Topic: Join lots of small lines

[CAB]

Oh yes..

That was just a rough draft.

[CAB]

Gary
I edited the code in your post, adding some needed local vars & condesing it further.
Hope you don't mind.

[GDF]

Allen

Thanks, I'm learning...............

[Fatty]

Maybe this need somebody else

Code: [Select]

;; | --------------------------------------------------------------------------
;; | PEDLINES.lsp
;; | --------------------------------------------------------------------------
;; | Returns  : Polyline entity
;; | Updated  : 2/5/06
;; | Author   : Fatty
;; | Note     : Multiple join of lines by picking first or last line in the chain
;; | ----------------------------------------------------------------------------

(defun pedlines (fuzz /    acsp     adoc     axss     chain_list
   couple   ept     line_list       ln       loop
   spt    ss
  )
 (vl-load-com)
 (or adoc
     (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 )
  (setvar "cmdecho" 0)
 (setq ln  (vlax-ename->vla-object (car (entsel
"\n\t >> Select first or last line in the line chain >>\n")))
spt (vlax-get ln 'Startpoint)
ept (vlax-get ln 'Endpoint)
 )

 (setq ss   (ssget "_X" '((0 . "LINE")))
axss (vla-get-activeselectionset adoc)
 )

 (setq line_list '()
chain_list
 (cons ln chain_list)
 )
 (vlax-for a axss (setq line_list (cons a line_list)))

 (setq loop t)
 (while loop
   (while
     (setq couple
     (vl-remove-if-not
       (function (lambda (x)
     (or (equal (vlax-get x 'Startpoint)
         (vlax-get ln 'Startpoint)
         fuzz
         )
         (equal (vlax-get x 'Startpoint)
         (vlax-get ln 'Endpoint)
         fuzz
         )
         (equal (vlax-get x 'Endpoint)
         (vlax-get ln 'Startpoint)
         fuzz
         )
         (equal (vlax-get x 'Endpoint)
         (vlax-get ln 'Endpoint)
         fuzz
         )
     )
   )
       )
       line_list
     )
     )
      (if couple
 (progn
   (setq chain_list (append couple chain_list))

   (setq line_list (vl-remove ln line_list))
   (setq ln (car chain_list))
 )
 (setq line_list (cdr line_list))
      )
   )
   (setq loop nil)
 )

(command "pedit" "m")
(mapcar 'command (mapcar 'vlax-vla-object->ename chain_list))
(command "" "Y" "J" "" "")
(setvar "cmdecho" 1) 
(entlast)
)
;TesT : (pedlines 0.01); 0.01 in drawing units

~'J'~

[CAB]

Here is my attempt.
Could use more testing.
Also attached is a test dwg that i used.
Note that Luis's code left some unattached in my test.

Code: [Select]

;;;=======================[ GlueAllLines.lsp ]=======================
;;; Author: Copyright© 2006 Charles Alan Butler
;;; Version:  1.1 Feb 09, 2006
;;; Purpose: To glue all lines that are end to end & on the same layer
;;;          and not on a locked layer
;;;          Selection is by user or current space or all drawing
;;; Sub_Routines: ss->lst creates a data list of all the lines
;;;               glue  will glue two lines
;;; Requirements: None   
;;;                       
;;;==============================================================

(defun c:GlueAllLines (/ masterlist itm lay tmp newlst layidx taridx laygroup
                       fuzz elst idx newln newtarget ss target)
                       
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;;                                                               -
;;;                        Functions                              -
;;;                                                               -
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
 
  ;;====================================================================
  ;;  returns a list of enity info ((ename layer stpt endpt space) ...)
  (defun ss->lst (ss2 / i ename result elst)
    (setq i -1)
    (while (setq ename (ssname ss2 (setq i (1+ i))))
      (setq elst   (entget ename)
            result (cons
                     (list ename                  ; ent name
                           (cdr (assoc 8 elst))   ; layer
                           (cdr (assoc 10 elst))  ; start pt
                           (cdr (assoc 11 elst))  ; end pt
                           (cdr (assoc 410 elst)) ; space
                     )
                     result
   ))))

 
  ;;Alan Butler 02/05/06
  ;;  returns nil if lines are not joined
  (defun glue  (flin slin / p1 p2 p3 p4 flist slist f1pt f2pt s1pt s2pt overlap parallel fuzz)
    ;; determine if p1 & p4 are in the same direction
    (defun overlap (p1 p2 p3 p4) (equal (angle p2 p1) (angle p3 p4) 1.001))
    ;;  test for parallel   CAB 10/18/05
    (defun parallel  (ln1 ln2 / ang1 ang2 pfuzz)
      (if (= (type ln1) 'ename)
        (setq ln1 (entget ln1)
              ln2 (entget ln2)))
      (setq ang1 (angle (cdr (assoc 10 ln1)) (cdr (assoc 11 ln1))))
      (setq ang2 (angle (cdr (assoc 10 ln2)) (cdr (assoc 11 ln2))))
      (setq pfuzz 0.001)
      (or (equal ang1 ang2 pfuzz)
          ;;  Check for lines drawn in opposite directions
          (equal (min ang1 ang2) (- (max ang1 ang2) pi) pfuzz)))
    ;;  ***  Start of Routine  ***
    (if (and flin slin)
      (progn (setq fuzz 0.01) ; alowable line endpoint gap
             (setq flist (entget flin))
             (setq slist (entget slin))
             (if (parallel flist slist)
               (progn (setq f1pt (cdr (assoc 10 flist)))
                      (setq f2pt (cdr (assoc 11 flist)))
                      (setq s1pt (cdr (assoc 10 slist)))
                      (setq s2pt (cdr (assoc 11 slist)))
                      ;;  find end point match
                      (cond ((< (distance f1pt s1pt) fuzz)
                             (setq p1 f2pt ; start of new line
                                   p2 f1pt ; intersect of old lines
                                   p3 s1pt ; intersect of old lines
                                   p4 s2pt ; end of new line
                                   ))
                            ((< (distance f2pt s1pt) fuzz)
                             (setq p1 f1pt  p2 f2pt  p3 s1pt  p4 s2pt))
                            ((< (distance f1pt s2pt) fuzz)
                             (setq p1 f2pt  p2 f1pt  p3 s2pt  p4 s1pt))
                            ((< (distance f2pt s2pt) fuzz)
                             (setq p1 f1pt  p2 f2pt  p3 s2pt  p4 s1pt)))
                      (if (and p1 (not (overlap p1 p2 p3 p4)))
                        (progn
                          (cond
                            ((equal p1 (cdr (assoc 11 flist)))
                             (setq flist (subst (cons 10 p4) (assoc 10 flist) flist)))
                            ((equal p4 (cdr (assoc 10 flist)))
                             (setq flist (subst (cons 11 p1) (assoc 11 flist) flist)))
                            ((setq flist (subst (cons 10 p1) (assoc 10 flist) flist)
                                   flist (subst (cons 11 p4) (assoc 11 flist) flist)))
                          )
                          (entmod flist) ; keeps the same properties of the first line
                          (entdel slin) ; second line is discarded
                       )))
      )))
    )

 
  ;; o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o
  ;;                S T A R T   O F   R O U T I N E               
  ;; o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o

  (prompt "\nSelect lines to join or Enter for all lines in drawing.")
  (if (or (setq ss (ssget '((0 . "LINE")))) ; user selected lines
          (and (not (initget "Yes No"))
               (/= (getkword "\n***  Limit to lines in current space? <Yes>  ***") "No")
               (setq ss (ssget "_X" (list '(0 . "LINE")(cons 410 (getvar "ctab")))))
          )
          (setq ss (ssget "_X" '((0 . "LINE"))))) ; get all lines
    (progn
      (command ".undo" "begin")
      (setq masterlist (ss->lst ss)) ; create a list of entity data
      ;;  sort the list on layer
      (setq masterlist (vl-sort masterlist '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
      (setq lay (cadar masterlist)) ; first layer
      ;;  create sub list grouped by layer
      (foreach itm masterlist
        (if (= lay (cadr itm))
          (setq tmp (cons itm tmp))
            (setq newlst (cons tmp newlst)
                  tmp    (list itm)
                  lay    (cadr itm)
            )
        )
      )
      (if tmp (setq newlst (cons tmp newlst)))
     
      ;;  foreach layer group
      ;;  Note that a WHILE is used as FOREACH will not handle changing list
      (setq layidx -1)
      (while (< (setq layidx (1+ layidx)) (length newlst))
        ;;  foreach item check with the other items for a match
        (setq taridx -1)
        (setq laygroup (nth layidx newlst))
        (while (< (setq taridx (1+ taridx)) (length laygroup))
          (if (setq target (nth taridx laygroup))
            (progn
              ;;  foreach other item combine lines within layer groups
              (setq idx -1)
              (while (< (setq idx (1+ idx)) (length laygroup))
                (if (and (setq itm (nth idx laygroup)) ; check for nil -> removed line
                         (not (equal (car target) (car itm)))
                         (= (nth 4 target) (nth 4 itm)) ;  in same space? model or layouts
                    )
                  ;;  try to glue the lines
                  (if (glue (car target) (car itm))
                    ;;  they are joined, so update list
                    ;;  update the sublist, new end points & nil deleted line
                    (setq elst     (entget (car target))
                          newtarget (list (car target)           ; ent name
                                          (cdr (assoc 8 elst))   ; layer
                                          (cdr (assoc 10 elst))  ; start pt
                                          (cdr (assoc 11 elst))  ; end pt
                                          (cdr (assoc 410 elst)) ; space
                                    )
                          laygroup  (subst newtarget target laygroup)
                          laygroup  (subst nil itm laygroup) ; remove deleted line, nil will be a place holder
                          target    newtarget
                          idx       -1 ; start the loop again because the targat end points changed
                    )
                  )
                )
              )
            )
           )
          )
        ) ; while
      (command ".undo" "end")
    )
  )
  (princ)
)
(prompt "\nGlue All Lines Loaded, Enter GlueAllLines to run.")
(princ)

Updated code again 02/09/06

[LE]

Here is my attempt.
Could use more testing.
Also attached is a test dwg that i used.
Note that Luis's code left some unattached in my test.

Hi Charles;

I just did a test using your drawing sample, my command glues all the possible collinear lines, I tried with yours and does not do anything.

Luis.

[Serge J. Gianolla]

Hudster,
On your post you mention Having 2006, any reason why you are not using the built-in command Join if indeed you are talking about colinear lines? If they are not colinear, use the PEdit function combined with Fast Select from the express tools. You can use it transparently as such 'FS when prompted to select all objects to join. FastSel is an open lisp file; a couple of added lines should be enough to select only object belonging to same layer.
HTH

[CAB]

Luis,
i fixed it. Thanks
When I stripped out the debug code I stripped too much.

[LE]

Luis,
i fixed it. Thanks
When I stripped out the debug code I stripped too much.

It is working now... just for lines that touch each other [as the OP asked]... but it takes a lot of time to process the items... as I know still is code in progress...

Thanks 

[sinc]

Hudster,
On your post you mention Having 2006, any reason why you are not using the built-in command Join if indeed you are talking about colinear lines? If they are not colinear, use the PEdit function combined with Fast Select from the express tools. You can use it transparently as such 'FS when prompted to select all objects to join. FastSel is an open lisp file; a couple of added lines should be enough to select only object belonging to same layer.
HTH

To play on this answer, you can also use the "Multiple" option of PEdit.  You probably want to set PEDITACCEPT to 1.  Then type PEdit, then hit M.  Select all lines/arcs you want joined.  Type "J" for Join.  Enter a "fuzz distance" at the prompt.  You should now have a set of polylines.

Also, I still use QuickSelect, but one my favorite ways for selecting objects has become the Express Tools command "Get Selection Set" (GETSEL).  To use this command, run GETSEL first, before running your other command (GETSEL doesn't work transparently).  First option is to pick an object on the layer you want (hit return or right-click for ALL LAYERS), then pick the type of object you want (hit return or right-click for ALL OBJECTS).  The objects will go into the current selection set.  Then, when you run your command and it asks you to select objects, hit "P" for "Previous selection set".

This works in 2004 and up; I don't know about earlier versions.

[CAB]

Andy where did you go?


Sinc, the GetSel works for me in ACAD2000
Have you tried my Sel routine?  Sel.lsp   It doesn't work transparently eather.
But it lets you choose more than one layer & then lets you select all or a window to filter from.
No object type filter though.

[hudster]

isn't getsel an express tools command?

[CAB]

isn't getsel an express tools command?

Yes. and my Sel routine is similar in the way it works.

The problem I have with getsel is that in my et version you can not limit the
the objects to be considered for the selection. It get the entire drawing or at
least the entire space.


Did you get your problem solved as for joining lines?

[hudster]

Yeah I used the gluelines routine, had to be selective on what i picked, but it joined all the lines nicely

[LE]

Yeah I used the gluelines routine, had to be selective on what i picked, but it joined all the lines nicely

Andy;

Since I am using GLUELINES to learn and implement the most I can about classes... I am doing some upgrades for the application - still will be a freeone.

By adding some filter options:
1. Layer
2. Linetype
3. Color

I know that the command OVERKILL does something similar... I will say that my version is going to be another alternative.

As soon I have ready.... it will be available for download right on the "show my stuff"... section.

Have fun.

Note:
Regarding the issues about relying on a 3d party application and the possibility of not having this command available to run on future releases of AutoCAD.
The source code including the C++ project solution and line by line description, MIGHT be available for a FEE