# Draw polyline along with 2 or more adjacent closed polylines

## Recommended Posts

Hi i required a lisp to draw a poly line along with 2 closed poly lines. If i pick 2 vertexes on 2 polygons, 1 new poly line should be created between these two points along with polygon walls. can any body help.

thanks,

##### Share on other sites

My approach would be:

• Collect set of candidate polygons

• Collect set of all possible vertices from set of candidate polygons

• Prompt user for source vertex and destination vertex

• Use Dijkstra's Algorithm to determine the shortest path between the two vertices from the set of available vertices, the weight for each segment being the distance between the vertices for that segment.

##### Share on other sites

Assuming that the polygons are at elevation 0.0, this should work :

```([color=BLUE]defun[/color] getverticies ( pl [color=BLUE]/[/color] lst )
([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]car[/color] x) 10) ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] x) lst)))) ([color=BLUE]entget[/color] pl))
([color=BLUE]reverse[/color] lst)
)

([color=BLUE]defun[/color] ChIV ( pl nthpt [color=BLUE]/[/color] ed edd q ec ed eddd eddd1 eddd2 eddd3 newed m n i )
([color=BLUE]setq[/color] ed ([color=BLUE]entget[/color] pl))
([color=BLUE]setq[/color] edd [color=BLUE]nil[/color])
([color=BLUE]setq[/color] q -1)
([color=BLUE]while[/color] ([color=BLUE]<[/color] q 0)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] ec ([color=BLUE]car[/color] ed))
([color=BLUE]setq[/color] ed ([color=BLUE]cdr[/color] ed))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]car[/color] ec) 10) ([color=BLUE]progn[/color] ([color=BLUE]setq[/color] ed ([color=BLUE]cons[/color] ec ed)) ([color=BLUE]setq[/color] edd ([color=BLUE]reverse[/color] edd)) ([color=BLUE]setq[/color] q 1)) ([color=BLUE]setq[/color] edd ([color=BLUE]cons[/color] ec edd)))
)
)
([color=BLUE]setq[/color] eddd [color=BLUE]nil[/color])
([color=BLUE]setq[/color] eddd1 [color=BLUE]nil[/color])
([color=BLUE]setq[/color] eddd2 [color=BLUE]nil[/color])
([color=BLUE]setq[/color] eddd ed)
([color=BLUE]setq[/color] m nthpt)
([color=BLUE]setq[/color] n ([color=BLUE]*[/color] m 4))
([color=BLUE]setq[/color] i 0)
([color=BLUE]foreach[/color] ec eddd
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] i ([color=BLUE]+[/color] i 1))
([color=BLUE]if[/color] ([color=BLUE]<=[/color] i n)
([color=BLUE]setq[/color] eddd1 ([color=BLUE]cons[/color] ec eddd1))
)
([color=BLUE]if[/color] ([color=BLUE]>[/color] i n)
([color=BLUE]setq[/color] eddd2 ([color=BLUE]cons[/color] ec eddd2))
)
)
)
([color=BLUE]setq[/color] eddd1 ([color=BLUE]reverse[/color] eddd1))
([color=BLUE]setq[/color] eddd2 ([color=BLUE]cdr[/color] eddd2))
([color=BLUE]setq[/color] eddd2 ([color=BLUE]reverse[/color] eddd2))
([color=BLUE]setq[/color] eddd3 '((210 0.0 0.0 1.0)))
([color=BLUE]setq[/color] newed ([color=BLUE]append[/color] edd eddd2 eddd1 eddd3))
([color=BLUE]entmod[/color] newed)
([color=BLUE]entupd[/color] pl)
)

([color=BLUE]defun[/color] c:2pl-pl ( [color=BLUE]/[/color] oldv v pt1 pt2 pt3 pl1 pl2 pl1vert pl2vert k nthpt1 nthpt3 pl1vertpt2 pl2vertpt2 newplvert )
([color=BLUE]setq[/color] oldv ([color=BLUE]mapcar[/color] '[color=BLUE]getvar[/color] ([color=BLUE]setq[/color] v '(cmdecho osmode))))
([color=BLUE]mapcar[/color] '[color=BLUE]setvar[/color] v '(0 1))
([color=BLUE]setq[/color] pt1 ([color=BLUE]getpoint[/color] [color=BROWN]"\nPick start point on first polyline : "[/color]))
([color=BLUE]setq[/color] pt2 ([color=BLUE]getpoint[/color] [color=BROWN]"\nPick point on 2 pline connection : "[/color]))
([color=BLUE]setq[/color] pt3 ([color=BLUE]getpoint[/color] [color=BROWN]"\nPick end point on second polyline : "[/color]))
([color=BLUE]setq[/color] pt1 ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] pt1))))
([color=BLUE]setq[/color] pt2 ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] pt2))))
([color=BLUE]setq[/color] pt3 ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] pt3))))
([color=BLUE]setvar[/color] 'osmode 0)
([color=BLUE]vl-cmdf[/color] [color=BROWN]"osnap"[/color] [color=BROWN]"off"[/color])
([color=BLUE]prompt[/color] [color=BROWN]"\nPick first polyline"[/color])
([color=BLUE]setq[/color] pl1 ([color=BLUE]ssname[/color] ([color=BLUE]ssget[/color] [color=BROWN]"_+.:E:L"[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]))) 0))
([color=BLUE]setq[/color] pl1vert (getverticies pl1))
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]member[/color] pt1 pl1vert)) ([color=BLUE]progn[/color] ([color=BLUE]alert[/color] [color=BROWN]"\nWarning - start point not member of first polyline"[/color]) ([color=BLUE]exit[/color])))
([color=BLUE]prompt[/color] [color=BROWN]"\nPick second polyline"[/color])
([color=BLUE]setq[/color] pl2 ([color=BLUE]ssname[/color] ([color=BLUE]ssget[/color] [color=BROWN]"_+.:E:L"[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]))) 0))
([color=BLUE]setq[/color] pl2vert (getverticies pl2))
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]member[/color] pt3 pl2vert)) ([color=BLUE]progn[/color] ([color=BLUE]alert[/color] [color=BROWN]"\nWarning - end point not member of second polyline"[/color]) ([color=BLUE]exit[/color])))
([color=BLUE]setq[/color] k -1)
([color=BLUE]foreach[/color] pt pl1vert
([color=BLUE]setq[/color] k ([color=BLUE]1+[/color] k))
([color=BLUE]if[/color] ([color=BLUE]equal[/color] pt pt1 1e- ([color=BLUE]setq[/color] nthpt1 k))
)
([color=BLUE]setq[/color] k -1)
([color=BLUE]foreach[/color] pt pl2vert
([color=BLUE]setq[/color] k ([color=BLUE]1+[/color] k))
([color=BLUE]if[/color] ([color=BLUE]equal[/color] pt pt3 1e- ([color=BLUE]setq[/color] nthpt3 k))
)
(ChIV pl1 nthpt1)
(ChIV pl2 nthpt3)
([color=BLUE]setq[/color] pl1vert (getverticies pl1))
([color=BLUE]setq[/color] pl2vert (getverticies pl2))
(ChIV pl1 ([color=BLUE]-[/color] ([color=BLUE]length[/color] pl1vert) nthpt1))
(ChIV pl2 ([color=BLUE]-[/color] ([color=BLUE]length[/color] pl2vert) nthpt3))
([color=BLUE]setq[/color] pl1vertpt2 ([color=BLUE]vl-remove[/color] pt2 ([color=BLUE]reverse[/color] ([color=BLUE]member[/color] pt2 ([color=BLUE]reverse[/color] pl1vert)))))
([color=BLUE]setq[/color] pl2vertpt2 ([color=BLUE]vl-remove[/color] pt2 ([color=BLUE]reverse[/color] ([color=BLUE]member[/color] pt2 ([color=BLUE]reverse[/color] pl2vert)))))
([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]last[/color] pl2vertpt2) pl1vert)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] pl2vert ([color=BLUE]cons[/color] pt3 ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] pl2vert))))
([color=BLUE]setq[/color] pl2vertpt2 ([color=BLUE]vl-remove[/color] pt2 ([color=BLUE]reverse[/color] ([color=BLUE]member[/color] pt2 ([color=BLUE]reverse[/color] pl2vert)))))
)
)
([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]last[/color] pl1vertpt2) pl2vert)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] pl1vert ([color=BLUE]cons[/color] pt1 ([color=BLUE]reverse[/color] ([color=BLUE]cdr[/color] pl1vert))))
([color=BLUE]setq[/color] pl1vertpt2 ([color=BLUE]vl-remove[/color] pt2 ([color=BLUE]reverse[/color] ([color=BLUE]member[/color] pt2 ([color=BLUE]reverse[/color] pl1vert)))))
)
)
([color=BLUE]setq[/color] newplvert ([color=BLUE]append[/color] pl1vertpt2 ([color=BLUE]list[/color] pt2) ([color=BLUE]reverse[/color] pl2vertpt2)))
([color=BLUE]entmakex[/color] ([color=BLUE]append[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbEntity"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbPolyline"[/color])
([color=BLUE]cons[/color] 62 3)
([color=BLUE]cons[/color] 90 ([color=BLUE]length[/color] newplvert))
([color=BLUE]cons[/color] 70 0)
([color=BLUE]cons[/color] 210 ([color=BLUE]list[/color] 0.0 0.0 1.0))
)
([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]cons[/color] 10 x)) newplvert)
)
)
([color=BLUE]mapcar[/color] '[color=BLUE]setvar[/color] v oldv)
([color=BLUE]princ[/color])
)
```

