3D-Flächen zu 3D-Solids (Autodesk/Rund um AutoCAD)

hab da zwei sehr gute Lösungen gefunden:

Code:

;; M2S (Mesh-to-Solid)
;; Creates an ACIS solid from an open 3d polygon mesh.
;;
;; (c) Copyright 1998 Bill Gilliss.
;; All rights reserved... such as they are.
;;
;; bill.gilliss@aya.yale.edu gilliss@iglou.com
;;
;; I wrote this to create sculptable ACIS terrain models
;; for architectural site renderings. It could also be used
;; to create thin shells from meshes, by subtracting a moved
;; copy of the solid from the original solid. Let me know of
;; other uses you find for it, or problems you encounter.
;;
;; This program works by constructing a pair of triangular
;; polylines on a flat plane directly beneath the vertices of
;; each "square" in a MxN polygon mesh. It then extrudes each
;; polyline into an ACIS solid as high as the highest corres-
;; ponding vertex on the mesh, and slices off the top with a
;; plane defined by the three points on the mesh. The result-
;; ing solids are then unioned into a complete solid.
;;
;; The solid will match the displayed mesh: if the mesh has
;; been smoothed and SPLFRAME is set to 0, the solid will be
;; smoothed. Otherwise, it will not be. The mesh itself is not
;; changed at all.
;;
;; Expect the unexpected if using a UCS radically different
;; from the WCS.
;;
;; Programmer's note: The most efficient method of unioning
;; I found was to union each row of Nx2 triangular seg-
;; ments, then to union all the M rows. It took 1-1/2 times
;; as long to union all the triangular segments at once, and
;; over 2-1/2 times as long to union each segment to the pre-
;; vious mass of unioned segments as soon as each segment was
;; created. Suggestions welcomed.
(defun C:m2s (/ ent ename entlst M N MN SN SM ST smooth oldecho vtx d1
low vtxcnt vtxmax bot bottom p1 p2 p3 p4 c1 c2 c3 c4 b1 b2
b3 b4 r1 r2 r3 s1 s2 s3
)
;;select the mesh
(setq ent (entsel "Select a polygon mesh to solidify: "))
(setq ename (car ent))
(setq entlst (entget ename))
(if (not (= (cdr (assoc 0 entlst)) "POLYLINE"))
(progn
(alert "That is not a polygon mesh.")
(exit)
(princ)
)
) ;endif
(if
(not
(or
(= (cdr (assoc 70 entlst)) 16) ;open 3d polygon mesh
(= (cdr (assoc 70 entlst)) 20) ;open 3d polygon mesh with spline-fit vertices
) ;or
) ;not
(progn
(alert "That is not an *open* polygon mesh.")
(exit)
(princ)
) ;progn
) ;endif
;; decide whether to use smoothed or unsmoothed vertices
(setq M (cdr (assoc 71 entlst))) ;M vertices
(setq N (cdr (assoc 72 entlst))) ;N vertices
(setq SM (cdr (assoc 73 entlst))) ;smoothed M vertices
(setq SN (cdr (assoc 74 entlst))) ;smoothed N vertices
(setq ST (cdr (assoc 75 entlst))) ;surface type
(if
(or
(= (getvar "splframe") 1) ;use MxN vertices when splframe = 1
(= ST 0) ;or mesh has not been smoothed
)
(progn
(setq smooth 0
MN (* M N)
)
) ;progn
(progn
(setq smooth 1) ;use SMxSN vertices when mesh is smoothed and SPLFRAME = 0
(setq MN (* SM SN)
M SM
N SN
)
) ;progn
) ;if
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
;; determine lowest vertex
(grtext -2 "Checking out the mesh...")
(setq vtx ename)
(setq vtx (entnext vtx))
(setq d1 (entget vtx))
(setq bottom (caddr (trans (cdr (assoc 10 d1)) 0 1)))
;translate to current UCS
(repeat (1- MN) ;compare with each vertex's z coord
(setq vtx (entnext vtx))
(setq d1 (entget vtx))
(setq low (caddr (trans (cdr (assoc 10 d1)) 0 1)))
(setq bottom (min bottom low))
) ;repeat
(setq bot (1+ bottom))
(while (> bot bottom)
(princ (strcat "\nLowest vertex is at elevation "
(rtos bottom)
" Enter elevation for bottom"
)
)
(setq bot
(getreal
"\nof solid, which must be at or BELOW the lowest vertex: "
)
)
)
;;Draw 2 triangular polylines for each mesh square
(setq p1 ename)
(if (= smooth 1)
(setq p1 (entnext p1))
) ;skip first vertex of smoothed mesh - not true vertex
(setq vtxcnt 1)
(setq vtxmax (- MN N))
(setq ssrow (ssadd)) ;create set of segments to be unioned at end of row
(setq ssall (ssadd)) ;create set of rows to be unioned at end of program
(grtext -2 "Creating first row...")
(while (< vtxcnt vtxmax)
(if (= 0 (rem vtxcnt N)) ;at end of each row...
(progn
(grtext -2 "Unioning row...")
(command "union" ssrow "") ;union row
(setq row (entlast))
(ssadd row ssall) ;add unioned row to set of rows
(setq ssrow (ssadd)) ;reinitialize selection set of pieces
(setq p1 (entnext p1)) ;go to the next vertex
(setq vtxcnt (1+ vtxcnt))
(grtext -2 "Creating row...")
) ;progn
) ;if

(setq p1 (entnext p1) ;first vertex of mesh square
p2 (entnext p1) ;second vertex
p3 p2
)
(repeat (1- n) ;walk along to 3rd (p+N) vertex
(setq p3 (entnext p3))
)
(setq p4 (entnext p3)) ;4th vertex of mesh square
(setq c1 (trans (cdr (assoc 10 (entget p1))) 0 1) ;top coordinates
c2 (trans (cdr (assoc 10 (entget p2))) 0 1)
c3 (trans (cdr (assoc 10 (entget p3))) 0 1)
c4 (trans (cdr (assoc 10 (entget p4))) 0 1)
b1 (list (car c1) (cadr c1) bot) ;bottom coordinates
b2 (list (car c2) (cadr c2) bot)
b3 (list (car c3) (cadr c3) bot)
b4 (list (car c4) (cadr c4) bot)
)
(LOFT c1 c2 c3 b1 b2 b3) ;loft first triangle
(LOFT c2 c3 c4 b2 b3 b4) ;loft second triangle
(setq vtxcnt (1+ vtxcnt))
) ;while
(grtext -2 "Unioning last row...")
(command "union" ssrow "") ;union last row
(setq row (entlast))
(ssadd row ssall) ;add unioned row to set of rows
(grtext -2 "Unioning all rows...")
(command "union" ssall "") ;union everything
(setvar "cmdecho" oldecho) ;cleanup
(setq ssrow nil
ssall nil
)
(princ)
) ;defun
;;============== SUBROUTINES ====================
(defun *error* (msg)
(if (/= msg "Function cancelled")
(if (= msg "quit / exit abort")
(princ)
(progn ;clean up variables so they don't go global
(princ (strcat "\nError: " msg))
(setq ent nil
ename nil
entlst nil
M nil
N nil
MN nil
SN nil
SM nil
ST nil
smooth nil
oldecho nil
vtx nil
d1 nil
low nil
vtxcnt nil
vtxmax nil
bot nil
bottom nil
p1 nil
p2 nil
p3 nil
p4 nil
c1 nil
c2 nil
c3 nil
c4 nil
b1 nil
b2 nil
b3 nil
b4 nil
r1 nil
r2 nil
r3 nil
s1 nil
s2 nil
s3 nil
e1 nil
extr nil
highest nil
ssrow nil
ssall nil
)
)
)
(princ)
)
) ;defun
(defun LOFT (r1 r2 r3 s1 s2 s3 / e1 extr highest)
(command "pline" s1 s2 s3 "c")
(setq highest (max (caddr r1) (caddr r2) (caddr r3)))
(setq extr (- highest bot))
(command "extrude" "L" "" extr "")
(command "slice" "L" "" "3" r1 r2 r3 s1)
(setq e1 (entlast))
(ssadd e1 ssrow)
)

