m2s Mesh-to-Solid

iLisp

2. 
   
3. ;;    M2S  (Mesh-to-Solid)
   
4. ;;    Creates an ACIS solid from an open 3d polygon mesh.
   
5. ;;
   
6. ;;    Take 2 - Updated 7/7/1998
   
7. ;;       - Works with REVSURF'd meshes that touch or cross axis of revolution.
   
8. ;;       - Works even if solid being constructed is not fully visible on screen.
   
9. ;;       - Works with all open meshes created with REVSURF, RULESURF,
   
10. ;;          EDGESURF, TABSURF, AI_MESH, and 3DMESH. Most of the stock 3D
    
11. ;;          surfaces will work if you use DDMODIFY to open them in the M
    
12. ;;          and N directions.
    
13. ;;       - Does not work with polyface entities.
    
14. ;;
    
15. ;;    (c) Copyright 1998 Bill Gilliss.  
    
16. ;;        All rights reserved... such as they are.
    
17. ;;
    
18. ;;    bill.gilliss@aya.yale.edu    gilliss@iglou.com
    
19. ;;
    
20. ;;       I wrote this to create sculptable ACIS terrain models
    
21. ;;    for architectural site renderings. It could also be used
    
22. ;;    to create thin shells from meshes, by subtracting a moved
    
23. ;;    copy of the solid from the original solid. Let me know of
    
24. ;;    other uses you find for it, or problems you encounter.
    
25. ;;
    
26. ;;       The solid is created by projecting each mesh facet "down"
    
27. ;;    the current z-axis to a plane a user-specified distance below
    
28. ;;    the lowest vertex. To assure that all parts of the mesh are
    
29. ;;    generated as solids, this distance can not be zero, but the
    
30. ;;    solid can be SLICEd later if need be.
    
31. ;;
    
32. ;;       The solid will match the displayed mesh: if the mesh has
    
33. ;;    been smoothed and SPLFRAME is set to 0, the solid will be
    
34. ;;    smoothed. Otherwise, it will not be. The mesh itself is not
    
35. ;;    changed at all.
    
36. ;;
    
37. 
    
38. 
    