Regards,

M.R.

[EDIT] : changed code so that you can select first and second polyline to make it easier to create consecutive contours of new connection polylines that could be joined in later step...

Edited by marko_ribar
code little changed

##### Share on other sites

thnks, It is working fine for 2 polygons.

same lisp i am unable to use for multiple polygons. can u modify this please.

##### Share on other sites

Repeat executing routine like I explained from 2nd polygon to 3rd, then repeat from 3rd to 4th, and so on... At the end you can join contour with PEDIT command...

M.R.

##### Share on other sites
My approach would be:

• Use Dijkstra's algorithm to determine the shortest path between the two vertices from the set of available vertices, the weight for each segment being the distance between the vertices for that segment.

After spending half-a-day reading Dijkstra's algorithm as Lee suggested. well after a while ..... it started to look like 3D Stereogram to me

I did however use the approach on Les's post (items 1-3). So here's a draft:

```(defun c:PlPath (/ LM:ListClockwise-p LM:Unique AT:GetVertices _Buildlist
_FindPoint _rebuild _FindNext
sp ep ss i a Pls  PtlSt)
(defun LM:ListClockwise-p (lst)
(minusp (apply '+ (mapcar
(function
(lambda (a b)
) ) lst (cons (last lst) lst)
)))
)
(defun LM:Unique ( l )
(if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
(defun AT:GetVertices (e / p l)
;; Alan J. Thompson, 09.30.10
(if e
(if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
(repeat (setq p (1+ (fix p)))
(setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
)
(list (vlax-curve-getStartPoint e)
(vlax-curve-getEndPoint e)
)
)
)
)
(defun _Buildlist (pt ls)
(setq Pt (_findpoint sp ls)
Pt (append (car Pt) (vl-remove-if
'(lambda (q) (member q (car Pt)))
(setq nl (nth (cadr Pt) ls))
)
)
ls (vl-remove nl ls)
)
(list Pt ls)
)
(defun _FindPoint (v l / a b c d)
(setq d -1)
(while (and (setq a (car l)) (not c))
(setq d (1+ d))
(if (setq b (member v a))
(setq c (cons b c) )
)
(setq l (vl-remove a l))
) (list (car c) d)
)
(defun _rebuild (v ls_)
(foreach s (cdr (member v ls_))
(setq ls_ (vl-remove s ls_))) ls_)
(defun _FindNext (l1 l2 / f g h)
(while (and (setq f (car l1)) (not g))
(if (not (setq g (car (_FindPoint f l2))))
(setq l1 (cdr l1))
)
)
(car g)
)
(cond ((and
(Setq Lst nil PtlSt nil
sp (getpoint "\nSelect Start Point:"))
(Setq ep (getpoint sp "\nSelect End Point:"))
(setq ss (ssget  '((0 . "LWPOLYLINE")
(-4 . "&=") (70 . 1)
(410 . "MODEL")
)
)
)
(progn
(initget 1 "T B")
(setq opt (getkword "\nSelect option [Top/Bottom]: ")) opt)
(repeat (setq i (sslength ss))
(setq a (AT:GetVertices (ssname ss (setq i (1- i)))))
(if (eq opt "B")
(setq a (if (LM:ListClockwise-p a)
(reverse a) a ))
(setq a (if (LM:ListClockwise-p a)
a (reverse a) )))
(setq lst (cons a lst)))
(repeat (length lst)
(setq Pls (_Buildlist sp lst)
PtlSt (cons (car Pls) PtlSt)
(setq sp (_FindNext (car PtlSt) lst))
(setq PtlSt (subst (_rebuild sp (car PtlSt)) (car PtlSt) PtlSt))
)
(setq PtlSt (LM:Unique
(apply 'append
(reverse
(subst (_rebuild ep (car PtlSt))
(car PtlSt)
PtlSt)))))
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length PtlSt))
(cons 70 0))
(mapcar (function (lambda (p) (cons 10 p))) PtlSt)))
)
)
)

(princ)
)```

Right now, if you pick a point form left to right , you'll be prompted for Top or Bottom, then select the polygons any which way you want it doesnt matter.

But if you somehow pick the points right to left, whats top is bottom and bottom is top.

We could easily add the option for that, but first try it out and tell me what you think

Cheers.

BTW: kudos to Lee Mac amd Alanjt for the subs i included on the code.

##### Share on other sites

Thanks pBe, its working fine. this is exactly what i want. But this is not working for open polygons.

Is there any possibilities to develop lisp without select all polygons(select only start vertices and end vertices)

##### Share on other sites
Thanks pBe, its working fine. this is exactly what i want. But this is not working for open polygons.

I guess the code can be modified to handle open polygons, but you did asked for Closed Polygons