-------------------------------------------------------------------

Code:

; 3DFA2SOL.LSP
; Theo L.A. Groenenberg
; Leusden NL
; acadvice@worldonline.nl
; http://www.dra.nl/~acadvice
;
; Converts 3Dfaces to solids.
;
; I'm an architect in Long Island, New York.
; I'm looking for a routine that automatically
; fills an area with a solid, similar to the bhatch command.
; There are commercial applications that do this such as m-color
; but I do not want to spend $300 dollars.
; I you know of any such routines that are more reasonable priced,
; please let me know. Thank you.
;
; George Pardo
;
; Hi George, here's something you can work with.
; Create REGIONs of all your areas using the BPOLY or
; REGION commands.
; Edit them if neccesary with UNION, SUBTRACT, etc.
; Use the 3DSOUT command and select your REGIONs.
; Erase the previous REGIONs.
; Use the 3DSIN command and select add, meshes.
; EXPLODE the MESHes. Now you are left with 3DFACEs.
; Now use this routine.
;
; Sounds complicated, but saves you $300.
;
; Good luck & regards Theo.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun 3dfa2sol (/ aantal n naam face hoogte solist)
(command "_undo" "_m")
(prompt (strcat "\n" (itoa (sslength faceset)) " 3DFACEs found.\n"))
(setq aantal (sslength faceset)
n 0
)
(prompt "\nConverting 3DFACEs to SOLIDs.....")
(repeat aantal
(setq naam (ssname faceset n)
n (+ n 1)
face (entget naam)
hoogte (/ (+ (caddr (cdr (assoc 10 face)))
(caddr (cdr (assoc 11 face)))
(caddr (cdr (assoc 12 face)))
(caddr (cdr (assoc 13 face)))
) 4
)
)
(entdel naam)
(setq solist (list (cons 0 "SOLID")
(assoc 8 face)
(cons 10 (list (car (cdr (assoc 10 face)))
(cadr (cdr (assoc 10 face)))
hoogte
)
)
(cons 11 (list (car (cdr (assoc 11 face)))
(cadr (cdr (assoc 11 face)))
hoogte
)
)
(cons 12 (list (car (cdr (assoc 13 face)))
(cadr (cdr (assoc 13 face)))
hoogte
)
)
(cons 13 (list (car (cdr (assoc 12 face)))
(cadr (cdr (assoc 12 face)))
hoogte
)
)
(cons 39 (* -1 hoogte))
)
)
(entmake solist)
)
(redraw)
(alert "The command UNDO with the option BACK\n\nwill undo everything to the start of 3DFA2SOL.")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:3dfa2sol (/ faceset)
(setvar "cmdecho" 0)
(setvar "splframe" 1)
(prompt "\nSelect 3DFACEs.")
(setq faceset (ssget '((0 . "3DFACE"))))
(if faceset
(3dfa2sol)
(alert "No 3DFACEs found.")
)
(prompt "\nRegards Theo.")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

------------------
"Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?" Read the whole story: The Autodesk File ca. 890 Seiten | 7500 KB PDF

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP