Topic: join lines

[domenicomaria]

. I draw a closed 2d polyline of segments only
  counterclockwise (about 20 segments at least)

. I explode the polyline

. the lines deriving from the exploded polyline have the direction of the points p10 and p11
  coincident with the direction they had when they belonged to the polyline

. I delete about half of these segments
  and I redraw them manually, in the opposite direction to the original polyline,
  so as to have a series of segments, which touch each other,
  and which represent the original polyline,
  but the direction of these segments, sometimes,
  does not agree with the direction of the original polyline

. I select all these lines, extract the pairs of points that define them
  and then I want to change the direction of these segments
  so that they define a shape either clockwise or counterclockwise.

. I can not make it !

. and I don't understand why!

. Can anyone help me ?

Code - Auto/Visual Lisp: [Select]

1. ;---------
2. (defun :STRING? (s)   (= (type s) 'STR)   )
3. ;---------
4. (defun :INT? (arg)   (= (type arg) 'INT)   )
5. ;---------
6. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
7.    (setq ssa (ssadd))
8.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
9.    (sssetfirst nil ssa) (ssget "_I")
10.    (if (> (sslength ssa) 0) ssa nil)
11. )
12. ;---------
13. (defun :3DPOLY-EMK-V-LST (v-lst)
14.    (entmake
15.       (append
16.          '(
17.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
18.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
19.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
20.          )
21.          (list (cons 62 (atoi (getvar "cecolor"))))
22.       )
23.    )
24.  
25.    (foreach   vrtx   v-lst
26.       (entmake
27.          (append
28.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
29.             (list (cons 10 vrtx) )
30.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
31.          )
32.       )
33.    )
34.  
35.    (entmake
36.       '( (0 . "SEQEND") (100 . "AcDbEntity") )  
37.    )
38. )
39. ;---------
40. (defun :LWDISPLAY-ON  () (setvar "lwdisplay" 1) )
41. ;---------
42. (defun :CELWEIGHT (clw) (setvar "celweight" clw) )
43. ;---------
44. (defun :CECOLOR (clr-str)
45.    (cond
46.       (   (:INT?    clr-str)   (setvar "cecolor" (itoa clr-str) ) )
47.       (   (:STRING? clr-str)   (setvar "cecolor" clr-str        ) )
48.    )
49. )
50. ;---------
51. (defun :SS-BEFORE-EN ( x-en / tmp )
52.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
53. )
54. ;---------
55. (defun :SS-BEFORE-EL (  / tmp x-en)
56.    (if(setq x-en (entlast) )
57.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
58.       nil
59.    )
60. )
61. ;---------
62. (defun LM:SSGET ( msg arg / sel )
63.     (princ msg)
64.     (setvar 'nomutt 1)
65.     (setq sel (vl-catch-all-apply 'ssget arg))
66.     (setvar 'nomutt 0)
67.     (if (not (vl-catch-all-error-p sel)) sel)
68. )
69.  
70. ;---------
71. (defun :GEOM-SEG-LST>POINT-LST-LST (x-seg-lst / kwi next-seg v-lst v-lst-lst x-seg )
72.    (while (> (length x-seg-lst) 1)
73.       (setq x-seg (car x-seg-lst)   x-seg-lst (cdr x-seg-lst) )
74.       (setq v-lst (list (car x-seg) ) )
75.       (setq kwi t)
76.       (while kwi
77.          (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) x-seg-lst) )
78.             (progn
79.                (setq v-lst (cons (cadr x-seg) v-lst) )
80.                (setq x-seg (car next-seg) )
81.                (setq x-seg-lst (vl-remove x-seg x-seg-lst) )
82.             )
83.             (progn
84.                (setq v-lst (cons (last v-lst) v-lst ) )
85.                (setq kwi nil)
86.             )
87.          )
88.       )
89.       (setq v-lst-lst (cons v-lst v-lst-lst) )
90.    )
91.    v-lst-lst
92. )
93.  
94. ;---------
95. (defun :SS>ENTGET-LIST (ss / IND L)
96.    (setq ind 0 l '())
97.    (repeat (sslength ss)
98.       (setq l (cons (entget (ssname ss ind) ) l) )      (setq ind (+ 1 ind) )
99.    )
100.    (reverse l)
101. )
102.  
103. ;---------
104. (defun :DXF (code elist) (cdr (assoc code elist)))
105.  
106.  
107. ;---------
108. (defun C:JOIN-LINES    (    /
109.                         eb mif v-lst v-lst-lst x-el x-seg x-seg-lst x-seg-lst-c
110.                          x-seg-lst-s x-ss x-ss-eg-lst
111.                      )
112.    
113.    
114.    (and
115.       (setq x-ss (LM:SSGET "\nselect LINES to JOIN <exit> :" '(((0 . "LINE"))) ) )
116.       (setq x-ss-eg-lst (:SS>ENTGET-LIST x-ss) )
117.       (setq x-seg-lst    (mapcar   '(lambda (x-el) (list (:DXF 10 x-el) (:DXF 11 x-el) ) )
118.                                  x-ss-eg-lst
119.                         )
120.       )
121.      
122.       (setq x-seg-lst-c x-seg-lst)
123.       (while (> (length x-seg-lst-c) 1)
124.          (setq x-seg (car x-seg-lst-c)   x-seg-lst-c (cdr x-seg-lst-c) )
125.          (setq   mif   (vl-member-if
126.                         '(lambda (i-seg)
127.                            (or (equal (car x-seg) (car i-seg) 1e-6) (equal (cadr x-seg) (cadr i-seg) 1e-6) )
128.                         )
129.                          x-seg-lst-c
130.                       )
131.          )
132.          (if mif
133.             (setq mif          (car mif)
134.                   x-seg-lst    (subst (reverse mif) mif x-seg-lst   )
135.                   x-seg-lst-c (subst (reverse mif) mif x-seg-lst-c )
136.             )
137.          )
138.       )
139.    )
140.      
141.    (setq v-lst-lst (:GEOM-SEG-LST>POINT-LST-LST x-seg-lst) )
142.    (vl-cmdf "erase" x-ss "")
143.    (setq eb (:SS-BEFORE-EL) ) (:CECOLOR 240) (:CELWEIGHT 35) (:LWDISPLAY-ON)
144.    (mapcar '(lambda (v-lst) (:3DPOLY-EMK-V-LST v-lst) ) v-lst-lst)
145.    (:SS-MAKE-PREVIOUS-EB eb)
146. )
147.  
148. (defun c:JL () (C:JOIN-LINES) )
149.  
150. (princ "\ntype JL ")

[VovKa]

is this problem the same as in https://www.theswamp.org/index.php?topic=58251.15 ?

[domenicomaria]

is this problem the same as in https://www.theswamp.org/index.php?topic=58251.15 ?

No.
For SHAPE of MESH, there is no problem.

The 2 solutions eliminating the coincident segments in two ways
- checking the coincidence of the midpoints
- comparing segments with segments that have opposite direction
work well.

If sometime doesn't work, it could depend from the analized data.

But normally, MS and MS2, work well.

And there is no problem related to JOIN LINES.

Because the prerequisite for using SHAPE-of-MESH
is that all 3dfaces have an anti-clockwise direction.

While in the case of JOIN LINES,
the assumption is that the segments can have both clockwise and anti-clockwise directions

[kasmo]

Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

[domenicomaria]

Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

 

No. I want solve without any acad command !

[ribarm]

Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?

[VovKa]

i have this
it is not optimized for lines
accepts segments on any length

Code: [Select]

(defun vk_MergeSegments (Segments / PolyLine PolyLines AdjSegment Fuzz _Find)
  (defun _Find (Point)
    (vl-some (function
       (lambda (Segment)
(cond ((equal (car Segment) Point Fuzz) (setq Segments (vl-remove Segment Segments)) Segment)
       ((equal (last Segment) Point Fuzz) (setq Segments (vl-remove Segment Segments)) (reverse Segment))
)
       )
     )
     Segments
    )
  )
  (setq Fuzz 1e-8)
  (setq Segments (vl-sort Segments (function (lambda (e1 e2) (< (caar e1) (caar e2)))))
PolyLine (car Segments)
Segments (cdr Segments)
  )
  (while Segments
    (if (or (setq AdjSegment (_Find (car PolyLine)))
    (and (setq AdjSegment (_Find (last PolyLine))) (setq PolyLine (reverse PolyLine)))
)
      (setq PolyLine (append (reverse (cdr AdjSegment)) PolyLine))
      (setq PolyLines (cons PolyLine PolyLines)
    PolyLine  (car Segments)
    Segments  (cdr Segments)
      )
    )
  )
  (cons PolyLine PolyLines)
)


[domenicomaria]

Thank you VovKa ...

... in the meantime I solved it too

and it also works with various segment groups

I will study your code, because what you do is always interesting !

if you want to do some tests, use the attached dwg

thanks

bye

Code - Auto/Visual Lisp: [Select]

1. ;---------
2. (defun :STRING? (s)   (= (type s) 'STR)   )
3. ;---------
4. (defun :INT? (arg)   (= (type arg) 'INT)   )
5. ;---------
6. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
7.    (setq ssa (ssadd))
8.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
9.    (sssetfirst nil ssa) (ssget "_I")
10.    (if (> (sslength ssa) 0) ssa nil)
11. )
12. ;---------
13. (defun :3DPOLY-EMK-V-LST (v-lst)
14.    (entmake
15.       (append
16.          '(
17.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
18.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
19.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
20.          )
21.          (list (cons 62 (atoi (getvar "cecolor"))))
22.       )
23.    )
24.  
25.    (foreach   vrtx   v-lst
26.       (entmake
27.          (append
28.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
29.             (list (cons 10 vrtx) )
30.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
31.          )
32.       )
33.    )
34.  
35.    (entmake
36.       '( (0 . "SEQEND") (100 . "AcDbEntity") )  
37.    )
38. )
39. ;---------
40. (defun :LWDISPLAY-ON  () (setvar "lwdisplay" 1) )
41. ;---------
42. (defun :CELWEIGHT (clw) (setvar "celweight" clw) )
43. ;---------
44. (defun :CECOLOR (clr-str)
45.    (cond
46.       (   (:INT?    clr-str)   (setvar "cecolor" (itoa clr-str) ) )
47.       (   (:STRING? clr-str)   (setvar "cecolor" clr-str        ) )
48.    )
49. )
50. ;---------
51. (defun :SS-BEFORE-EN ( x-en / tmp )
52.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
53. )
54. ;---------
55. (defun :SS-BEFORE-EL (  / tmp x-en)
56.    (if(setq x-en (entlast) )
57.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
58.       nil
59.    )
60. )
61. ;---------
62. (defun LM:SSGET ( msg arg / sel )
63.     (princ msg)
64.     (setvar 'nomutt 1)
65.     (setq sel (vl-catch-all-apply 'ssget arg))
66.     (setvar 'nomutt 0)
67.     (if (not (vl-catch-all-error-p sel)) sel)
68. )
69.  
70. ;---------
71. (defun :SS>ENTGET-LIST (ss / IND L)
72.    (setq ind 0 l '())
73.    (repeat (sslength ss)
74.       (setq l (cons (entget (ssname ss ind) ) l) )      (setq ind (+ 1 ind) )
75.    )
76.    (reverse l)
77. )
78.  
79. ;---------
80. (defun :DXF (code elist) (cdr (assoc code elist)))
81.  
82.  
83. ;---------
84. (defun C:JOIN-LINES  (   /
85.                         eb mif new-seg-lst new-seg-lst-lst x-el x-seg x-seg-lst x-ss x-ss-eg-lst
86.                      )
87.      (and
88.       (setq x-ss (LM:SSGET "\nselect LINES to JOIN <exit> :" '(((0 . "LINE"))) ) )
89.       (setq x-ss-eg-lst (:SS>ENTGET-LIST x-ss) )
90.       (setq x-seg-lst   (mapcar '(lambda (x-el) (list (:DXF 10 x-el) (:DXF 11 x-el) ) ) x-ss-eg-lst))
91.      
92.       (setq x-seg       (car x-seg-lst)
93.             x-seg-lst   (cdr x-seg-lst)
94.             new-seg-lst-lst '()
95.             new-seg-lst (list x-seg)
96.       )
97.      
98.       (while x-seg-lst
99.          (setq   mif (car   (vl-member-if
100.                            '(lambda   (i-seg)
101.                                (vl-member-if  '(lambda (i-pt) (equal (cadr x-seg) i-pt 1e-6) )  i-seg )
102.                             )
103.                             x-seg-lst
104.                         )
105.                    )
106.          )
107.          
108.          (cond
109.             (  (and mif (equal (cadr x-seg) (car mif) 1e-6) )
110.                (setq new-seg-lst (append new-seg-lst (list mif) )
111.                      x-seg mif
112.                      x-seg-lst (vl-remove mif x-seg-lst)
113.                )
114.             )
115.             (  (and mif (equal (cadr x-seg) (cadr mif) 1e-6) )
116.                (setq new-seg-lst (append new-seg-lst (list (reverse mif) ) )
117.                      x-seg (reverse mif)
118.                      x-seg-lst (vl-remove mif x-seg-lst)
119.                )
120.             )
121.             (  (not mif)
122.                (setq new-seg-lst-lst (cons new-seg-lst new-seg-lst-lst)
123.                      x-seg           (car x-seg-lst)
124.                      new-seg-lst     (list x-seg)
125.                      x-seg-lst       (cdr x-seg-lst)
126.                )
127.             )
128.          )
129.       )
130.     )
131.    
132.    (if new-seg-lst (setq new-seg-lst-lst (cons new-seg-lst new-seg-lst-lst) ) )
133.    
134.    (vl-cmdf "erase" x-ss "")
135.    (setq eb (:SS-BEFORE-EL) ) (:CECOLOR 240) (:CELWEIGHT 35) (:LWDISPLAY-ON)
136.    (foreach i new-seg-lst-lst
137.       (:3DPOLY-EMK-V-LST (append (mapcar 'car i) (list (last (last i) ) ) ) )
138.    )
139.  
140.    (:SS-MAKE-PREVIOUS-EB eb)
141. )
142.  
143. (defun c:JL () (C:JOIN-LINES) )
144.  
145. (princ "\ntype JL ")

[domenicomaria]

Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?

I don't know which is the correct direction (CW/CCW) ...
the segments themselves do not have a CW/CCW direction ...

... the problem is only to join segments that touch each other,
and that have to be put in order

... reversing those that touch either both
at point p10 or both at point p11 ...

the sequence must be    p10 p11,   p10 p11,   p10 p11   ...

They must be consecutive segments ...

I haven't tested vovka's code yet, but I'm sure it works...

my code works and also works with segment groups that define more shapes ...

if you open the attached dwg there are 4 shapes,
made up of often oppositely oriented segments ...

with one command, all segments are all merged

[ribarm]

Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?

I suppose you exploded already connected segments and get mixed CW/CCW lines... Is that true, or you always get what you don't need to do - already correct p10 p11, p10 p11 ...

[kasmo]

Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

 

No. I want solve without any acad command !

ahem.. 

Code - Auto/Visual Lisp: [Select]

1. ...
2. (vl-cmdf "erase" x-ss "")
3. ...
4.  

[ribarm]

I've zipped something connected with "word" "chain" and searched my library...
Perhaps it'll help you - I forgot what I used them for...

HTH.
M.R.

[domenicomaria]

@kasmo

I want to solve this math, logic and geometry problem:

given a set of touching segments,
some oriented counterclockwise and some clockwise,
which define a shape,

extract the ordered list of points to redraw the form ...

and this without using acad commands.

Then, to make a test,
you have to erase and redraw ...
... in acad !

[domenicomaria]

@MR
Thanks Marko

I had a look at your code
which seemed quite complex to me...
 ...
 my problem (which I fixed) it's much simpler ...
 ...
 Anyway, I'll study your LISP file

 Thank you

 ciao

[kasmo]

@kasmo

I want to solve this math, logic and geometry problem:

given a set of touching segments,
some oriented counterclockwise and some clockwise,
which define a shape,

extract the ordered list of points to redraw the form ...

and this without using acad commands.

Then, to make a test,
you have to erase and redraw ...
... in acad !

But why?
Wouldn't this basically achieve the same thing?

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo ( / ss )
2.   (if (setq ss (ssget '((0 . "line"))))
3.     (command "_.pedit" "_m" ss "" "_y" "_j" "1e-6" "_r" "")
4.   )
5. )
6.  

[domenicomaria]

@kasmo
because there are situations
where it's not the same thing
(and it's not easy to explain it)
and anyway it's more interesting
to write functions that are independent
from ACAD ...

[ribarm]

I had small mistake in chain.zip, so I reattached it again...

Sorry, but it happens from time to time...

[domenicomaria]

https://drive.google.com/file/d/1BTd9jFE7b4hb0iiaAKV5HW0qp8o0u-1e/view?usp=sharing

Thank you VovKa
Your code and mine do the same thing.
And they both work well.
Yours is blue. Mine is red.

Your code is as always very elegant
and I still have to study it.

ciao

[VovKa]

does not want to join these

Code: [Select]

(mapcar 'entmakex
'(((0 . "LINE") (10 6753.94 4368.45 0.0) (11 6768.27 4108.41 0.0))
  ((0 . "LINE") (10 6768.27 4108.41 0.0) (11 6469.86 3748.16 0.0))
  ((0 . "LINE") (10 6753.94 4368.45 0.0) (11 7467.73 4401.85 0.0))
  ((0 . "LINE") (10 7515.47 4172.82 0.0) (11 7467.73 4401.85 0.0))
  ((0 . "LINE") (10 7515.47 4172.82 0.0) (11 7396.11 3798.26 0.0))
  ((0 . "LINE") (10 7396.11 3798.26 0.0) (11 7157.39 3678.97 0.0))
  ((0 . "LINE") (10 7157.39 3678.97 0.0) (11 6768.27 4108.41 0.0))
)
)


[domenicomaria]

does not want to join these

Code: [Select]

(mapcar 'entmakex
'(((0 . "LINE") (10 6753.94 4368.45 0.0) (11 6768.27 4108.41 0.0))
  ((0 . "LINE") (10 6768.27 4108.41 0.0) (11 6469.86 3748.16 0.0))
  ((0 . "LINE") (10 6753.94 4368.45 0.0) (11 7467.73 4401.85 0.0))
  ((0 . "LINE") (10 7515.47 4172.82 0.0) (11 7467.73 4401.85 0.0))
  ((0 . "LINE") (10 7515.47 4172.82 0.0) (11 7396.11 3798.26 0.0))
  ((0 . "LINE") (10 7396.11 3798.26 0.0) (11 7157.39 3678.97 0.0))
  ((0 . "LINE") (10 7157.39 3678.97 0.0) (11 6768.27 4108.41 0.0))
)
)


Your code works perfectly !

My code fails !

Because the bad red segment !

I am not VovKa !

[domenicomaria]

I'm not worried about this type of error anyway ...

which I didn't think about ...

because I suppose that the segments touch each other
and define a shape (closed or open)
without strange or particular situations

[VovKa]

Your code works perfectly !

my code is by far not perfect
it produces different results depending on many random factors
i'd call it unpredictable

[domenicomaria]

@vovka
if we exclude the case where three or more segments have a common point, your code (but mine too) works perfectly...

[Lee Mac]

My LM:sortedchainselection from this program may be useful in this regard: given a selection set (which could easily be a list of segments instead), it will return a list of chained segments.

[domenicomaria]

@Lee Mac
as always your code exceeds expectations

Thank you

[ribarm]

@meja has founded topic that may be of interes...
https://www.theswamp.org/index.php?topic=55918.0

Note : After applying (c:joinlsp) on preselection, resulting entity is joined polyline/spline and it's always (entlast) "if connections were lines or arcs" - last entity (with splines/polylines with more vertices it's different - one of them in the chain inherited joinings - one of them from endings start/end)...

[xdcad]

Thank you VovKa ...

... in the meantime I solved it too

and it also works with various segment groups

I will study your code, because what you do is always interesting !

if you want to do some tests, use the attached dwg

thanks

bye

==========

Regarding 3dpolyline JOIN, ideas:
1. Project to XY (Z->0)
2. JOIN
3. Modify the Z coordinate to the original corresponding 3D point and regenerate the 3D polyline

==========

Code - Auto/Visual Lisp: [Select]

1. (defun c:tt ()
2. ;|
3. Project the selection set curve to the XY plane, Z=0
4. |;
5.   (defun _Project->XY (ss)
6.     (setq plane (xdge::constructor "kPlane" '(0 0 0) '(0 0 1.0)))
7.      ;Coordinate origin 0,0, normal vector (0 0 1.0) AcGe kPlane
8.     (mapcar '(lambda (x)
9.                (setq g (xdge::constructor x))
10.      ; Generate AcGe curve from AcDb curve
11.                (setq g1 (xdge::getpropertyvalue g "orthoproject" plane))
12.      ;Geometric curves are orthogonally projected onto the plane plane
13.                (setq e1 (xdge::entity:make g1))
14.      ;Generate entity after projection
15.                (if (xdrx_object_isa x "AcDb2dPolyline")
16.                  (xdrx_polyline_convertto e1)
17.                ) ;_ end of if
18.      ;If it is 2d Polyline, convert it to lwpolyline
19.                (xdrx_entity_matchprop x e1)
20.      ;The entity attributes match the original curve, color, layer, linetype....
21.                (xdrx_object_swapid e1 x)
22.      ;Entity ObjectId exchange to ensure that the newly generated curve entity name remains unchanged
23.                (xdrx_entity_delete e1)
24.      ;Delete the original curve
25.                (xdge::free g)
26.      ;Geometric curve entities release memory
27.              ) ;_ end of lambda
28.             (xdrx_pickset->ents ss)
29.      ;Select set to entity table
30.     ) ;_ end of mapcar
31.     (xdge::free plane)
32.      ;Geometry plane object releases memory
33.   ) ;_ end of defun
34. ;|
35.    Two-dimensional points query the original three-dimensional point table to obtain the coordinate Z value.
36.    Make a new table ((x y) z)
37. |;
38.   (defun _query (pt pts)
39.     (last (assoc (list (car pt) (cadr pt)) pts))
40.   ) ;_ end of defun
41.   (if (and (xdrx_initssget "\nSelect Curve<Exit>:")
42.            (setq ss (xdrx_ssget '((0 . "*line,arc,ellipse,circle"))))
43.       ) ;_ end of and
44.     (progn
45.      ;|
46.         Save the 3dpolyline vertex table for later querying the Z value corresponding to the two-dimensional point
47.         ( ((x1 y1) z1)((x2 y2) z2) ... ((xn yn) zn) )
48.      |;
49.       (setq pts  (xdrx-getpropertyvalue ss "vertices")
50.                                         ;Select set curve vertex table
51.             pts  (xd::list:flat-point pts)
52.                                         ;One level bracket point table
53.             pts1 (mapcar '(lambda (x)
54.                             (list (list (car x) (cadr x)) (caddr x))
55.                           ) ;_ end of lambda
56.                          pts
57.                  ) ;_ end of mapcar
58.       ) ;_ end of setq
59.       (_Project->XY ss)
60.       ;;3dpolyline -> lwpolyline
61.       (xdrx-curve-join ss)
62.       ;; LWPOLYLINE JOIN
63.       (setq nPnts nil)
64.       (foreach n verts
65.         (setq z (_query n pts1))
66.         (setq pt    (list (car n) (cadr n) z)
67.               nPnts (cons pt nPnts)
68.         ) ;_ end of setq
69.         (setq i (1+ i))
70.       ) ;_ end of foreach
71.       (setq nPnts (reverse nPnts))
72.       (setq pl3d (xdrx-3dpolyline-make nPnts ))
73.       ;;Generate new 3dpolyline
74.     ) ;_ end of progn
75.   ) ;_ end of if
76.   (princ)
77. )
78.  

=============

The above LISP code uses the XDRX-API, which can be downloaded from https://github.com/xdcad/XDrx-API and is updated at any time.

The XDRX API encapsulates AcDb, AcEd, AcGe, AcBr... C++ library, using C++ methods to develop LISP programs.Thousands of Lisp functions are available.