Is there any possibilities to develop lisp without select all polygons(select only start vertices and end vertices)

Oh boy.. now that would be something. That is beyond my math skils. I gues i need to read Dijkstra's algorithm more seriously this time.

But I'll try, no promises though

##### Share on other sites

Thanks pBe

Tnks for ur patience. Can u please tell me which part i need to modify in this lisp for Open polygons. For my side it difficult to me, Because i am Newbie to Autolisp.

##### Share on other sites

Hi, chaps...

Recently, I've checked my code I posted above on A2012, and it fails - it skips some vertices, but on A2009 on the same PC it works fine... Can someone confirm what I am saying... What could cause this bug?

Nevertheless, pBe code works fine - still I was unable to understand it all and as I had some free time I've formatted code so it just looks better for my eyes and I suppose for someone that wants to analyze it...

Thanks to pBe for the code and hoping that won't mind for my remarks ab formatting - nowadays I see improvement on that manner...

Cheers...

M.R.

```([color=BLUE]defun[/color] [color=BLUE]c:PlPath[/color] ( [color=BLUE]/[/color] LM:ListClockwise-p LM:Unique AT:GetVertices _Buildlist _FindPoint _Rebuild _FindNext
sp ep ss opt i a Pls PtlSt )

([color=BLUE]defun[/color] LM:ListClockwise-p ( lst )
([color=BLUE]minusp[/color]
([color=BLUE]apply[/color] '[color=BLUE]+[/color]
([color=BLUE]mapcar[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( a b )
)
) lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
)
)
)
)

([color=BLUE]defun[/color] LM:Unique ( lst )
([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (LM:Unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] AT:GetVertices ( e [color=BLUE]/[/color] p l )
;; Alan J. Thompson, 09.30.10
(LM:Unique
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] p ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] p)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getPointAtParam[/color] e ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getStartPoint[/color] e) ([color=BLUE]vlax-curve-getEndPoint[/color] e))
)
)
)
)

([color=BLUE]defun[/color] _Buildlist ( pt ls )
([color=BLUE]setq[/color] Pt (_FindPoint sp ls)
Pt ([color=BLUE]append[/color]
([color=BLUE]car[/color] Pt)
([color=BLUE]vl-remove-if[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( q ) ([color=BLUE]member[/color] q ([color=BLUE]car[/color] Pt)))
)
([color=BLUE]setq[/color] [color=BLUE]nl[/color] ([color=BLUE]nth[/color] ([color=BLUE]cadr[/color] Pt) ls))
)
)
ls ([color=BLUE]vl-remove[/color] [color=BLUE]nl[/color] ls)
)
([color=BLUE]list[/color] Pt ls)
)

([color=BLUE]defun[/color] _FindPoint ( v l [color=BLUE]/[/color] a b c d )
([color=BLUE]setq[/color] d -1)
([color=BLUE]while[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] l))
([color=BLUE]not[/color] c)
)
([color=BLUE]setq[/color] d ([color=BLUE]1+[/color] d))
([color=BLUE]if[/color] ([color=BLUE]setq[/color] b ([color=BLUE]member[/color] v a))
([color=BLUE]setq[/color] c ([color=BLUE]cons[/color] b c))
)
([color=BLUE]setq[/color] l ([color=BLUE]vl-remove[/color] a l))
)
([color=BLUE]list[/color] ([color=BLUE]car[/color] c) d)
)

([color=BLUE]defun[/color] _Rebuild ( v ls_ )
([color=BLUE]foreach[/color] s ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] v ls_))
([color=BLUE]setq[/color] ls_ ([color=BLUE]vl-remove[/color] s ls_))
)
ls_
)

([color=BLUE]defun[/color] _FindNext ( l1 l2 [color=BLUE]/[/color] f g )
([color=BLUE]while[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] f ([color=BLUE]car[/color] l1))
([color=BLUE]not[/color] g)
)
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]setq[/color] g ([color=BLUE]car[/color] (_FindPoint f l2))))
([color=BLUE]setq[/color] l1 ([color=BLUE]cdr[/color] l1))
)
)
([color=BLUE]car[/color] g)
)

([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] Lst [color=BLUE]nil[/color] PtlSt [color=BLUE]nil[/color]
sp ([color=BLUE]getpoint[/color] [color=BROWN]"\nSelect Start Point:"[/color])
)
([color=BLUE]setq[/color] ep ([color=BLUE]getpoint[/color] sp [color=BROWN]"\nSelect End Point:"[/color]))
([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]) (-4 . [color=BROWN]"&="[/color]) (70 . 1) (410 . [color=BROWN]"MODEL"[/color]))))
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 1 [color=BROWN]"T B"[/color])
([color=BLUE]setq[/color] opt ([color=BLUE]getkword[/color] [color=BROWN]"\nSelect option [Top/Bottom]: "[/color]))
opt
)
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
([color=BLUE]setq[/color] a (AT:GetVertices ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"B"[/color])
([color=BLUE]setq[/color] a ([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]reverse[/color] a)
a
)
)
([color=BLUE]setq[/color] a ([color=BLUE]if[/color] (LM:ListClockwise-p a)
a
([color=BLUE]reverse[/color] a)
)
)
)
([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] a lst))
)
([color=BLUE]repeat[/color] ([color=BLUE]length[/color] lst)
([color=BLUE]setq[/color] Pls (_Buildlist sp lst)
PtlSt ([color=BLUE]cons[/color] ([color=BLUE]car[/color] Pls) PtlSt)
)
([color=BLUE]setq[/color] sp (_FindNext ([color=BLUE]car[/color] PtlSt) lst))
([color=BLUE]setq[/color] PtlSt ([color=BLUE]subst[/color] (_Rebuild sp ([color=BLUE]car[/color] PtlSt)) ([color=BLUE]car[/color] PtlSt) PtlSt))
)
([color=BLUE]setq[/color] PtlSt
(LM:Unique
([color=BLUE]apply[/color] '[color=BLUE]append[/color]
([color=BLUE]reverse[/color]
([color=BLUE]subst[/color] (_Rebuild ep ([color=BLUE]car[/color] PtlSt)) ([color=BLUE]car[/color] PtlSt) PtlSt)
)
)
)
)
)
([color=BLUE]progn[/color]
([color=BLUE]entmakex[/color]
([color=BLUE]append[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbEntity"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbPolyline"[/color])
([color=BLUE]cons[/color] 90 ([color=BLUE]length[/color] PtlSt))
([color=BLUE]cons[/color] 70 0)
)
([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( p ) ([color=BLUE]cons[/color] 10 p))) PtlSt)
)
)
)
)
([color=BLUE]princ[/color])
)
```

Edited by marko_ribar
changed AT:getvertices with supplied LM:Unique

##### Share on other sites

After I analyzed pBe's code, I discovered that original AT:Getvertices subfunction here isn't applicable like it was - if picked for start point the same point as start point of first polygon, plpath.lsp will draw polyline from next vertex, but not start... So I removed duplicate start-end point in AT:Getvertices, and _Rebuild subfunction from plpath.lsp should return correct list of points... Also corrected one more localized variable in _FindNext subfunction - variable h was sufficient...

