Jozef13 Posted August 15, 2018 Share Posted August 15, 2018 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. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted August 15, 2018 Share Posted August 15, 2018 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) ) Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted August 15, 2018 Author Share Posted August 15, 2018 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 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 15, 2018 Share Posted August 15, 2018 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]) ) Quote Link to comment Share on other sites More sharing options...
rkmcswain Posted August 15, 2018 Share Posted August 15, 2018 Couldn't you also use constraints to maintain that endpoint to endpoint relationship? Quote Link to comment Share on other sites More sharing options...
ronjonp Posted August 15, 2018 Share Posted August 15, 2018 Nice Lee Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 15, 2018 Share Posted August 15, 2018 Nice Lee Thanks Ron - you too - I like the concision of your code Quote Link to comment Share on other sites More sharing options...
ronjonp Posted August 15, 2018 Share Posted August 15, 2018 Thanks Ron - you too - I like the concision of your code Cheers! Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted August 16, 2018 Author Share Posted August 16, 2018 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 16, 2018 Share Posted August 16, 2018 You're welcome Jozef Quote Link to comment Share on other sites More sharing options...
DAVID_OJEDA Posted May 19 Share Posted May 19 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 Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted May 19 Share Posted May 19 @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. Quote Link to comment Share on other sites More sharing options...
DAVID_OJEDA Posted May 19 Share Posted May 19 thank you, it works wonderfully. It helps me a lot. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.