Join lines by layer

Join lines by layer

Anonymous
Not applicable
1,385 Views
3 Replies
Message 1 of 4

Join lines by layer

Anonymous
Not applicable

Hello,

 

I have this beautiful lisp of joining lines together:

 

;; Join Lines  -  Lee Mac
;; Joins collinear lines in a selection, retaining all original properties.

(defun c:joinlines ( / process e i l s x )

    (defun process ( l / x r )
        (if (setq x (car l))
            (progn
                (foreach y (cdr l)
                    (if (vl-every '(lambda ( a ) (apply 'LM:collinear-p (cons a (cdr x)))) (cdr y))
                        (setq x (cons (car x) (LM:furthestapart (append (cdr x) (cdr y)))))
                        (setq r (cons y r))
                    )
                )
                (entmake (append (car x) (mapcar 'cons '(10 11) (cdr x))))
                (process r)
            )
        )
    )
    (if (setq s (ssget "_:L" '((0 . "LINE"))))
        (process
            (repeat (setq i (sslength s))
                (setq e (ssname s (setq i (1- i)))
                      x (entget e)
                      e (entdel e)
                      l (cons (list x (cdr (assoc 10 x)) (cdr (assoc 11 x))) l)
                )
            )
        )
    )
    (princ)
)

;; Furthest Apart  -  Lee Mac
;; Returns the two points furthest apart in a given list

(defun LM:furthestapart ( lst / di1 di2 pt1 rtn )
    (setq di1 0.0)
    (while (setq pt1 (car lst))
        (foreach pt2 (setq lst (cdr lst))
            (if (< di1 (setq di2 (distance pt1 pt2)))
                (setq di1 di2
                      rtn (list pt1 pt2)
                )
            )
        )
    )
    rtn
)

;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear

(defun LM:Collinear-p ( p1 p2 p3 )
    (
        (lambda ( a b c )
            (or
                (equal (+ a b) c 1e-8)
                (equal (+ b c) a 1e-8)
                (equal (+ c a) b 1e-8)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
)

(princ)

 

 

, but the problem is that it changes the layer that they apear.

 

I want by selecting the objects it will join them but in their current layer.

 

Thank you 

 

Eyal

0 Likes
1,386 Views
3 Replies
Replies (3)
Message 2 of 4

ВeekeeCZ
Consultant
Consultant

What's wrong with the JOIN command? I like using this command myself.

BTW post some sample dwg of what you receive and you what... because as Lee stated at the beginning of his routine it honors its original properties - which is in my understanding the same as your "their current layer".

0 Likes
Message 3 of 4

john.uhden
Mentor
Mentor

I am thinking that he just needs to include the layer in the ssget filter, so that he is not inadvertently joining cats with dogs.  If he were he would have to create a new layer like DAT or COG, or is that DOT or CAG?  Sorta like the old Laugh-In joke... if Tuesday Weld married Frederick March 3rd, she'd be Tuesday March 3rd.

John F. Uhden

Message 4 of 4

ВeekeeCZ
Consultant
Consultant

Well, try this routine joining entities (not just lines) by their layer.

 

(defun c:JoinByLayer ( / ss ent lay asc lst i)
  
  (if (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE,ARC"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
	    lay (cdr (assoc 8 (entget ent)))
	    lst (if (setq asc (assoc lay lst))
		  (subst (cons lay (ssadd ent (cdr asc)))
			 asc
			 lst)
		  (cons (cons lay (ssadd ent)) lst)))))
  (foreach e lst
    (progn
      (initcommandversion)
      (command "_.JOIN" (cdr e) "")))
  (princ)
  )

 

 

0 Likes