Can someone confirm bug that occurs on A2012 with mine lisp 2pl-pl.lsp posted above, or it's my comp. that has this bug...?

Regards, M.R.

##### Share on other sites

Can someone confirm bug that occurs on A2012 with mine lisp 2pl-pl.lsp posted above, or it's my comp. that has this bug...?

I didn't really go into details on this routine Marko . If it is indeed flawed what is your solution then?. To be honest, can't remember what the routine is for

##### Share on other sites

pBe - look at the picture posted at first OP request... Please, inform me for 2pl-pl.lsp on A2012 and versions above - is it working without skipping vertices...

In addition, I've modified your code further more to accept arcs - so polygon can be real closed LWPOLYLINE...

Test it also, as I only briefly tested...

```([color=BLUE]defun[/color] [color=BLUE]c:PlPath[/color] ( [color=BLUE]/[/color] AssocOn LM:ListClockwise-p LM:Unique AT:GetVertices MR:GetBulge _intl [color=BLUE]prelst[/color] [color=BLUE]suflst[/color] _Buildlist
sp ep ss opt i pl pll a b bb ab lst lstab Pls PtlSt PtBulg PttBulg )

([color=BLUE]defun[/color] AssocOn ( SearchTerm Lst func fuzz )
([color=BLUE]car[/color]
([color=BLUE]vl-member-if[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] (pair) ([color=BLUE]equal[/color] SearchTerm ([color=BLUE]apply[/color] func ([color=BLUE]list[/color] pair)) fuzz))
)
lst
)
)
)

([color=BLUE]defun[/color] LM:ListClockwise-p ( lst )
([color=BLUE]minusp[/color]
([color=BLUE]apply[/color] '[color=BLUE]+[/color]
([color=BLUE]mapcar[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( a b )
)
) lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
)
)
)
)

([color=BLUE]defun[/color] LM:Unique ( lst )
([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (LM:Unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] AT:GetVertices ( e [color=BLUE]/[/color] p l )
;; Alan J. Thompson, 09.30.10
(LM:Unique
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] p ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] p)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getPointAtParam[/color] e ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getStartPoint[/color] e) ([color=BLUE]vlax-curve-getEndPoint[/color] e))
)
)
)
)

([color=BLUE]defun[/color] MR:GetBulge ( e [color=BLUE]/[/color] o p l )
([color=BLUE]cond[/color] ( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'ENAME)
([color=BLUE]setq[/color] o ([color=BLUE]vlax-ename->vla-object[/color] e)) )
( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'VLA-OBJECT)
([color=BLUE]setq[/color] o e) )
)
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]fix[/color] p)
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vla-getbulge[/color] o ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
)
)
)

([color=BLUE]defun[/color] _intl (l1 l2 [color=BLUE]/[/color] ll1 ll2 a ls1 ls2)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll2))
([color=BLUE]while[/color] ll1
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll1) 1e-
([color=BLUE]setq[/color] ls1 ([color=BLUE]append[/color] ls1 ([color=BLUE]list[/color] a))
ll1 ([color=BLUE]cdr[/color] ll1)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1))
)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2)
ll1 ([color=BLUE]vl-remove[/color] a l1)
)
)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll1))
([color=BLUE]while[/color] ll2
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll2) 1e-
([color=BLUE]setq[/color] ls2 ([color=BLUE]append[/color] ls2 ([color=BLUE]list[/color] a))
ll2 ([color=BLUE]cdr[/color] ll2)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2))
)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1)
ll2 ([color=BLUE]vl-remove[/color] a l2)
)
)
([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]length[/color] ls1) ([color=BLUE]length[/color] ls2)) ls1 ls2)
)

([color=BLUE]defun[/color] [color=BLUE]prelst[/color] ( lst el [color=BLUE]/[/color] f )
([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]or[/color] f ([color=BLUE]setq[/color] f ([color=BLUE]equal[/color] a el 1e-))) lst)
)

([color=BLUE]defun[/color] [color=BLUE]suflst[/color] ( lst el )
([color=BLUE]cdr[/color] ([color=BLUE]vl-member-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]equal[/color] a el 1e-) lst))
)

([color=BLUE]defun[/color] _Buildlist ( sp lst )
([color=BLUE]append[/color] ([color=BLUE]list[/color] sp) ([color=BLUE]suflst[/color] lst sp) ([color=BLUE]prelst[/color] lst sp))
)

([color=BLUE]setq[/color] sp ([color=BLUE]getpoint[/color] [color=BROWN]"\nSelect Start Point:"[/color]))
([color=BLUE]setq[/color] ep ([color=BLUE]getpoint[/color] sp [color=BROWN]"\nSelect End Point:"[/color]))
([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]) (-4 . [color=BROWN]"&="[/color]) (70 . 1) (410 . [color=BROWN]"MODEL"[/color]))))
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 1 [color=BROWN]"T B"[/color])
([color=BLUE]setq[/color] opt ([color=BLUE]getkword[/color] [color=BROWN]"\nSelect option [Top/Bottom]: "[/color]))
)
([color=BLUE]setq[/color] pl ([color=BLUE]car[/color] ([color=BLUE]nentselp[/color] sp)))
([color=BLUE]while[/color] ([color=BLUE]>=[/color] ([color=BLUE]sslength[/color] ss) 1)
([color=BLUE]setq[/color] a (AT:GetVertices pl))
([color=BLUE]setq[/color] b (MR:GetBulge pl))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"T"[/color])
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
)
([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] a lst) lstab ([color=BLUE]cons[/color] ab lstab))
([color=BLUE]ssdel[/color] pl ss)
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-safearray->list[/color] ([color=BLUE]list[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-variant-value[/color] ([color=BLUE]list[/color] ([color=BLUE]vla-intersectwith[/color] ([color=BLUE]vlax-ename->vla-object[/color] pl) ([color=BLUE]vlax-ename->vla-object[/color] ent) [color=BLUE]AcExtendNone[/color])))))))
([color=BLUE]setq[/color] pll ent)
)
)
([color=BLUE]if[/color] pll ([color=BLUE]setq[/color] pl pll))
)
([color=BLUE]setq[/color] i -1)
([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst) lstab ([color=BLUE]reverse[/color] lstab))
([color=BLUE]while[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) ([color=BLUE]length[/color] lst))
([color=BLUE]setq[/color] Pls (_Buildlist sp ([color=BLUE]nth[/color] i lst)))
([color=BLUE]if[/color] ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst)
([color=BLUE]setq[/color] sp ([color=BLUE]car[/color] (_intl Pls ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst))))
([color=BLUE]setq[/color] sp ep)
)
([color=BLUE]setq[/color] Pls ([color=BLUE]prelst[/color] Pls sp))
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt Pls))
)
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt ([color=BLUE]list[/color] ep)))
([color=BLUE]foreach[/color] pt PtlSt
([color=BLUE]if[/color] ([color=BLUE]assoc[/color] ep ([color=BLUE]car[/color] lstab))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]reverse[/color] lstab))) '[color=BLUE]car[/color] 1e-6)) PtBulg))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] lstab)) '[color=BLUE]car[/color] 1e-6)) PtBulg))
)
)
([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]if[/color] ([color=BLUE]equal[/color] x [color=BLUE]nil[/color]) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] 0.0 PttBulg)) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] x PttBulg)))) PtBulg)
([color=BLUE]entmakex[/color]
([color=BLUE]append[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbEntity"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbPolyline"[/color])
([color=BLUE]cons[/color] 90 ([color=BLUE]length[/color] PtlSt))
([color=BLUE]cons[/color] 70 0)
)
([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( p b ) ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 10 p) ([color=BLUE]cons[/color] 42 b)))) PtlSt PttBulg))
)
)
([color=BLUE]princ[/color])
)
```

