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.    (entmakex
  28.       (list   '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) )
  29.    )
  30. )
  31.  
  32. ;-------------------------------------------------------
  33. (defun :SS-BEFORE-EL (  / tmp x-en)
  34.    (if(setq x-en (entlast) )
  35.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  36.       nil
  37.    )
  38. )
  39.  
  40. ;-------------------------------------------------------
  41. (defun :SS-AFTER-SS (x-en / tmp ss)
  42.    (setq ss (ssadd))
  43.    (while (setq x-en (if x-en (entnext x-en) (entnext) ) ) (ssadd x-en ss) )
  44.    (if (> (sslength ss) 0) ss nil)
  45. )
  46.  
  47.  
  48. ;-------------------------------------------------------
  49. (defun :3DPOLY-EMK-V-LST (v-lst)
  50.    (entmake
  51.       (append
  52.          '(
  53.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
  54.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
  55.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
  56.          )
  57.          (list (cons 62 (atoi (getvar "cecolor"))))
  58.       )
  59.    )
  60.  
  61.    (foreach   vrtx   v-lst
  62.       (entmake
  63.          (append
  64.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
  65.             (list (cons 10 vrtx) )
  66.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
  67.          )
  68.       )
  69.    )
  70.  
  71.    (entmake
  72.       '( (0 . "SEQEND") (100 . "AcDbEntity") )
  73.    )
  74. )
  75.  
  76.  
  77. ;-------------------------------------------------------
  78. (defun c:MESH-SHAPE    (    /
  79.                         kwi n-rep next-seg p10 p11 p12 segs-lst shape-seg-lst shape-v-lst
  80.                          shape-v-lst-lst ss ss-el-lst trng-lst x-seg x-trng
  81.                      )
  82.    (and
  83.       (setq ss (LM:SSGET "\nselect 3DFACES to get their SHAPE <exit> :" '(((0 . "3DFACE"))) ) )
  84.       (setq ss-el-lst (:SS>ENTGET-LIST ss) )
  85.       (setq trng-lst (mapcar ':3DF-3V-LST ss-el-lst) )
  86.       (setq segs-lst (mapcar '(lambda (x-trng)
  87.                                  (setq p10 (car x-trng) p11 (cadr x-trng) p12 (caddr x-trng) )
  88.                                  (list (list p10 p11) (list p11 p12) (list p12 p10) )
  89.                               )
  90.                              trng-lst
  91.                      )
  92.       )
  93.       (setq segs-lst (apply 'append segs-lst) )
  94.  
  95.       (foreach x-seg segs-lst
  96.          (if(not (member (reverse x-seg) segs-lst) )
  97.             ;   (not (vl-member-if '(lambda (i) (equal i (reverse x-seg) 1e-6) ) segs-lst) )
  98.             (setq shape-seg-lst (cons x-seg shape-seg-lst) )
  99.          )
  100.          t
  101.       )
  102.      
  103.       (setq eb (:SS-BEFORE-EL) )
  104.      
  105.       (setq shape-v-lst (list (caar shape-seg-lst) ) )
  106.       (setq x-seg (car shape-seg-lst)   shape-seg-lst (cdr shape-seg-lst) )
  107.  
  108.       (setvar "cecolor" "150")(setvar "celweight" 35)
  109.  
  110.       (while shape-seg-lst
  111.          (setq kwi t)
  112.          (while kwi
  113.             (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) shape-seg-lst) )
  114.                (progn
  115.                   (setq shape-v-lst (cons (cadr x-seg) shape-v-lst) )
  116.                   (setq x-seg (car next-seg) )
  117.                   (setq shape-seg-lst (vl-remove x-seg shape-seg-lst) )
  118.                )
  119.                (progn
  120.                   (setq shape-v-lst (cons (last shape-v-lst) shape-v-lst ) )
  121.                   (setq kwi nil)
  122.                   (princ "\nnext segment not found !")
  123.                )
  124.             )
  125.          )
  126.          (:3DPOLY-EMK-V-LST shape-v-lst)
  127.          
  128.          (setq shape-v-lst-lst (cons shape-v-lst shape-v-lst-lst) )
  129.          
  130.          (setq shape-v-lst (list (caar shape-seg-lst) ) )
  131.          (setq x-seg (car shape-seg-lst)   shape-seg-lst (cdr shape-seg-lst) )
  132.       )
  133.    )
  134.    
  135.    (setq ssa (:SS-AFTER-SS eb) )
  136.    (sssetfirst ssa ssa)
  137.  
  138.    shape-v-lst-lst
  139.    
  140. )
  141. (defun C:MS () (c:MESH-SHAPE) )
  142.  
  143. (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

To discard coincident double segments,
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.    (entmakex
  28.       (list   '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) )
  29.    )
  30. )
  31.  
  32. ;-------------------------------------------------------
  33. (defun :SS-BEFORE-EN ( x-en / tmp )
  34.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  35. )
  36.  
  37. ;-------------------------------------------------------
  38. (defun :SS-BEFORE-EL (  / tmp x-en)
  39.    (if(setq x-en (entlast) )
  40.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  41.       nil
  42.    )
  43. )
  44.  
  45. ;-------------------------------------------------------
  46. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
  47.    (setq ssa (ssadd))
  48.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
  49.    (sssetfirst nil ssa) (ssget "_I")
  50.    (if (> (sslength ssa) 0) ssa nil)
  51. )
  52.  
  53. ;-------------------------------------------------------
  54. (defun :MID-2P (p1 p2) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2) )
  55.  
  56.  
  57. ;-------------------------------------------------------
  58. (defun :GEOM-SEG-LST>POINT-LST-LST (x-seg-lst / kwi next-seg shape-v-lst shape-v-lst-lst x-seg )
  59.    (while x-seg-lst
  60.       (setq shape-v-lst (list (caar x-seg-lst) ) )
  61.       (setq x-seg (car x-seg-lst)   x-seg-lst (cdr x-seg-lst) )
  62.       (setq kwi t)
  63.       (while kwi
  64.          (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) x-seg-lst) )
  65.             (progn
  66.                (setq shape-v-lst (cons (cadr x-seg) shape-v-lst) )
  67.                (setq x-seg (car next-seg) )
  68.                (setq x-seg-lst (vl-remove x-seg x-seg-lst) )
  69.             )
  70.             (progn
  71.                (setq shape-v-lst (cons (last shape-v-lst) shape-v-lst ) )
  72.                (setq kwi nil)
  73.                ;   (princ "\nnext segment not found !")
  74.             )
  75.          )
  76.       )
  77.       (setq shape-v-lst-lst (cons shape-v-lst shape-v-lst-lst) )
  78.    )
  79.    shape-v-lst-lst
  80. )
  81.  
  82. ;-------------------------------------------------------
  83. (defun :3DPOLY-EMK-V-LST (v-lst)
  84.    (entmake
  85.       (append
  86.          '(
  87.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
  88.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
  89.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
  90.          )
  91.          (list (cons 62 (atoi (getvar "cecolor"))))
  92.       )
  93.    )
  94.  
  95.    (foreach   vrtx   v-lst
  96.       (entmake
  97.          (append
  98.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
  99.             (list (cons 10 vrtx) )
  100.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
  101.          )
  102.       )
  103.    )
  104.  
  105.    (entmake
  106.       '( (0 . "SEQEND") (100 . "AcDbEntity") )
  107.    )
  108. )
  109.  
  110.  
  111. ;-------------------------------------------------------
  112. (defun c:MESH-SHAPE-2     (    /
  113.                            eb m2p-segs-lst p10 p11 p12 segs-lst shape-seg-lst shape-v-
  114.                             lst-lst ss ss-el-lst trng-lst x-m2p-seg x-m2p-seg-2 x-seg x-trng
  115.                         )
  116.    
  117.    (and
  118.       (setq ss (LM:SSGET "\nselect 3DFACES to get the SHAPE <exit> :" '(((0 . "3DFACE"))) ) )
  119.       (setq ss-el-lst (:SS>ENTGET-LIST ss) )
  120.       (setq trng-lst (mapcar ':3DF-3V-LST ss-el-lst) )
  121.       (setq segs-lst (mapcar '(lambda (x-trng)
  122.                                  (setq p10 (car x-trng) p11 (cadr x-trng) p12 (caddr x-trng) )
  123.                                  (list (list p10 p11) (list p11 p12) (list p12 p10) )
  124.                               )
  125.                               trng-lst
  126.                      )
  127.       )
  128.       (setq segs-lst (apply 'append segs-lst) )
  129.  
  130.       (setq m2p-segs-lst   (mapcar
  131.                                 '(lambda (x-seg) (cons  (:MID-2P (car x-seg) (cadr x-seg) ) x-seg) )
  132.                               segs-lst
  133.                            )
  134.       )
  135.  
  136.       (while m2p-segs-lst
  137.          (setq x-m2p-seg (car m2p-segs-lst)   m2p-segs-lst (cdr m2p-segs-lst) )
  138.          
  139.          (if(setq x-m2p-seg-2  (vl-member-if '(lambda (i) (equal (car i) (car x-m2p-seg) 1e-6) )  m2p-segs-lst) )
  140.             (setq m2p-segs-lst  (vl-remove (car x-m2p-seg-2) m2p-segs-lst) )
  141.             (setq shape-seg-lst  (cons (cdr x-m2p-seg) shape-seg-lst) )
  142.          )
  143.       )
  144.       (setq shape-v-lst-lst (:GEOM-SEG-LST>POINT-LST-LST shape-seg-lst) )
  145.    )
  146.      
  147.    (setq eb (:SS-BEFORE-EL) )
  148.    (setvar "cecolor" "240") (setvar "celweight" 35) (setvar "lwdisplay" 1)
  149.    
  150.    
  151.    (foreach shape-v-lst shape-v-lst-lst (:3DPOLY-EMK-V-LST shape-v-lst) )
  152.    (:SS-MAKE-PREVIOUS-EB eb)
  153.    
  154.    shape-v-lst-lst
  155. )
  156.    
  157. (defun C:MS2 () (c:MESH-SHAPE-2) )
  158.  
  159. (princ "\ntype \"MS2\"")
  160.  
  161.    
« 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