39. (defun c:m2s (/  ent ename entlst M N MN SN SM ST smooth oldecho vtx d1
    
40.                  low vtxcnt vtxmax bot bottom p1 p2 p3 p4 c1 c2 c3 c4
    
41.                  b1 b2 b3 b4 soldepth ssall ssrow)
    
42. 
    
43. (setq oldecho (getvar "cmdecho"))
    
44. (setq oldsnap (getvar "osmode"))
    
45. (setq oldblip (getvar "blipmode"))
    
46. (setvar "cmdecho" 0)
    
47. (setvar "osmode" 0)
    
48. (setvar "blipmode" 0)
    
49. (command "undo" "begin")
    
50. 
    
51. ;;select the mesh
    
52.   (setq ent (entsel "Select a polygon mesh to solidify: "))
    
53.   (setq ename (car ent))
    
54.   (setq entlst (entget ename))
    
55. 
    
56.   (if (not (= (cdr (assoc 0 entlst)) "POLYLINE"))
    
57.     (progn
    
58.       (alert "That is not a polygon mesh.")
    
59.       (exit)
    
60.       (princ)
    
61.     );progn
    
62.   );endif
    
63. 
    
64.   (if
    
65.     (not
    
66.       (or
    
67.        (= (cdr (assoc 70 entlst)) 16) ;open 3d polygon mesh
    
68.        (= (cdr (assoc 70 entlst)) 20) ;open mesh w/ spline-fit vertices
    
69.         );or
    
70.        );not
    
71.      (progn
    
72.        (alert "That is not an *open* polygon mesh.")
    
73.        (exit)
    
74.        (princ)
    
75.      );progn
    
76.   );endif
    
77. 
    
78. ;; decide whether to use smoothed or unsmoothed vertices
    
79.   (setq M (cdr (assoc 71 entlst)))   ;M vertices
    
80.   (setq N (cdr (assoc 72 entlst)))   ;N vertices
    
81.   (setq SM (cdr (assoc 73 entlst)))  ;smoothed M vertices
    
82.   (setq SN (cdr (assoc 74 entlst)))  ;smoothed N vertices
    
83.   (setq ST (cdr (assoc 75 entlst)))  ;surface type
    
84.   (if
    
85.     (or
    
86.       (= (getvar "splframe") 1)      ;use MxN vertices when splframe = 1
    
87.       (= ST 0)                       ;or mesh has not been smoothed
    
88.       )
    
89.     (setq smooth 0
    
90.          MN (* M N))
    
91.     (setq smooth 1                   ;use SMxSN vertices when mesh is smoothed
    
92.           MN (* SM SN)               ;and SPLFRAME = 0
    
93.           M SM
    
94.           N SN)
    
95.     );if
    
96. 
    
97. ;; determine lowest vertex
    
98.   (grtext -2 "Checking out the mesh...")
    
99.   (setq vtx ename)
    
100.   (setq vtx (entnext vtx))
     
101.   (setq d1 (entget vtx))
     
102.   (setq bottom (caddr (trans (cdr (assoc 10 d1)) 0 1)))
     
103. 
     
104.   (repeat (1- MN)   ;compare with each vertex's z coord
     
105.     (setq vtx (entnext vtx))
     
106.     (setq d1 (entget vtx))
     
107.     (setq low (caddr (trans (cdr (assoc 10 d1)) 0 1)))
     
108.     (setq bottom (min bottom low))
     
109.     );repeat
     
110. 
     
111. ;; get desired thickness of solid
     
112.   (setq soldepth 0)
     
113.   (while
     
114.      (zerop soldepth)
     
115.      (progn
     
116.        (setq soldepth
     
117.           (getdist "\nEnter desired thickness of solid below lowest vertex <1>: "))
     
118.        (if (not soldepth) (setq soldepth 1.0))
     
119.        (if (zerop soldepth)
     
120.           (princ "\nThickness can be small, but not zero. (Slice it later, if need be.)"))
     
121.         );progn
     
122.      );while
     
123.   (setq bot (- bottom (abs soldepth)))
     
124. 
     
125.   (setq p1 ename)
     
126.   (if (= smooth 1)
     
127.       (setq p1 (entnext p1))) ;skip 1st vtx of smoothed mesh - not true vtx
     
128.   (setq ssrow (ssadd))        ;initialize set of extruded segments to be unioned as a row
     
129.   (setq ssall (ssadd))        ;initialize set of rows to be unioned into the whole
     
130.   (grtext -2 "Creating row...")
     
131.   (setq vtxmax (- MN N))  
     
132.   (setq vtxcnt 1)
     
133. 
     
134. ;;create row of solid segments
     
135.   (while (< vtxcnt vtxmax)
     
136. 
     
137.     (if (= 0 (rem vtxcnt N))  ;at end of each row...
     
138.         (progn
     
139.           (setq rowmsg (strcat "Unioning row "
     
140.                        (itoa (/ vtxcnt N)) " of "
     
141.                        (itoa (1- M)) "... "))
     
142.           (grtext -2 rowmsg)
     
143.           (command "union" ssrow "")
     
144.           (setq row (entlast))
     
145.           (ssadd row ssall)
     
146.           (setq ssrow (ssadd))
     
147.           (setq p1 (entnext p1)         ;skip to the next vertex
     
148.                 vtxcnt (1+ vtxcnt))
     
149.           );progn
     
150.         );if
     
151. 
     
152.     (grtext -2 "Creating row...")
     
153.     (setq p1 (entnext p1)                  ;first vertex of mesh square
     
154.           p2 (entnext p1)                  ;second vertex
     
155.           p3 p2)
     
156.     (repeat (1- n) (setq p3 (entnext p3))) ;walk along to 3rd (p1 + N) vertex
     
157.     (setq p4 (entnext p3))                 ;4th vertex of mesh square
     
158. 
     
159.     (setq c1 (trans (cdr (assoc 10 (entget p1))) 0 1) ;top coordinates
     
160.           c2 (trans (cdr (assoc 10 (entget p2))) 0 1)
     
161.           c3 (trans (cdr (assoc 10 (entget p3))) 0 1)
     
162.           c4 (trans (cdr (assoc 10 (entget p4))) 0 1)
     
163.           b1 (list (car c1) (cadr c1) bot)            ;bottom coordinates
     
164.           b2 (list (car c2) (cadr c2) bot)
     
165.           b3 (list (car c3) (cadr c3) bot)
     
166.           b4 (list (car c4) (cadr c4) bot))
     
167.           (LOFT c1 c2 c3 b1 b2 b3)
     
168.           (LOFT c2 c3 c4 b2 b3 b4)
     
169. 
     
170.     (setq vtxcnt (1+ vtxcnt))
     
171.   );while
     
172. 
     
173. (grtext -2 "Unioning last row...")
     
174.   (command "union" ssrow "")
     
175.   (setq row (entlast))
     
176.   (ssadd row ssall)
     
177.   (if (> M 2)       ;bypass final union for N x 1 meshes (i.e., RULESURF)
     
178.     (progn
     
179.       (grtext -2 "Unioning all rows...")
     
180.        (command "union" ssall "")
     
181.         );progn
     
182.      );if
     
183. 
     
184. ;;cleanup
     
185.   (command "undo" "end")
     
186.   (setvar "cmdecho" oldecho)
     
187.   (setvar "osmode" oldsnap)
     
188.   (setvar "blipmode" oldblip)
     
189.   (setq ssall nil ssrow nil)
     
190.   (princ)
     
191. 
     
192. );defun
     