M.R.

Edited by marko_ribar
code updated with AssocOn subfunction

##### Share on other sites

In addition to my last code, I am posting this one that adds vertexes to selected polylines at all intersection points with all other objects... So these two can be combined to quickly get resulting PlPath... Just run this code firstly...

```([color=BLUE]vl-load-com[/color])
([color=BLUE]princ[/color])

([color=BLUE]defun[/color] [color=BLUE]c:plintav[/color] ( [color=BLUE]/[/color] intersobj1obj2 LM:Unique AT:GetVertices _reml member-fuzz add_vtx
ss sspl i ent n ent1 ss-ent1 k ent2 intpts intptsall pl plpts restintpts par )

([color=BLUE]defun[/color] intersobj1obj2 ( obj1 obj2 [color=BLUE]/[/color] coords pt ptlst )
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]type[/color] obj1) 'ENAME) ([color=BLUE]setq[/color] obj1 ([color=BLUE]vlax-ename->vla-object[/color] obj1)))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]type[/color] obj2) 'ENAME) ([color=BLUE]setq[/color] obj2 ([color=BLUE]vlax-ename->vla-object[/color] obj2)))
([color=BLUE]setq[/color] coords ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-safearray->list[/color] ([color=BLUE]list[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-variant-value[/color] ([color=BLUE]list[/color] ([color=BLUE]vla-intersectwith[/color] obj1 obj2 [color=BLUE]AcExtendNone[/color]))))))
([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] coords)
([color=BLUE]setq[/color] ptlst [color=BLUE]nil[/color])
([color=BLUE]repeat[/color] ([color=BLUE]/[/color] ([color=BLUE]length[/color] coords) 3)
([color=BLUE]setq[/color] ptlst ([color=BLUE]cons[/color] pt ptlst))
([color=BLUE]setq[/color] coords ([color=BLUE]cdddr[/color] coords))
)
)
ptlst
)

([color=BLUE]defun[/color] LM:Unique ( lst )
([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (LM:Unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] AT:GetVertices ( e [color=BLUE]/[/color] p l )
(LM:Unique
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] p ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] p)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getPointAtParam[/color] e ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getStartPoint[/color] e) ([color=BLUE]vlax-curve-getEndPoint[/color] e))
)
)
)
)

([color=BLUE]defun[/color] _reml ( l1 l2 [color=BLUE]/[/color] a n ls )
([color=BLUE]while[/color]
([color=BLUE]setq[/color] n [color=BLUE]nil[/color]
a ([color=BLUE]car[/color] l2)
)
([color=BLUE]while[/color] ([color=BLUE]and[/color] l1 ([color=BLUE]null[/color] n))
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] l1) 1e-
([color=BLUE]setq[/color] l1 ([color=BLUE]cdr[/color] l1)
n [color=BLUE]t[/color]
)
([color=BLUE]setq[/color] ls ([color=BLUE]append[/color] ls ([color=BLUE]list[/color] ([color=BLUE]car[/color] l1)))
l1 ([color=BLUE]cdr[/color] l1)
)
)
)
([color=BLUE]setq[/color] l2 ([color=BLUE]cdr[/color] l2))
)
([color=BLUE]append[/color] ls l1)
)

([color=BLUE]defun[/color] member-fuzz ( expr lst fuzz )
([color=BLUE]while[/color] ([color=BLUE]and[/color] lst ([color=BLUE]not[/color] ([color=BLUE]equal[/color] ([color=BLUE]car[/color] lst) expr fuzz)))
([color=BLUE]setq[/color] lst ([color=BLUE]cdr[/color] lst))
)
lst
)

obj
([color=BLUE]vlax-make-variant[/color]
([color=BLUE]vlax-safearray-fill[/color]
([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbdouble[/color] ([color=BLUE]cons[/color] 0 1))
([color=BLUE]list[/color]
([color=BLUE]car[/color] ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getpointatparam[/color] obj add_pt) 0 ent_name))
)
)
)
)
([color=BLUE]setq[/color] bulg ([color=BLUE]vla-GetBulge[/color] obj ([color=BLUE]fix[/color] add_pt)))
([color=BLUE]vla-SetBulge[/color] obj
([color=BLUE]/[/color]
)
)
([color=BLUE]vla-SetBulge[/color] obj
([color=BLUE]/[/color]
([color=BLUE]sin[/color] ([color=BLUE]/[/color] ([color=BLUE]*[/color] 4 ([color=BLUE]atan[/color] bulg) ([color=BLUE]-[/color] ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] add_pt)) add_pt)) 4))
([color=BLUE]cos[/color] ([color=BLUE]/[/color] ([color=BLUE]*[/color] 4 ([color=BLUE]atan[/color] bulg) ([color=BLUE]-[/color] ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] add_pt)) add_pt)) 4))
)
)
([color=BLUE]vla-update[/color] obj)
)

([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] [color=BROWN]"_:L"[/color] '((0 . [color=BROWN]"*LINE,RAY,ELLIPSE,CIRCLE,ARC"[/color]))))
([color=BLUE]setq[/color] i -1)
([color=BLUE]while[/color] ([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i))))
([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ent))) [color=BROWN]"*POLYLINE"[/color])
)
)
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] n ([color=BLUE]sslength[/color] ss))
([color=BLUE]setq[/color] ent1 ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] n ([color=BLUE]1-[/color] n))))
([color=BLUE]setq[/color] ss-ent1 ([color=BLUE]ssdel[/color] ent1 ss))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] k ([color=BLUE]sslength[/color] ss-ent1))
([color=BLUE]setq[/color] ent2 ([color=BLUE]ssname[/color] ss-ent1 ([color=BLUE]setq[/color] k ([color=BLUE]1-[/color] k))))
([color=BLUE]setq[/color] intpts (intersobj1obj2 ent1 ent2))
([color=BLUE]setq[/color] intptsall ([color=BLUE]append[/color] intpts intptsall))
)
)
([color=BLUE]setq[/color] i -1)
([color=BLUE]while[/color] ([color=BLUE]setq[/color] pl ([color=BLUE]ssname[/color] sspl ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i))))
([color=BLUE]setq[/color] plpts (AT:GetVertices pl))
([color=BLUE]setq[/color] restintpts (_reml intptsall plpts))
([color=BLUE]foreach[/color] pt restintpts
([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]not[/color] (member-fuzz pt plpts 1e-6))
([color=BLUE]setq[/color] par ([color=BLUE]vlax-curve-getparamatpoint[/color] pl pt))
)
)
)
)
([color=BLUE]princ[/color])
)
```

