Jump to content

Join endpoints of multiple polylines to common point

Jozef13

By Jozef13
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Jozef13 Enthusiast

Jozef13

Posted
Posted

Dear all,

 

I am looking for a lisp routine that join endpoints of multiple polylines to common point. I do not need to join them into one polyline, just touch all in one point.

Based on selection I want to get "master point" of first polyline in selection and then connect all the rest of polylines to that point as shown in attached picture.

Touch Polylines.jpg

ronjonp Grand Master

ronjonp

Posted
Posted

Here you go...

(defun c:foo (/ cp p s x)
 ;; RJP » 2018-08-15
 ;; Puts plines and lines closest vertice to a common picked point
 (cond
   ((and (setq p (getpoint "\nPick common point: "))
  (setq s (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
    )
    (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq cp	(car (vl-sort (list (vlax-curve-getstartpoint e) (vlax-curve-getendpoint e))
		      '(lambda (r j) (< (distance r p) (distance j p)))
	     )
	)
      )
      (entmod (mapcar '(lambda	(x)
		  (cond	((equal (list (car cp) (cadr cp)) (cdr x) 1e- (cons (car x) p))
			(x)
		  )
		)
	       (entget e '("*"))
       )
      )
    )
   )
 )
 (princ)
)

Jozef13 Enthusiast

Jozef13

Posted
  • Author
Posted
Here you go...

(defun c:foo (/ cp p s x)
 ;; RJP » 2018-08-15
 ;; Puts plines and lines closest vertice to a common picked point
 (cond
   ((and (setq p (getpoint "\nPick common point: "))
  (setq s (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
    )
    (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq cp	(car (vl-sort (list (vlax-curve-getstartpoint e) (vlax-curve-getendpoint e))
		      '(lambda (r j) (< (distance r p) (distance j p)))
	     )
	)
      )
      (entmod (mapcar '(lambda	(x)
		  (cond	((equal (list (car cp) (cadr cp)) (cdr x) 1e- (cons (car x) p))
			(x)
		  )
		)
	       (entget e '("*"))
       )
      )
    )
   )
 )
 (princ)
)

 

Perfect :shock:

Thank you.

I was struggling with polylines extended data but without success.

Could you modify it to be possible to apply it also at POLYLINES ?

Do not loose the time if it is more tricky.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Here's another - this doesn't account for UCS which are not parallel to WCS:

([color=BLUE]defun[/color] c:cpt ( [color=BLUE]/[/color] a b e i p q s x )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] s
               ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]
                  '(
                       (-04 . [color=MAROON]"<OR"[/color])
                           (000 . [color=MAROON]"LINE"[/color])
                           (-04 . [color=MAROON]"<AND"[/color])
                               (000 . [color=MAROON]"*POLYLINE"[/color])
                               (-04 . [color=MAROON]"<NOT"[/color])
                                   (-04 . [color=MAROON]"&="[/color])
                                   (070 . 1)
                               (-04 . [color=MAROON]"NOT>"[/color])
                           (-04 . [color=MAROON]"AND>"[/color])
                       (-04 . [color=MAROON]"OR>"[/color])
                   )
               )
           )
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify common point: "[/color]))
           ([color=BLUE]setq[/color] p ([color=BLUE]trans[/color] p 1 0))
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)
                 e ([color=BLUE]ssname[/color] s i)
                 x ([color=BLUE]entget[/color] e)
           )
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"POLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
               ([color=BLUE]progn[/color]
                   ([color=BLUE]setq[/color] e ([color=BLUE]entnext[/color] e)
                         x ([color=BLUE]entget[/color]  e)
                         a x
                   )
                   ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                       ([color=BLUE]setq[/color] b x
                             e ([color=BLUE]entnext[/color] e)
                             x ([color=BLUE]entget[/color]  e)
                       )
                   )
                   ([color=BLUE]setq[/color] q ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 a))) ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 b)))) a b))
                   ([color=BLUE]if[/color] ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 10 p) ([color=BLUE]assoc[/color] 10 q) q))
                       ([color=BLUE]entupd[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 q)))
                   )
               )
               ([color=BLUE]apply[/color]
                  '([color=BLUE]lambda[/color] ( a b [color=BLUE]/[/color] q )
                       ([color=BLUE]setq[/color] q ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] a)) ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] b))) a b))
                       ([color=BLUE]if[/color] ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] q) p) q x))
                           ([color=BLUE]entupd[/color] e)
                       )
                   )
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"LINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                       ([color=BLUE]list[/color] ([color=BLUE]assoc[/color] 10 x) ([color=BLUE]assoc[/color] 11 x))
                       ([color=BLUE]list[/color] ([color=BLUE]assoc[/color] 10 x) ([color=BLUE]assoc[/color] 10 ([color=BLUE]reverse[/color] x)))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

rkmcswain Grand Master

rkmcswain

Posted
Posted

Couldn't you also use constraints to maintain that endpoint to endpoint relationship?

Lee Mac Grand Master

Lee Mac

Posted
Posted
Nice Lee 8)

 

Thanks Ron - you too - I like the concision of your code :thumbsup:

ronjonp Grand Master

ronjonp

Posted
Posted
Thanks Ron - you too - I like the concision of your code :thumbsup:

 

Cheers! :)

Jozef13 Enthusiast

Jozef13

Posted
  • Author