193. 
     
194. ;;============== SUBROUTINES ====================
     
195. ;(defun *error* (msg)
     
196. ;  (command)
     
197. ;  (command "undo" "end")
     
198. ;  (setvar "cmdecho" oldecho)
     
199. ;  (setvar "osmode" oldsnap)
     
200. ;  (setvar "blipmode" oldblip)
     
201. ;  (princ (strcat "\nError: " msg))
     
202. ;  );defun
     
203. 
     
204. (defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest)
     
205.   (command "area" s1 s2 s3 "")
     
206.   (if (not (equal (getvar "area") 0.0 0.00000001))
     
207.     (progn
     
208.       (command "pline" s1 s2 s3 "c")
     
209.       (setq highest (max (caddr r1) (caddr r2) (caddr r3)))
     
210.       (setq extr (- highest bot))
     
211.       (command "extrude" (entlast) "" extr 0.0)
     
212.       (command "slice" (entlast) "" "3points" r1 r2 r3 s1)
     
213.       (setq e1 (entlast))
     
214.       (ssadd e1 ssrow)
     
215.       );progn
     
216.     );if
     
217.   );defun
     
218. 
     
219. (princ "M2S loaded.")

<br /> ;;    M2S  (Mesh-to-Solid) <br /> ;;    Creates an ACIS solid from an open 3d polygon mesh. <br /> ;; <br /> ;;    Take 2 - Updated 7/7/1998 <br /> ;;       - Works with REVSURF'd meshes that touch or cross axis of revolution. <br /> ;;       - Works even if solid being constructed is not fully visible on screen. <br /> ;;       - Works with all open meshes created with REVSURF, RULESURF, <br /> ;;          EDGESURF, TABSURF, AI_MESH, and 3DMESH. Most of the stock 3D <br /> ;;          surfaces will work if you use DDMODIFY to open them in the M <br /> ;;          and N directions. <br /> ;;       - Does not work with polyface entities. <br /> ;; <br /> ;;    (c) Copyright 1998 Bill Gilliss.  <br /> ;;        All rights reserved... such as they are. <br /> ;; <br /> ;;    bill.gilliss@aya.yale.edu    gilliss@iglou.com <br /> ;; <br /> ;;       I wrote this to create sculptable ACIS terrain models <br /> ;;    for architectural site renderings. It could also be used <br /> ;;    to create thin shells from meshes, by subtracting a moved <br /> ;;    copy of the solid from the original solid. Let me know of <br /> ;;    other uses you find for it, or problems you encounter. <br /> ;; <br /> ;;       The solid is created by projecting each mesh facet "down" <br /> ;;    the current z-axis to a plane a user-specified distance below <br /> ;;    the lowest vertex. To assure that all parts of the mesh are <br /> ;;    generated as solids, this distance can not be zero, but the <br /> ;;    solid can be SLICEd later if need be. <br /> ;; <br /> ;;       The solid will match the displayed mesh: if the mesh has <br /> ;;    been smoothed and SPLFRAME is set to 0, the solid will be <br /> ;;    smoothed. Otherwise, it will not be. The mesh itself is not <br /> ;;    changed at all. <br /> ;; <br /> <br /> <br /> (defun c:m2s (/  ent ename entlst M N MN SN SM ST smooth oldecho vtx d1 <br />                  low vtxcnt vtxmax bot bottom p1 p2 p3 p4 c1 c2 c3 c4 <br />                  b1 b2 b3 b4 soldepth ssall ssrow) <br /> <br /> (setq oldecho (getvar "cmdecho")) <br /> (setq oldsnap (getvar "osmode")) <br /> (setq oldblip (getvar "blipmode")) <br /> (setvar "cmdecho" 0) <br /> (setvar "osmode" 0) <br /> (setvar "blipmode" 0) <br /> (command "undo" "begin") <br /> <br /> ;;select the mesh <br />   (setq ent (entsel "Select a polygon mesh to solidify: ")) <br />   (setq ename (car ent)) <br />   (setq entlst (entget ename)) <br /> <br />   (if (not (= (cdr (assoc 0 entlst)) "POLYLINE")) <br />     (progn <br />       (alert "That is not a polygon mesh.") <br />       (exit) <br />       (princ) <br />     );progn <br />   );endif <br /> <br />   (if <br />     (not <br />       (or <br />        (= (cdr (assoc 70 entlst)) 16) ;open 3d polygon mesh <br />        (= (cdr (assoc 70 entlst)) 20) ;open mesh w/ spline-fit vertices <br />         );or <br />        );not <br />      (progn <br />        (alert "That is not an *open* polygon mesh.") <br />        (exit) <br />        (princ) <br />      );progn <br />   );endif <br /> <br /> ;; decide whether to use smoothed or unsmoothed vertices <br />   (setq M (cdr (assoc 71 entlst)))   ;M vertices <br />   (setq N (cdr (assoc 72 entlst)))   ;N vertices <br />   (setq SM (cdr (assoc 73 entlst)))  ;smoothed M vertices <br />   (setq SN (cdr (assoc 74 entlst)))  ;smoothed N vertices <br />   (setq ST (cdr (assoc 75 entlst)))  ;surface type <br />   (if <br />     (or <br />       (= (getvar "splframe") 1)      ;use MxN vertices when splframe = 1 <br />       (= ST 0)                       ;or mesh has not been smoothed <br />       ) <br />     (setq smooth 0 <br />          MN (* M N)) <br />     (setq smooth 1                   ;use SMxSN vertices when mesh is smoothed <br />           MN (* SM SN)               ;and SPLFRAME = 0 <br />           M SM <br />           N SN) <br />     );if <br /> <br /> ;; determine lowest vertex <br />   (grtext -2 "Checking out the mesh...") <br />   (setq vtx ename) <br />   (setq vtx (entnext vtx)) <br />   (setq d1 (entget vtx)) <br />   (setq bottom (caddr (trans (cdr (assoc 10 d1)) 0 1))) <br /> <br />   (repeat (1- MN)   ;compare with each vertex's z coord <br />     (setq vtx (entnext vtx)) <br />     (setq d1 (entget vtx)) <br />     (setq low (caddr (trans (cdr (assoc 10 d1)) 0 1))) <br />     (setq bottom (min bottom low)) <br />     );repeat <br /> <br /> ;; get desired thickness of solid <br />   (setq soldepth 0) <br />   (while <br />      (zerop soldepth) <br />      (progn <br />        (setq soldepth <br />           (getdist "\nEnter desired thickness of solid below lowest vertex <1>: ")) <br />        (if (not soldepth) (setq soldepth 1.0)) <br />        (if (zerop soldepth) <br />           (princ "\nThickness can be small, but not zero. (Slice it later, if need be.)")) <br />         );progn <br />      );while <br />   (setq bot (- bottom (abs soldepth))) <br /> <br />   (setq p1 ename) <br />   (if (= smooth 1) <br />       (setq p1 (entnext p1))) ;skip 1st vtx of smoothed mesh - not true vtx <br />   (setq ssrow (ssadd))        ;initialize set of extruded segments to be unioned as a row <br />   (setq ssall (ssadd))        ;initialize set of rows to be unioned into the whole <br />   (grtext -2 "Creating row...") <br />   (setq vtxmax (- MN N))  <br />   (setq vtxcnt 1) <br /> <br /> ;;create row of solid segments <br />   (while (< vtxcnt vtxmax) <br /> <br />     (if (= 0 (rem vtxcnt N))  ;at end of each row... <br />         (progn <br />           (setq rowmsg (strcat "Unioning row " <br />                        (itoa (/ vtxcnt N)) " of " <br />                        (itoa (1- M)) "... ")) <br />           (grtext -2 rowmsg) <br />           (command "union" ssrow "") <br />           (setq row (entlast)) <br />           (ssadd row ssall) <br />           (setq ssrow (ssadd)) <br />           (setq p1 (entnext p1)         ;skip to the next vertex <br />                 vtxcnt (1+ vtxcnt)) <br />           );progn <br />         );if <br /> <br />     (grtext -2 "Creating row...") <br />     (setq p1 (entnext p1)                  ;first vertex of mesh square <br />           p2 (entnext p1)                  ;second vertex <br />           p3 p2) <br />     (repeat (1- n) (setq p3 (entnext p3))) ;walk along to 3rd (p1 + N) vertex <br />     (setq p4 (entnext p3))                 ;4th vertex of mesh square <br /> <br />     (setq c1 (trans (cdr (assoc 10 (entget p1))) 0 1) ;top coordinates <br />           c2 (trans (cdr (assoc 10 (entget p2))) 0 1) <br />           c3 (trans (cdr (assoc 10 (entget p3))) 0 1) <br />           c4 (trans (cdr (assoc 10 (entget p4))) 0 1) <br />           b1 (list (car c1) (cadr c1) bot)            ;bottom coordinates <br />           b2 (list (car c2) (cadr c2) bot) <br />           b3 (list (car c3) (cadr c3) bot) <br />           b4 (list (car c4) (cadr c4) bot)) <br />           (LOFT c1 c2 c3 b1 b2 b3) <br />           (LOFT c2 c3 c4 b2 b3 b4) <br /> <br />     (setq vtxcnt (1+ vtxcnt)) <br />   );while <br /> <br /> (grtext -2 "Unioning last row...") <br />   (command "union" ssrow "") <br />   (setq row (entlast)) <br />   (ssadd row ssall) <br />   (if (> M 2)       ;bypass final union for N x 1 meshes (i.e., RULESURF) <br />     (progn <br />       (grtext -2 "Unioning all rows...") <br />        (command "union" ssall "") <br />         );progn <br />      );if <br /> <br /> ;;cleanup <br />   (command "undo" "end") <br />   (setvar "cmdecho" oldecho) <br />   (setvar "osmode" oldsnap) <br />   (setvar "blipmode" oldblip) <br />   (setq ssall nil ssrow nil) <br />   (princ) <br /> <br /> );defun <br /> <br /> ;;============== SUBROUTINES ==================== <br /> ;(defun *error* (msg) <br /> ;  (command) <br /> ;  (command "undo" "end") <br /> ;  (setvar "cmdecho" oldecho) <br /> ;  (setvar "osmode" oldsnap) <br /> ;  (setvar "blipmode" oldblip) <br /> ;  (princ (strcat "\nError: " msg)) <br /> ;  );defun <br /> <br /> (defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest) <br />   (command "area" s1 s2 s3 "") <br />   (if (not (equal (getvar "area") 0.0 0.00000001)) <br />     (progn <br />       (command "pline" s1 s2 s3 "c") <br />       (setq highest (max (caddr r1) (caddr r2) (caddr r3))) <br />       (setq extr (- highest bot)) <br />       (command "extrude" (entlast) "" extr 0.0) <br />       (command "slice" (entlast) "" "3points" r1 r2 r3 s1) <br />       (setq e1 (entlast)) <br />       (ssadd e1 ssrow) <br />       );progn <br />     );if <br />   );defun <br /> <br /> (princ "M2S loaded.")

yoyoho

感谢  iLisp  分享程序!

HLCAD

谢谢楼主分享程序!