M.R.

##### Share on other sites

In addition, I've modified your code further more to accept arcs - so polygon can be real closed LWPOLYLINE...

Test it also, as I only briefly tested...

Code changed further more. It had lacks, and even now if trying it in various cases - it may confuse bulges... If firstly created LWPOLYLINE through BPOLY command from multiple LWPOLYLINES than it should work well...

M.R.

##### Share on other sites

What is computer... The code was all correct only (assoc) function didn't work with fuzz factor because it doesn't have... So I implemented AssocOn subfunction with fuzz 1e-6 and now it should work perfect...

So check code here

Regards, M.R.

##### Share on other sites

Assuming that you have A2010 or above 2011, 2012, ...

And assuming that you applied c:plintav posted in my previous post, this should work and for opened LWPOLYLINES, just make sure path is possible (no gaps, or common intersection points - that are made with c:plintav)...

```([color=BLUE]defun[/color] [color=BLUE]c:PlPath[/color] ( [color=BLUE]/[/color] AssocOn LM:ListClockwise-p LM:Unique AT:GetVertices MR:GetBulge _intl [color=BLUE]prelst[/color] [color=BLUE]suflst[/color] _Buildlist
sp ep ss opt i pl pll a b bb ab lst lstab Pls PtlSt PtBulg PttBulg )

([color=BLUE]defun[/color] AssocOn ( SearchTerm Lst func fuzz )
([color=BLUE]car[/color]
([color=BLUE]vl-member-if[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] (pair) ([color=BLUE]equal[/color] SearchTerm ([color=BLUE]apply[/color] func ([color=BLUE]list[/color] pair)) fuzz))
)
lst
)
)
)

([color=BLUE]defun[/color] LM:ListClockwise-p ( lst )
([color=BLUE]minusp[/color]
([color=BLUE]apply[/color] '[color=BLUE]+[/color]
([color=BLUE]mapcar[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( a b )
)
) lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
)
)
)
)

([color=BLUE]defun[/color] LM:Unique ( lst )
([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (LM:Unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] AT:GetVertices ( e [color=BLUE]/[/color] p l )
;; Alan J. Thompson, 09.30.10
(LM:Unique
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] p ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] p)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getPointAtParam[/color] e ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getStartPoint[/color] e) ([color=BLUE]vlax-curve-getEndPoint[/color] e))
)
)
)
)

([color=BLUE]defun[/color] MR:GetBulge ( e [color=BLUE]/[/color] o p l )
([color=BLUE]cond[/color] ( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'ENAME)
([color=BLUE]setq[/color] o ([color=BLUE]vlax-ename->vla-object[/color] e)) )
( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'VLA-OBJECT)
([color=BLUE]setq[/color] o e) )
)
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]fix[/color] p)
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vla-getbulge[/color] o ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
)
)
)

([color=BLUE]defun[/color] _intl (l1 l2 [color=BLUE]/[/color] ll1 ll2 a ls1 ls2)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll2))
([color=BLUE]while[/color] ll1
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll1) 1e-
([color=BLUE]setq[/color] ls1 ([color=BLUE]append[/color] ls1 ([color=BLUE]list[/color] a))
ll1 ([color=BLUE]cdr[/color] ll1)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1))
)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2)
ll1 ([color=BLUE]vl-remove[/color] a l1)
)
)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll1))
([color=BLUE]while[/color] ll2
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll2) 1e-
([color=BLUE]setq[/color] ls2 ([color=BLUE]append[/color] ls2 ([color=BLUE]list[/color] a))
ll2 ([color=BLUE]cdr[/color] ll2)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2))
)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1)
ll2 ([color=BLUE]vl-remove[/color] a l2)
)
)
([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]length[/color] ls1) ([color=BLUE]length[/color] ls2)) ls1 ls2)
)

([color=BLUE]defun[/color] [color=BLUE]prelst[/color] ( lst el [color=BLUE]/[/color] f )
([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]or[/color] f ([color=BLUE]setq[/color] f ([color=BLUE]equal[/color] a el 1e-))) lst)
)

([color=BLUE]defun[/color] [color=BLUE]suflst[/color] ( lst el )
([color=BLUE]cdr[/color] ([color=BLUE]vl-member-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]equal[/color] a el 1e-) lst))
)

([color=BLUE]defun[/color] _Buildlist ( sp lst )
([color=BLUE]append[/color] ([color=BLUE]list[/color] sp) ([color=BLUE]suflst[/color] lst sp) ([color=BLUE]prelst[/color] lst sp))
)

([color=BLUE]setq[/color] sp ([color=BLUE]getpoint[/color] [color=BROWN]"\nSelect Start Point:"[/color]))
([color=BLUE]setq[/color] ep ([color=BLUE]getpoint[/color] sp [color=BROWN]"\nSelect End Point:"[/color]))
([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]) (-4 . [color=BROWN]"&="[/color]) (70 . 0) (410 . [color=BROWN]"MODEL"[/color]))))
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 1 [color=BROWN]"T B"[/color])
([color=BLUE]setq[/color] opt ([color=BLUE]getkword[/color] [color=BROWN]"\nSelect option [Top/Bottom]: "[/color]))
)
([color=BLUE]setq[/color] pl ([color=BLUE]car[/color] ([color=BLUE]nentselp[/color] sp)))
([color=BLUE]while[/color] ([color=BLUE]>=[/color] ([color=BLUE]sslength[/color] ss) 1)
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"T"[/color])
([color=BLUE]if[/color] ([color=BLUE]not[/color] (LM:ListClockwise-p (AT:GetVertices pl)))
([color=BLUE]command[/color] [color=BROWN]"_.reverse"[/color] pl [color=BROWN]""[/color])
)
([color=BLUE]if[/color] (LM:ListClockwise-p (AT:GetVertices pl))
([color=BLUE]command[/color] [color=BROWN]"_.reverse"[/color] pl [color=BROWN]""[/color])
)
)
([color=BLUE]setq[/color] a (AT:GetVertices pl))
([color=BLUE]setq[/color] b (MR:GetBulge pl))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"T"[/color])
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
)
([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] a lst) lstab ([color=BLUE]cons[/color] ab lstab))
([color=BLUE]ssdel[/color] pl ss)
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-safearray->list[/color] ([color=BLUE]list[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-variant-value[/color] ([color=BLUE]list[/color] ([color=BLUE]vla-intersectwith[/color] ([color=BLUE]vlax-ename->vla-object[/color] pl) ([color=BLUE]vlax-ename->vla-object[/color] ent) [color=BLUE]AcExtendNone[/color])))))))
([color=BLUE]setq[/color] pll ent)
)
)
([color=BLUE]if[/color] pll ([color=BLUE]setq[/color] pl pll))
)
([color=BLUE]setq[/color] i -1)
([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst) lstab ([color=BLUE]reverse[/color] lstab))
([color=BLUE]while[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) ([color=BLUE]length[/color] lst))
([color=BLUE]setq[/color] Pls (_Buildlist sp ([color=BLUE]nth[/color] i lst)))
([color=BLUE]if[/color] ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst)
([color=BLUE]setq[/color] sp ([color=BLUE]car[/color] (_intl Pls ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst))))
([color=BLUE]setq[/color] sp ep)
)
([color=BLUE]setq[/color] Pls ([color=BLUE]prelst[/color] Pls sp))
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt Pls))
)
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt ([color=BLUE]list[/color] ep)))
([color=BLUE]foreach[/color] pt PtlSt
([color=BLUE]if[/color] ([color=BLUE]assoc[/color] ep ([color=BLUE]car[/color] lstab))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]reverse[/color] lstab))) '[color=BLUE]car[/color] 1e-6)) PtBulg))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] lstab)) '[color=BLUE]car[/color] 1e-6)) PtBulg))
)
)
([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]if[/color] ([color=BLUE]equal[/color] x [color=BLUE]nil[/color]) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] 0.0 PttBulg)) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] x PttBulg)))) PtBulg)
([color=BLUE]entmakex[/color]
([color=BLUE]append[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbEntity"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbPolyline"[/color])
([color=BLUE]cons[/color] 90 ([color=BLUE]length[/color] PtlSt))
([color=BLUE]cons[/color] 70 0)
)
([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( p b ) ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 10 p) ([color=BLUE]cons[/color] 42 b)))) PtlSt PttBulg))
)
)
([color=BLUE]princ[/color])
)
```

