### Author Topic: SHAPE of a 2D MESH  (Read 3186 times)

0 Members and 1 Guest are viewing this topic.

#### domenicomaria

• Swamp Rat
• Posts: 738
##### Re: SHAPE of a 2D MESH
« Reply #15 on: May 19, 2023, 09:31:05 AM »
well done! I was thinking of using the mid point of each edge as the check, instead of flipping them, not sure if that would work
I see you only needed a line, not a closed polyline, a bit of work to order the edges

"a bit of work to order the edges"
yes
I am working to do this and i am at a good point

"I was thinking of using the mid point of each edge"
It is a good idea
« Last Edit: May 19, 2023, 09:38:13 AM by domenicomaria »

#### domenicomaria

• Swamp Rat
• Posts: 738
##### Re: SHAPE of a 2D MESH
« Reply #16 on: May 19, 2023, 10:15:14 AM »
Code - Auto/Visual Lisp: [Select]
1. ;-------------------------------------------------------
2. (defun LM:SSGET ( msg arg / sel )
3.     (princ msg)
4.     (setvar 'nomutt 1)
5.     (setq sel (vl-catch-all-apply 'ssget arg))
6.     (setvar 'nomutt 0)
7.     (if (not (vl-catch-all-error-p sel)) sel)
8. )
9.
10. ;-------------------------------------------------------
11. (defun :SS>ENTGET-LIST (ss / ind l)
12.    (setq ind 0 l '())
13.    (repeat (sslength ss) (setq l (cons (entget (ssname ss ind) ) l) )   (setq ind (+ 1 ind) ) )
14.    (reverse l)
15. )
16.
17. ;-------------------------------------------------------
18. (defun :3DF-3V-LST (x-el)
19.    (list (:DXF 10 x-el) (:DXF 11 x-el) (:DXF 12 x-el) )
20. )
21.
22. ;-------------------------------------------------------
23. (defun :DXF (code e-lst) (cdr (assoc code e-lst)))
24.
25. ;-------------------------------------------------------
26. (defun :LINE (p1 p2)
27.       (list   '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) )
28.    )
29. )
30.
31. ;-------------------------------------------------------
32. (defun :SS-BEFORE-EL (  / tmp x-en)
33.    (if(setq x-en (entlast) )
34.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
35.       nil
36.    )
37. )
38.
39. ;-------------------------------------------------------
40. (defun :SS-AFTER-SS (x-en / tmp ss)
42.    (while (setq x-en (if x-en (entnext x-en) (entnext) ) ) (ssadd x-en ss) )
43.    (if (> (sslength ss) 0) ss nil)
44. )
45.
46.
47. ;-------------------------------------------------------
48. (defun :3DPOLY-EMK-V-LST (v-lst)
49.          '(
50.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
51.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
52.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
53.          )
54.          (list (cons 62 (atoi (getvar "cecolor"))))
55.       )
56.    )
57.
58.    (foreach   vrtx   v-lst
59.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
60.             (list (cons 10 vrtx) )
61.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
62.          )
63.       )
64.    )
65.
66.       '( (0 . "SEQEND") (100 . "AcDbEntity") )
67.    )
68. )
69.
70.
71. ;-------------------------------------------------------
72. (defun c:MESH-SHAPE    (    /
73.                         kwi n-rep next-seg p10 p11 p12 segs-lst shape-seg-lst shape-v-lst
74.                          shape-v-lst-lst ss ss-el-lst trng-lst x-seg x-trng
75.                      )
76.    (and
77.       (setq ss (LM:SSGET "\nselect 3DFACES to get their SHAPE <exit> :" '(((0 . "3DFACE"))) ) )
78.       (setq ss-el-lst (:SS>ENTGET-LIST ss) )
79.       (setq trng-lst (mapcar ':3DF-3V-LST ss-el-lst) )
80.       (setq segs-lst (mapcar '(lambda (x-trng)
81.                                  (setq p10 (car x-trng) p11 (cadr x-trng) p12 (caddr x-trng) )
82.                                  (list (list p10 p11) (list p11 p12) (list p12 p10) )
83.                               )
84.                              trng-lst
85.                      )
86.       )
87.       (setq segs-lst (apply 'append segs-lst) )
88.
89.       (foreach x-seg segs-lst
90.          (if(not (member (reverse x-seg) segs-lst) )
91.             ;   (not (vl-member-if '(lambda (i) (equal i (reverse x-seg) 1e-6) ) segs-lst) )
92.             (setq shape-seg-lst (cons x-seg shape-seg-lst) )
93.          )
94.          t
95.       )
96.
97.       (setq eb (:SS-BEFORE-EL) )
98.
99.       (setq shape-v-lst (list (caar shape-seg-lst) ) )
100.       (setq x-seg (car shape-seg-lst)   shape-seg-lst (cdr shape-seg-lst) )
101.
102.       (setvar "cecolor" "150")(setvar "celweight" 35)
103.
104.       (while shape-seg-lst
105.          (setq kwi t)
106.          (while kwi
107.             (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) shape-seg-lst) )
108.                   (setq shape-v-lst (cons (cadr x-seg) shape-v-lst) )
109.                   (setq x-seg (car next-seg) )
110.                   (setq shape-seg-lst (vl-remove x-seg shape-seg-lst) )
111.                )
112.                   (setq shape-v-lst (cons (last shape-v-lst) shape-v-lst ) )
113.                   (setq kwi nil)
115.                )
116.             )
117.          )
118.          (:3DPOLY-EMK-V-LST shape-v-lst)
119.
120.          (setq shape-v-lst-lst (cons shape-v-lst shape-v-lst-lst) )
121.
122.          (setq shape-v-lst (list (caar shape-seg-lst) ) )
123.          (setq x-seg (car shape-seg-lst)   shape-seg-lst (cdr shape-seg-lst) )
124.       )
125.    )
126.
127.    (setq ssa (:SS-AFTER-SS eb) )
128.    (sssetfirst ssa ssa)
129.
130.    shape-v-lst-lst
131.
132. )
133. (defun C:MS () (c:MESH-SHAPE) )
134.
135. (princ "\ntype \"MS\"")

and this is the code that draws the 3DPOLYLINES
and seems to work fine
(outline and holes too) !

« Last Edit: May 19, 2023, 10:21:34 AM by domenicomaria »

#### domenicomaria

• Swamp Rat
• Posts: 738
##### Re: SHAPE of a 2D MESH
« Reply #17 on: May 20, 2023, 10:13:36 AM »
and this is the latest optimized version

it checks if the midpoints of the segments are coincident
(as suggested by AKA Daniel)

It detects and draws the outer shape of the 3d mesh,
and all the holes too.

What I haven't been able to do (for the moment)
is separate in two (or more) different points lists,
two (or more) holes that have a coincident vertex
or that have a vertex (or more) on the outer shape.

Code - Auto/Visual Lisp: [Select]
1. ;-------------------------------------------------------
2. (defun LM:SSGET ( msg arg / sel )
3.     (princ msg)
4.     (setvar 'nomutt 1)
5.     (setq sel (vl-catch-all-apply 'ssget arg))
6.     (setvar 'nomutt 0)
7.     (if (not (vl-catch-all-error-p sel)) sel)
8. )
9.
10. ;-------------------------------------------------------
11. (defun :SS>ENTGET-LIST (ss / ind l)
12.    (setq ind 0 l '())
13.    (repeat (sslength ss) (setq l (cons (entget (ssname ss ind) ) l) )   (setq ind (+ 1 ind) ) )
14.    (reverse l)
15. )
16.
17. ;-------------------------------------------------------
18. (defun :3DF-3V-LST (x-el)
19.    (list (:DXF 10 x-el) (:DXF 11 x-el) (:DXF 12 x-el) )
20. )
21.
22. ;-------------------------------------------------------
23. (defun :DXF (code e-lst) (cdr (assoc code e-lst)))
24.
25. ;-------------------------------------------------------
26. (defun :LINE (p1 p2)
27.       (list   '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) )
28.    )
29. )
30.
31. ;-------------------------------------------------------
32. (defun :SS-BEFORE-EN ( x-en / tmp )
33.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
34. )
35.
36. ;-------------------------------------------------------
37. (defun :SS-BEFORE-EL (  / tmp x-en)
38.    (if(setq x-en (entlast) )
39.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
40.       nil
41.    )
42. )
43.
44. ;-------------------------------------------------------
45. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
47.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
48.    (sssetfirst nil ssa) (ssget "_I")
49.    (if (> (sslength ssa) 0) ssa nil)
50. )
51.
52. ;-------------------------------------------------------
53. (defun :MID-2P (p1 p2) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2) )
54.
55.
56. ;-------------------------------------------------------
57. (defun :GEOM-SEG-LST>POINT-LST-LST (x-seg-lst / kwi next-seg shape-v-lst shape-v-lst-lst x-seg )
58.    (while x-seg-lst
59.       (setq shape-v-lst (list (caar x-seg-lst) ) )
60.       (setq x-seg (car x-seg-lst)   x-seg-lst (cdr x-seg-lst) )
61.       (setq kwi t)
62.       (while kwi
63.          (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) x-seg-lst) )
64.                (setq shape-v-lst (cons (cadr x-seg) shape-v-lst) )
65.                (setq x-seg (car next-seg) )
66.                (setq x-seg-lst (vl-remove x-seg x-seg-lst) )
67.             )
68.                (setq shape-v-lst (cons (last shape-v-lst) shape-v-lst ) )
69.                (setq kwi nil)
71.             )
72.          )
73.       )
74.       (setq shape-v-lst-lst (cons shape-v-lst shape-v-lst-lst) )
75.    )
76.    shape-v-lst-lst
77. )
78.
79. ;-------------------------------------------------------
80. (defun :3DPOLY-EMK-V-LST (v-lst)
81.          '(
82.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
83.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
84.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
85.          )
86.          (list (cons 62 (atoi (getvar "cecolor"))))
87.       )
88.    )
89.
90.    (foreach   vrtx   v-lst
91.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
92.             (list (cons 10 vrtx) )
93.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
94.          )
95.       )
96.    )
97.
98.       '( (0 . "SEQEND") (100 . "AcDbEntity") )
99.    )
100. )
101.
102.
103. ;-------------------------------------------------------
104. (defun c:MESH-SHAPE-2     (    /
105.                            eb m2p-segs-lst p10 p11 p12 segs-lst shape-seg-lst shape-v-
106.                             lst-lst ss ss-el-lst trng-lst x-m2p-seg x-m2p-seg-2 x-seg x-trng
107.                         )
108.
109.    (and
110.       (setq ss (LM:SSGET "\nselect 3DFACES to get the SHAPE <exit> :" '(((0 . "3DFACE"))) ) )
111.       (setq ss-el-lst (:SS>ENTGET-LIST ss) )
112.       (setq trng-lst (mapcar ':3DF-3V-LST ss-el-lst) )
113.       (setq segs-lst (mapcar '(lambda (x-trng)
114.                                  (setq p10 (car x-trng) p11 (cadr x-trng) p12 (caddr x-trng) )
115.                                  (list (list p10 p11) (list p11 p12) (list p12 p10) )
116.                               )
117.                               trng-lst
118.                      )
119.       )
120.       (setq segs-lst (apply 'append segs-lst) )
121.
122.       (setq m2p-segs-lst   (mapcar
123.                                 '(lambda (x-seg) (cons  (:MID-2P (car x-seg) (cadr x-seg) ) x-seg) )
124.                               segs-lst
125.                            )
126.       )
127.
128.       (while m2p-segs-lst
129.          (setq x-m2p-seg (car m2p-segs-lst)   m2p-segs-lst (cdr m2p-segs-lst) )
130.
131.          (if(setq x-m2p-seg-2  (vl-member-if '(lambda (i) (equal (car i) (car x-m2p-seg) 1e-6) )  m2p-segs-lst) )
132.             (setq m2p-segs-lst  (vl-remove (car x-m2p-seg-2) m2p-segs-lst) )
133.             (setq shape-seg-lst  (cons (cdr x-m2p-seg) shape-seg-lst) )
134.          )
135.       )
136.       (setq shape-v-lst-lst (:GEOM-SEG-LST>POINT-LST-LST shape-seg-lst) )
137.    )
138.
139.    (setq eb (:SS-BEFORE-EL) )
140.    (setvar "cecolor" "240") (setvar "celweight" 35) (setvar "lwdisplay" 1)
141.
142.
143.    (foreach shape-v-lst shape-v-lst-lst (:3DPOLY-EMK-V-LST shape-v-lst) )
144.    (:SS-MAKE-PREVIOUS-EB eb)
145.
146.    shape-v-lst-lst
147. )
148.
149. (defun C:MS2 () (c:MESH-SHAPE-2) )
150.
151. (princ "\ntype \"MS2\"")
152.
153.
« Last Edit: May 21, 2023, 04:42:52 PM by domenicomaria »

#### It's Alive!

• Retired
• Needs a day job
• Posts: 8859
• AKA Daniel
##### Re: SHAPE of a 2D MESH
« Reply #18 on: May 20, 2023, 07:02:53 PM »
well done! works great!

#### domenicomaria

• Swamp Rat
• Posts: 738
##### Re: SHAPE of a 2D MESH
« Reply #19 on: May 30, 2023, 12:41:28 AM »