Posted
Here's another - this doesn't account for UCS which are not parallel to WCS:

([color=BLUE]defun[/color] c:cpt ( [color=BLUE]/[/color] a b e i p q s x )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] s
               ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]
                  '(
                       (-04 . [color=MAROON]"<OR"[/color])
                           (000 . [color=MAROON]"LINE"[/color])
                           (-04 . [color=MAROON]"<AND"[/color])
                               (000 . [color=MAROON]"*POLYLINE"[/color])
                               (-04 . [color=MAROON]"<NOT"[/color])
                                   (-04 . [color=MAROON]"&="[/color])
                                   (070 . 1)
                               (-04 . [color=MAROON]"NOT>"[/color])
                           (-04 . [color=MAROON]"AND>"[/color])
                       (-04 . [color=MAROON]"OR>"[/color])
                   )
               )
           )
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify common point: "[/color]))
           ([color=BLUE]setq[/color] p ([color=BLUE]trans[/color] p 1 0))
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)
                 e ([color=BLUE]ssname[/color] s i)
                 x ([color=BLUE]entget[/color] e)
           )
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"POLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
               ([color=BLUE]progn[/color]
                   ([color=BLUE]setq[/color] e ([color=BLUE]entnext[/color] e)
                         x ([color=BLUE]entget[/color]  e)
                         a x
                   )
                   ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                       ([color=BLUE]setq[/color] b x
                             e ([color=BLUE]entnext[/color] e)
                             x ([color=BLUE]entget[/color]  e)
                       )
                   )
                   ([color=BLUE]setq[/color] q ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 a))) ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 b)))) a b))
                   ([color=BLUE]if[/color] ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 10 p) ([color=BLUE]assoc[/color] 10 q) q))
                       ([color=BLUE]entupd[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 q)))
                   )
               )
               ([color=BLUE]apply[/color]
                  '([color=BLUE]lambda[/color] ( a b [color=BLUE]/[/color] q )
                       ([color=BLUE]setq[/color] q ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] a)) ([color=BLUE]distance[/color] p ([color=BLUE]cdr[/color] b))) a b))
                       ([color=BLUE]if[/color] ([color=BLUE]entmod[/color] ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] q) p) q x))
                           ([color=BLUE]entupd[/color] e)
                       )
                   )
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"LINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                       ([color=BLUE]list[/color] ([color=BLUE]assoc[/color] 10 x) ([color=BLUE]assoc[/color] 11 x))
                       ([color=BLUE]list[/color] ([color=BLUE]assoc[/color] 10 x) ([color=BLUE]assoc[/color] 10 ([color=BLUE]reverse[/color] x)))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

 

Thnks Lee.

It works perfectly :thumbsup:

  • 5 years later...
DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
Posted

Greetings dear CAD gurus. I have a problem similar to the one our friend Josef13 presents. Which consists of joining multiple end points of multiple polylines to a common point. I downloaded the routines they published to solve my problem, but they don't work for me, they give me the following errors.

 

Routine. ;; RJP » 2018-08-15 ;; Puts plines and lines closest vertex to a common picked point. throws the following error =Command: ; error: malformed list on input.

 

The second routine published by master Lee Mac throws the following error. Command: ; error: extra cdrs in dotted pair on input. Can you help me by explaining to me what I did wrong when executing the command?

 

I really appreciate the help you can give me.

 

EXAMPLE.dwg

marko_ribar Veteran

marko_ribar

Posted
Posted

@DAVID_OJEDA

Here is Lee Mac's code without BBC tags... You should get no errors...

  

(defun c:cpt ( / a b e i p q s x )
  (if
    (and
      (setq s
        (ssget "_:L"
          '(
            (-04 . "<OR")
            (000 . "LINE")
            (-04 . "<AND")
            (000 . "*POLYLINE")
            (-04 . "<NOT")
            (-04 . "&=")
            (070 . 1)
            (-04 . "NOT>")
            (-04 . "AND>")
            (-04 . "OR>")
          )
        )
      )
      (setq p (getpoint "\nSpecify common point: "))
      (setq p (trans p 1 0))
    )
    (repeat (setq i (sslength s))
      (setq i (1- i)
            e (ssname s i)
            x (entget e)
      )
      (if (= "POLYLINE" (cdr (assoc 0 x)))
        (progn
          (setq e (entnext e)
                x (entget e)
                a x
          )
          (while (= "VERTEX" (cdr (assoc 0 x)))
            (setq b x
                  e (entnext e)
                  x (entget e)
            )
          )
          (setq q (if (< (distance p (cdr (assoc 10 a))) (distance p (cdr (assoc 10 b)))) a b))
          (if (entmod (subst (cons 10 p) (assoc 10 q) q))
            (entupd (cdr (assoc 330 q)))
          )
        )
        (apply
          '(lambda ( a b / q )
             (setq q (if (< (distance p (cdr a)) (distance p (cdr b))) a b))
             (if (entmod (subst (cons (car q) p) q x))
               (entupd e)
             )
           )
           (if (= "LINE" (cdr (assoc 0 x)))
             (list (assoc 10 x) (assoc 11 x))
             (list (assoc 10 x) (assoc 10 (reverse x)))
           )
        )
      )
    )
  )
  (princ)
)

 

HTH.

M.R.

DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
Posted

thank you, it works wonderfully. It helps me a lot.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...