P.S. This is my best - I couldn't think of anything better than checking top/bottom option and perform REVERSE command on those plines that omit rule of the same CW or CCW direction...

M.R.

Edited by marko_ribar
code changed finally

##### Share on other sites

Code changed finally...

All the best M.R.

##### Share on other sites

Final version

```([color=BLUE]defun[/color] [color=BLUE]c:PlPath[/color] ( [color=BLUE]/[/color] rlw AssocOn LM:ListClockwise-p LM:Unique AT:GetVertices MR:GetBulge _intl prelst suflst _Buildlist
sp ep ss opt i pl pll a b bb ab lst lstab Pls PtlSt PtBulg PttBulg )

([color=BLUE]defun[/color] rlw (LW [color=BLUE]/[/color] E X1 X2 X3 X4 X5 X6)
;; by ElpanovEvgeniy
;; reverse lwpolyline
([color=BLUE]if[/color] ([color=BLUE]=[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] lw)))) [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]progn[/color] ([color=BLUE]foreach[/color] a1 e
([color=BLUE]cond[/color] (([color=BLUE]=[/color] ([color=BLUE]car[/color] a1) 10) ([color=BLUE]setq[/color] x2 ([color=BLUE]cons[/color] a1 x2)))
(([color=BLUE]=[/color] ([color=BLUE]car[/color] a1) 40) ([color=BLUE]setq[/color] x4 ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] 41 ([color=BLUE]cdr[/color] a1)) x4)))
(([color=BLUE]=[/color] ([color=BLUE]car[/color] a1) 41) ([color=BLUE]setq[/color] x3 ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] 40 ([color=BLUE]cdr[/color] a1)) x3)))
(([color=BLUE]=[/color] ([color=BLUE]car[/color] a1) 42) ([color=BLUE]setq[/color] x5 ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] 42 ([color=BLUE]-[/color] ([color=BLUE]cdr[/color] a1))) x5)))
(([color=BLUE]=[/color] ([color=BLUE]car[/color] a1) 210) ([color=BLUE]setq[/color] x6 ([color=BLUE]cons[/color] a1 x6)))
([color=BLUE]t[/color] ([color=BLUE]setq[/color] x1 ([color=BLUE]cons[/color] a1 x1)))
)
)
([color=BLUE]entmod[/color] ([color=BLUE]append[/color] ([color=BLUE]reverse[/color] x1)
([color=BLUE]append[/color] ([color=BLUE]apply[/color] ([color=BLUE]function[/color] [color=BLUE]append[/color])
([color=BLUE]apply[/color] ([color=BLUE]function[/color] [color=BLUE]mapcar[/color])
([color=BLUE]cons[/color] '[color=BLUE]list[/color]
([color=BLUE]list[/color] x2
([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] x3) ([color=BLUE]reverse[/color] x3))))
([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] x4) ([color=BLUE]reverse[/color] x4))))
([color=BLUE]cdr[/color] ([color=BLUE]reverse[/color] ([color=BLUE]cons[/color] ([color=BLUE]car[/color] x5) ([color=BLUE]reverse[/color] x5))))
)
)
)
)
x6
)
)
)
([color=BLUE]entupd[/color] lw)
)
)
)

([color=BLUE]defun[/color] AssocOn ( SearchTerm Lst func fuzz )
([color=BLUE]car[/color]
([color=BLUE]vl-member-if[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] (pair) ([color=BLUE]equal[/color] SearchTerm ([color=BLUE]apply[/color] func ([color=BLUE]list[/color] pair)) fuzz))
)
lst
)
)
)

([color=BLUE]defun[/color] LM:ListClockwise-p ( lst )
([color=BLUE]minusp[/color]
([color=BLUE]apply[/color] '[color=BLUE]+[/color]
([color=BLUE]mapcar[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( a b )
)
) lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
)
)
)
)

([color=BLUE]defun[/color] LM:Unique ( lst )
([color=BLUE]if[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]car[/color] lst) (LM:Unique ([color=BLUE]vl-remove[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cdr[/color] lst)))))
)

([color=BLUE]defun[/color] AT:GetVertices ( e [color=BLUE]/[/color] p l )
;; Alan J. Thompson, 09.30.10
(LM:Unique
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] p ([color=BLUE]1+[/color] ([color=BLUE]fix[/color] p)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getPointAtParam[/color] e ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getStartPoint[/color] e) ([color=BLUE]vlax-curve-getEndPoint[/color] e))
)
)
)
)

([color=BLUE]defun[/color] MR:GetBulge ( e [color=BLUE]/[/color] o p l )
([color=BLUE]cond[/color] ( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'ENAME)
([color=BLUE]setq[/color] o ([color=BLUE]vlax-ename->vla-object[/color] e)) )
( ([color=BLUE]eq[/color] ([color=BLUE]type[/color] e) 'VLA-OBJECT)
([color=BLUE]setq[/color] o e) )
)
([color=BLUE]if[/color] e
([color=BLUE]if[/color] ([color=BLUE]eq[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vlax-curve-getEndParam[/color] e)) ([color=BLUE]fix[/color] p))
([color=BLUE]repeat[/color] ([color=BLUE]fix[/color] p)
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vla-getbulge[/color] o ([color=BLUE]setq[/color] p ([color=BLUE]1-[/color] p))) l))
)
)
)
)

([color=BLUE]defun[/color] _intl (l1 l2 [color=BLUE]/[/color] ll1 ll2 a ls1 ls2)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll2))
([color=BLUE]while[/color] ll1
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll1) 1e-
([color=BLUE]setq[/color] ls1 ([color=BLUE]append[/color] ls1 ([color=BLUE]list[/color] a))
ll1 ([color=BLUE]cdr[/color] ll1)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1))
)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2)
ll1 ([color=BLUE]vl-remove[/color] a l1)
)
)
([color=BLUE]setq[/color] ll1 l1
ll2 l2
)
([color=BLUE]while[/color]
([color=BLUE]setq[/color] a ([color=BLUE]car[/color] ll1))
([color=BLUE]while[/color] ll2
([color=BLUE]if[/color] ([color=BLUE]equal[/color] a ([color=BLUE]car[/color] ll2) 1e-
([color=BLUE]setq[/color] ls2 ([color=BLUE]append[/color] ls2 ([color=BLUE]list[/color] a))
ll2 ([color=BLUE]cdr[/color] ll2)
)
([color=BLUE]setq[/color] ll2 ([color=BLUE]cdr[/color] ll2))
)
)
([color=BLUE]setq[/color] ll1 ([color=BLUE]cdr[/color] ll1)
ll2 ([color=BLUE]vl-remove[/color] a l2)
)
)
([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]length[/color] ls1) ([color=BLUE]length[/color] ls2)) ls1 ls2)
)

([color=BLUE]defun[/color] prelst ( lst el [color=BLUE]/[/color] f )
([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]or[/color] f ([color=BLUE]setq[/color] f ([color=BLUE]equal[/color] a el 1e-))) lst)
)

([color=BLUE]defun[/color] suflst ( lst el )
([color=BLUE]cdr[/color] ([color=BLUE]vl-member-if[/color] '([color=BLUE]lambda[/color] ( a ) ([color=BLUE]equal[/color] a el 1e-) lst))
)

([color=BLUE]defun[/color] _Buildlist ( sp lst )
([color=BLUE]append[/color] ([color=BLUE]list[/color] sp) ([color=BLUE]suflst[/color] lst sp) ([color=BLUE]prelst[/color] lst sp))
)

([color=BLUE]setq[/color] sp ([color=BLUE]getpoint[/color] [color=BROWN]"\nSelect Start Point:"[/color]))
([color=BLUE]setq[/color] ep ([color=BLUE]getpoint[/color] sp [color=BROWN]"\nSelect End Point:"[/color]))
([color=BLUE]setq[/color] ss ([color=BLUE]ssget[/color] '((0 . [color=BROWN]"LWPOLYLINE"[/color]) (-4 . [color=BROWN]"&="[/color]) (70 . 0) (410 . [color=BROWN]"MODEL"[/color]))))
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 1 [color=BROWN]"T B"[/color])
([color=BLUE]setq[/color] opt ([color=BLUE]getkword[/color] [color=BROWN]"\nSelect option [Top/Bottom]: "[/color]))
)
([color=BLUE]setq[/color] pl ([color=BLUE]car[/color] ([color=BLUE]nentselp[/color] sp)))
([color=BLUE]while[/color] ([color=BLUE]>=[/color] ([color=BLUE]sslength[/color] ss) 1)
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"T"[/color])
([color=BLUE]if[/color] ([color=BLUE]not[/color] (LM:ListClockwise-p (AT:GetVertices pl)))
(rlw pl)
)
([color=BLUE]if[/color] (LM:ListClockwise-p (AT:GetVertices pl))
(rlw pl)
)
)
([color=BLUE]setq[/color] a (AT:GetVertices pl))
([color=BLUE]setq[/color] b (MR:GetBulge pl))
([color=BLUE]if[/color] ([color=BLUE]eq[/color] opt [color=BROWN]"T"[/color])
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
([color=BLUE]if[/color] (LM:ListClockwise-p a)
([color=BLUE]setq[/color] a ([color=BLUE]reverse[/color] a) b ([color=BLUE]reverse[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]*[/color] ([color=BLUE]-[/color] 1.0) x)) b)) bb ([color=BLUE]cdr[/color] b) b ([color=BLUE]append[/color] bb ([color=BLUE]list[/color] ([color=BLUE]car[/color] b))) ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
([color=BLUE]setq[/color] ab ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x y) ([color=BLUE]cons[/color] x y)) a b))
)
)
([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] a lst) lstab ([color=BLUE]cons[/color] ab lstab))
([color=BLUE]ssdel[/color] pl ss)
([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] ss))
([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] ss ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-safearray->list[/color] ([color=BLUE]list[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-variant-value[/color] ([color=BLUE]list[/color] ([color=BLUE]vla-intersectwith[/color] ([color=BLUE]vlax-ename->vla-object[/color] pl) ([color=BLUE]vlax-ename->vla-object[/color] ent) [color=BLUE]AcExtendNone[/color])))))))
([color=BLUE]setq[/color] pll ent)
)
)
([color=BLUE]if[/color] pll ([color=BLUE]setq[/color] pl pll))
)
([color=BLUE]setq[/color] i -1)
([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst) lstab ([color=BLUE]reverse[/color] lstab))
([color=BLUE]while[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) ([color=BLUE]length[/color] lst))
([color=BLUE]setq[/color] Pls (_Buildlist sp ([color=BLUE]nth[/color] i lst)))
([color=BLUE]if[/color] ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst)
([color=BLUE]setq[/color] sp ([color=BLUE]car[/color] (_intl Pls ([color=BLUE]nth[/color] ([color=BLUE]1+[/color] i) lst))))
([color=BLUE]setq[/color] sp ep)
)
([color=BLUE]setq[/color] Pls ([color=BLUE]prelst[/color] Pls sp))
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt Pls))
)
([color=BLUE]setq[/color] PtlSt ([color=BLUE]append[/color] PtlSt ([color=BLUE]list[/color] ep)))
([color=BLUE]foreach[/color] pt PtlSt
([color=BLUE]if[/color] ([color=BLUE]assoc[/color] ep ([color=BLUE]car[/color] lstab))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]reverse[/color] lstab))) '[color=BLUE]car[/color] 1e-6)) PtBulg))
([color=BLUE]setq[/color] PtBulg ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] (assocon pt ([color=BLUE]reverse[/color] ([color=BLUE]apply[/color] '[color=BLUE]append[/color] lstab)) '[color=BLUE]car[/color] 1e-6)) PtBulg))
)
)
([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] (x) ([color=BLUE]if[/color] ([color=BLUE]equal[/color] x [color=BLUE]nil[/color]) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] 0.0 PttBulg)) ([color=BLUE]setq[/color] PttBulg ([color=BLUE]cons[/color] x PttBulg)))) PtBulg)
([color=BLUE]entmakex[/color]
([color=BLUE]append[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=BROWN]"LWPOLYLINE"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbEntity"[/color])
([color=BLUE]cons[/color] 100 [color=BROWN]"AcDbPolyline"[/color])
([color=BLUE]cons[/color] 90 ([color=BLUE]length[/color] PtlSt))
([color=BLUE]cons[/color] 70 0)
)
([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( p b ) ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 10 p) ([color=BLUE]cons[/color] 42 b)))) PtlSt PttBulg))
)
)
([color=BLUE]princ[/color])
)
```

##### Share on other sites

@marko_ribar

Excellent result. Congratulations!

I think OP will be really satisfied with the goal.

## 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.

×   Pasted as rich text.   Paste as plain text instead

Only 75 emoji are allowed.