martinle Posted February 18, 2016 Share Posted February 18, 2016 Hello Please help! I can not lisp. Seeking a way with a lisp to connect the corners of a closed polyline. These polylines are always so similar to the example. There are very many such lines and it would be great if you could solve with a lisp. Thank you! Martin Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted February 18, 2016 Share Posted February 18, 2016 Hi Martin Try this, but be aware that it will fail if there are duplicate points or if any partial distance is shorter that the "offset" distance. (defun connect (e / _point d d1 l p1 p2 a b n i) (setq _point vlax-curve-getpointatparam d (vlax-curve-getdistatparam e (setq n (fix (+ 0.1 (vlax-curve-getendparam e)))))) (repeat (setq i (1+ n)) (setq l (cons (setq p1 (_point e (setq i (1- i)))) l)) (if (setq p2 (cadr l)) (if (and (< (setq d1 (distance p1 p2)) d) (not (zerop d1)) ) (setq d d1 a (rem (1+ i) n) b i ) ) ) ) (mapcar 'set '(a b) (list (max a b) (min a b))) (while (progn (setq a (rem (1+ a) n)) (setq b (rem (+ n (1- b)) n)) (not (= (rem (1+ a) n) b)) ) (entmake (list '(0 . "LINE") (cons 10 (_point e a)) (cons 11 (_point e b)) ) ) ) ) (defun c:test (/ ss i) (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (connect (ssname ss (setq i (1- i)))) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 Hello Stefan! That's awesome !! Many thanks. It works wonderfully! Thank you! Martin Quote Link to comment Share on other sites More sharing options...
eldon Posted February 18, 2016 Share Posted February 18, 2016 Just in case you would like an alternative which does not use lisp, draw a polyline at the centre, give it a width, and turn Fill off. The effect is the same Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 Hi Eldon My polylines exist already. Only the corner joints are still missing. thank you Martin Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted February 18, 2016 Share Posted February 18, 2016 (edited) You're welcome Martin Duplicate points bug removed (defun connect (e / _point d d1 p1 p2 p11 p12 p21 p22 a b n i) (setq _point vlax-curve-getpointatparam d (vlax-curve-getdistatparam e (setq n (fix (+ 0.1 (vlax-curve-getendparam e)))) ) ) (repeat (setq i (1+ n)) (setq p1 (_point e (setq i (1- i)))) (if p2 (if (and (< (setq d1 (distance p1 p2)) d) (not (zerop d1)) ) (setq d d1 a (rem (1+ i) n) b i ) ) ) (setq p2 p1) ) (if (zerop b) (mapcar 'set '(a b) (list b a))) (setq p11 (_point e a) p21 (_point e b) ) (while (progn (while (equal p11 (setq p12 (_point e (setq a (rem (1+ a) n)))) 1e- ) (while (equal p21 (setq p22 (_point e (setq b (rem (+ n (1- b)) n)))) 1e- ) (not (or (= (abs (- a b)) 1) (= (abs (- a b)) n) ) ) ) (entmake (list '(0 . "LINE") (cons 10 (setq p11 p12)) (cons 11 (setq p21 p22)) ) ) ) ) (defun c:test (/ ss i) (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (connect (ssname ss (setq i (1- i)))) ) ) (princ) ) Edited February 18, 2016 by Stefan BMR Updated Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 Hello Stefan! Many thanks. Thank you! Martin Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 Hello Stefan, One small thing is I have noticed. There are drawn all the oblique connections. But also a connection to the straight end of the polyline. Would it still possible that you will not use it to create any line on the other is? That would be great! Many thanks! Martin Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 sorry for my bad English Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted February 18, 2016 Share Posted February 18, 2016 Updated previous post. I'm not sure I have covered all the possibilities, I will check again later. Quote Link to comment Share on other sites More sharing options...
martinle Posted February 18, 2016 Author Share Posted February 18, 2016 Many thanks! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 18, 2016 Share Posted February 18, 2016 Nice solution Stefan Here's another way: (defun c:test ( / a d e f i l n v x ) (if (setq e (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))) (progn (setq l (entget (ssname e 0)) l (cons (assoc 10 (reverse l)) l) f (lambda ( x ) (reverse (cdr x))) d 1e308 n 0 ) (while (setq a (assoc 10 l)) (and v (< (setq x (distance (cdr a) (car v))) d) (setq d x i n)) (or (and v (equal (car v) (cdr a) 1e-3)) (setq v (cons (cdr a) v)) ) (setq l (cdr (member a l)) n (1+ n) ) ) (setq v (f v)) (repeat i (setq v (reverse (cons (car v) (f v))))) (repeat (- (/ (length v) 2) 2) (entmake (list '(0 . "LINE") (cons 10 (car (setq v (f (f v))))) (cons 11 (last v)))) ) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
martinle Posted February 19, 2016 Author Share Posted February 19, 2016 Thank Mr. Lee Mac! It works beautifully. Thanks Martin Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted February 19, 2016 Share Posted February 19, 2016 Thanks Lee Your solution is nice and concise, as always. Maybe Martin is pleased with both lisps and he might have a clean drawing, but we both fail to cover all the exceptions. Try this polyline: (entmakex '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (62 . 3) (90 . 12) (70 . 1) (10 5.0 5.0) (10 5.0 1.0) (10 2.0 1.0) (10 2.0 2.0) (10 2.0 2.0) (10 4.0 2.0) (10 4.0 4.0) (10 1.0 4.0) (10 1.0 0.0) (10 0.0 0.0) (10 0.0 5.0) (10 0.0 5.0) ) ) Quote Link to comment Share on other sites More sharing options...
martinle Posted February 19, 2016 Author Share Posted February 19, 2016 Hello Stefan Oh yes Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 19, 2016 Share Posted February 19, 2016 Your solution is nice and concise, as always. Thank you! Maybe Martin is pleased with both lisps and he might have a clean drawing, but we both fail to cover all the exceptions.Try this polyline: Good catch - fixed: ([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] a d e f i l n v x ) ([color=BLUE]if[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1)))) ([color=BLUE]progn[/color] ([color=BLUE]setq[/color] l ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] e 0)) l ([color=BLUE]cons[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]reverse[/color] l)) l) f ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] x))) d 1e308 n 0 ) ([color=BLUE]while[/color] ([color=BLUE]setq[/color] a ([color=BLUE]assoc[/color] 10 l)) ([color=BLUE]cond[/color] ( ([color=BLUE]not[/color] v) ([color=BLUE]setq[/color] v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v))) ( ([color=BLUE]equal[/color] ([color=BLUE]car[/color] v) ([color=BLUE]cdr[/color] a) 1e-3)) ( ([color=BLUE]<[/color] ([color=BLUE]setq[/color] x ([color=BLUE]distance[/color] ([color=BLUE]cdr[/color] a) ([color=BLUE]car[/color] v))) d) ([color=BLUE]setq[/color] d x i n v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v))) ( ([color=BLUE]setq[/color] v ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] a) v))) ) ([color=BLUE]setq[/color] l ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] a l)) n ([color=BLUE]1+[/color] n) ) ) ([color=BLUE]setq[/color] v (f v)) ([color=BLUE]repeat[/color] i ([color=BLUE]setq[/color] v ([color=BLUE]reverse[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] v) (f v))))) ([color=BLUE]repeat[/color] ([color=BLUE]-[/color] ([color=BLUE]/[/color] ([color=BLUE]length[/color] v) 2) 2) ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]car[/color] ([color=BLUE]setq[/color] v (f (f v))))) ([color=BLUE]cons[/color] 11 ([color=BLUE]last[/color] v)))) ) ) ) ([color=BLUE]princ[/color]) ) 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.