(defun cmd-draw-pmesh (m n coords-list /)
(cmd-in)
(apply 'vl-cmdf (append (list "_3dmesh" m n) coords-list))
(cmd-out)
(entlast))
;;;Listing 16.1. Drawing the PolygonMesh using the 3DMESH command.
(defun PolygonMesh-header (m n)
(entmake
(list '(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolygonMesh")
'(70 . 16)
(cons 71 m)
(cons 72 n))))
;;;Listing 16.2. Function to generate the PolygonMesh header.
(defun PolygonMesh-vertex (xyz)
(entmake
(list '(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDbPolygonMeshVertex")
(cons 10 xyz)
'(70 . 64))))
;;;Listing 16.3. Function to generate each mesh vertex.
(defun ent-seqend ()
(entmake
(list '(0 . "SEQEND")
'(100 . "AcDbEntity"))))
;;;Listing 16.4. Function that creates the End of Sequence entity.
(defun ent-draw-pmesh (m n coords-list /)
(PolygonMesh-header m n)
(foreach pt coords-list
(PolygonMesh-vertex pt))
(ent-seqend)
(entlast))
;;;Listing 16.5. Drawing the mesh with entmake.
(defun ax-draw-pmesh (m n coords-list / points-array)
(setq coords-list (apply 'append coords-list)
points-array (vlax-make-safearray
vlax-vbDouble
(cons 0 (- (length coords-list) 1))))
(vlax-safearray-fill points-array coords-list)
(vla-Add3dMesh
(current-space *aevl:drawing*)
m
n
points-array))
;;;Listing 16.6. Creating the PolygonMesh with the Add3dMesh method.
(defun pmesh-data (/)
(initget 1 "Command Entmake Activex")
(setq method (getkword "\nMethod [Command/Entmake/Activex]: "))
(initget 1 "1 2 3")
(setq option (getkword "\nSurface equation [1/2/3]: ")
dimX (getreal "\nX dimension: ")
dimY (getreal "\nY dimension: ")
dimZ (getreal "\nZ dimension: ")
res (getint "\nMesh resolution (2 to 256): "))
(while (not (< 1 res 257))
(prompt "\nMesh resolution must be in the range of 2 to 256")
(setq res (getint "\nMesh resolution: ")))
(initget 1 "None Quadratic Cubic Bezier")
(setq smoothing (getkword
"\nSmoothing [None/Quadratic/Cubic/Bezier]: "))
(if (/= smoothing "None")
(progn (initget (+ 1 2 4))
(setq density (getint "\nSmoothing density (2 to 200):"))))
(cond
((= smoothing "Quadratic") (setq smoothing acQuadSurfaceMesh))
((= smoothing "Cubic") (setq smoothing acCubicSurfaceMesh))
((= smoothing "Bezier") (setq smoothing acBezierSurfaceMesh))
(t (setq smoothing nil)))
(initget 1)
(setq origin (getpoint "\nMesh center: ")
stepX (/ dimX res)
stepY (/ dimY res)
Xmin (- (/ dimX 2))
Ymin (- (/ dimY 2))))
;;;Listing 16.7. Function that prompts for the mesh definition data.
;;; Function f1
(defun f1 (x y /) (cos (sqrt (+ (* x x 2) (* y y)))))
;;; Function f2
(defun f2 (x y /) (sqrt (abs (* x y))))
;;; Function f3
(defun f3 (x y /) (/ (* x y) 10))
;;;Listing 16.8. Functions for calculating different surface shapes.
(defun op-equation (option /)
(cond
((= option "1") 'f1)
((= option "2") 'f2)
((= option "3") 'f3)))
;;;Listing 16.9. Function that determines the equation to be used.
(defun pmesh-calculus (formula Xmin Ymin dimz stepX stepY res
/ i j y lst f-height)
(setq i 0)
(while (< i res)
(setq j 0
y Ymin)
(while (< j res)
(setq lst (cons (list Xmin y (apply formula (list Xmin y)))
lst))
(setq j (1+ j)
y (+ y stepY)))
(setq i (1+ i)
Xmin (+ Xmin stepX)))
(setq f-height (/
dimz
(-
(apply 'max
(mapcar '(lambda (pt) (nth 2 pt)) lst))
(apply 'min
(mapcar '(lambda (pt) (nth 2 pt)) lst))))
lst (mapcar
'(lambda (pt)
(list (nth 0 pt)
(nth 1 pt)
(* f-height (nth 2 pt))))
lst))
(reverse lst))
;;;Listing 16.10. Function that calculates the coordinates of the mesh's vertices.
(defun C:POLYMESH (/ mtrans time method dimX dimY res origin stepX stepY
Xmin Ymin smoothing density coords-list obj *error*)
(setq time (getvar "millisecs"))
(defun *error* ()
(cmd-out)
(command-s "._UNDO" "_End"))
(vl-cmdf "._UNDO" "_Begin")
(cond
((= (getvar "WORLDUCS") 0)
(setq mtrans (last (ax-ucs-matrix))))
(t (setq mtrans nil)))
(pmesh-data)
(setq coords-list (pmesh-calculus
(op-equation option)
Xmin
Ymin
dimZ
stepX
stepY
res))
(cond
((= method "Command")
(cmd-in)
(setq mtrans nil
obj (vlax-ename->vla-object
(cmd-draw-pmesh res res coords-list)))
(cmd-out))
((= method "Entmake")
(setq obj (vlax-ename->vla-object
(ent-draw-pmesh res res coords-list))))
((= method "Activex")
(setq obj (ax-draw-pmesh res res coords-list))))
(if mtrans
(vla-TransformBy obj mtrans))
(ax-translation obj (trans origin 1 0 t))
(if smoothing
(progn (vla-put-Type obj smoothing)
(vla-put-MDensity obj density)
(vla-put-NDensity obj density)))
(vla-update obj)
(ax-SWt)
(prompt
(strcat "\nTiming: "
(rtos (- (getvar "millisecs") time) 2 0)
" miliseconds"))
(vl-cmdf "._UNDO" "_End")
(princ))
;;;Listing 16.11. Main function C:POLYMESH.
(defun cmd-draw-pface (vertices-list face-list /)
(vl-cmdf "._pface")
(foreach vert vertices-list (vl-cmdf vert))
(vl-cmdf "")
(foreach face face-list
(foreach id face (vl-cmdf id))
(vl-cmdf ""))
(vl-cmdf "")
(entlast))
;;;Listing 16.12 Function that creates the PolyfaceMesh by means of the PFACE command.
(defun def-face (face-list / tmp res vini nvert i)
(foreach face face-list
(setq vini (nth 0 face)
nvert (length face)
i 1)
(cond
((= nvert 3)
(setq res (cons (append face (list (nth 2 face))) res)))
((= nvert 4) (setq res (cons face res)))
((> nvert 4)
(repeat (- nvert 2)
(setq tmp nil)
(cond
((= i 1)
(setq tmp (cons
(list vini
(nth i face)
(nth (setq i (1+ i)) face)
(- (nth i face)))
tmp)))
((= i (- nvert 2))
(setq tmp (cons
(list (- vini)
(nth i face)
(+ (nth (setq i (1+ i)) face))
(nth i face))
tmp)))
(t
(setq tmp (cons
(list (- vini)
(nth i face)
(- (nth (setq i (1+ i)) face))
(- (nth i face)))
tmp))))
(setq res (append tmp res))))
(t
(prompt "ERROR: The face must include 3 o more vertices.")
(exit))))
(reverse res))
;;;Listing 16.13. Discretization of the faces.
(defun polyface-header (vertices-list face-list /)
(entmake
(list '(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyFaceMesh")
'(70 . 64)
(cons 71 (length vertices-list))
(cons 72 (length face-list)))))
;;;Listing 16.14. Creation of the PolyfaceMesh header entity.
(defun polyface-vertices (vertices-list /)
(foreach vert vertices-list
(entmake
(list '(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDbPolyFaceMeshVertex")
(cons 10 vert)
'(70 . 192)))))
;;;Listing 16.15. Creating the VERTEX entities.
(defun polyface-faces (face-list /)
(foreach face face-list
(entmake
(list '(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbFaceRecord")
'(10 0.0 0.0 0.0)
'(70 . 128)
(cons 71 (nth 0 face))
(cons 72 (nth 1 face))
(cons 73 (nth 2 face))
(cons 74 (nth 3 face))))))
;;;Listing 16.16. Faces creation (FaceRecord entities).
(defun ent-draw-pface (vertices-list face-list /)
(setq face-list (def-face face-list))
(polyface-header vertices-list face-list)
(polyface-vertices vertices-list)
(polyface-faces face-list)
(ent-seqend)
(entlast))
;;;Listing 16.17. Function that draws the PolyfaceMesh using entmake.
(defun ax-draw-pface (coords-list face-list / vertices-array faces-array)
(setq coords-list (apply 'append coords-list)
vertices-array (vlax-make-safearray
vlax-vbDouble
(cons 0 (- (length coords-list) 1)))
vertices-array (vlax-safearray-fill
vertices-array
coords-list)
face-list (apply 'append (def-face face-list))
faces-array (vlax-make-safearray
vlax-vbInteger
(cons 0 (- (length face-list) 1)))
faces-array (vlax-safearray-fill faces-array face-list))
(vla-AddPolyfaceMesh
(current-space *aevl:drawing*)
vertices-array
faces-array))
;;;Listing 16.18. Creating the mesh using vla-AddPolyfaceMesh.
(defun polyhedra-data (/)
(initget 1 "Command Entmake Activex")
(setq method (getkword "\nMethod [Command/Entmake/Activex]: "))
(initget 1 "Tetrahedron Hexahedron Dodecahedron")
(setq class (getkword
"\nType [Tetrahedron/Hexahedron/Dodecahedron]: ")
center (getpoint "\nPolyhedron center: ")
radius (getdist center
"\Circumscribed sphere's radius: ")))
;;;Listing 16.19. User data entry.
(defun op-polyhedron (class /)
(cond
((= class "Tetrahedron")
(setq vertices '((0 0 1)
(0 0.9428 -0.3333)
(-0.8164 -0.4714 -0.3333)
(0.8164 -0.4714 -0.3333))
faces '((1 2 3) (1 3 4) (1 4 2) (2 4 3))))
((= class "Hexahedron")
(setq vertices '((-0.5773 -0.5773 -0.5773)
(-0.5773 0.5773 -0.5773)
(0.5773 0.5773 -0.5773)
(0.5773 -0.5773 -0.5773)
(-0.5773 -0.5773 0.5773)
(-0.5773 0.5773 0.5773)
(0.5773 0.5773 0.5773)
(0.5773 -0.5773 0.5773))
faces '((1 2 3 4)
(5 6 2 1)
(6 7 3 2)
(7 8 4 3)
(8 5 1 4)
(8 7 6 5))))
((= class "Dodecahedron")
(setq vertices '((0.5773 -0.1875 0.7946)
(0.3568 0.4911 0.7946)
(-0.3568 0.4911 0.7946)
(-0.5773 -0.1875 0.7946)
(0.0 -0.6070 0.7946)
(0.9341 -0.3035 0.1875)
(0.9341 0.3035 -0.1875)
(0.5773 0.7946 0.1875)
(0.0 0.9822 -0.1875)
(-0.5773 0.7946 0.1875)
(-0.9341 0.3035 -0.1875)
(-0.9341 -0.3035 0.1875)
(-0.5773 -0.7946 -0.1875)
(0.0 -0.9822 0.1875)
(0.5773 -0.7946 -0.1875)
(0.3568 -0.4911 -0.7946)
(0.5773 0.1875 -0.7946)
(0.0 0.6070 -0.7946)
(-0.5773 0.1875 -0.7946)
(-0.3568 -0.4911 -0.7946))
faces '((1 2 3 4 5)
(1 6 7 8 2)
(2 8 9 10 3)
(3 10 11 12 4)
(4 12 13 14 5)
(5 14 15 6 1)
(6 15 16 17 7)
(8 7 17 18 9)
(10 9 18 19 11)
(12 11 19 20 13)
(14 13 20 16 15)
(16 20 19 18 17))))))
;;;Listing 16.20. Loading the polyhedron's vertices and faces data.
(defun C:POLYHEDRON-PFACE (/ *error* time mtrans method class center radius obj)
(setq time (getvar "millisecs"))
(defun *error* () (cmd-out) (command-s "._UNDO" "_End"))
(vl-cmdf "._UNDO" "_Begin")
(cond
((= (getvar "WORLDUCS") 0)
(setq mtrans (last (ax-ucs-matrix))))
(t (setq mtrans nil)))
(polyhedra-data)
(op-polyhedron class)
(cond
((= method "Command")
(cmd-in)
(setq mtrans nil
obj (vlax-ename->vla-object
(cmd-draw-pface vertices faces)))
(cmd-out))
((= method "Entmake")
(setq obj (vlax-ename->vla-object
(ent-draw-pface vertices faces))))
((= method "Activex")
(setq obj (ax-draw-pface vertices faces))))
;; Transformations:
(ax-scale obj (list radius radius radius))
(if mtrans
(vla-TransformBy obj mtrans))
(ax-translation obj (trans center 1 0 t))
(ax-SWt)
(prompt
(strcat "\nTiming: "
(rtos (- (getvar "millisecs") time) 2 0)
" milliseconds"))
(vl-cmdf "._UNDO" "_End")
(princ))
;;;Listing 16.21. Main Function C:POLYHEDRON-PFACE.
(defun pmesh-vertices-list (pmesh-ent smoothing / vertices-list)
(while
(and (setq pmesh-ent (entnext pmesh-ent))
(/= (cdr (assoc 0 (setq dxf (entget pmesh-ent))))
"SEQEND"))
(cond
(smoothing
(if (/= (logand 8 (cdr (assoc 70 dxf))) 0)
(setq vertices-list (cons (cdr (assoc 10 dxf))
vertices-list))))
(t
(if (/= (logand 16 (cdr (assoc 70 dxf))) 0)
(setq vertices-list (cons (cdr (assoc 10 dxf))
vertices-list))))))
(reverse vertices-list))
;;;Listing 16.22. Function that retrieves the vertices produced by smoothing a PolygonMesh.
(defun cal-z (xyz equation dim-z / z h f-esc)
(while xyz
(setq z (cons (apply equation (list (nth 0 xyz) (nth 1 xyz)))
z)
xyz (cdddr xyz)))
(setq h (- (apply 'max z) (apply 'min z))
f-esc (/ dim-z h))
(reverse (mapcar '(lambda (n) (* n f-esc)) z)))
;;;Listing 16.23. Function for calculating the Z coordinate.
(defun ax-mod-pmesh (pmesh-obj equation dim-z / xyz lst-z i vertices pt)
(setq xyz (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates pmesh-obj)))
lst-z (cal-z xyz equation dim-z)
i 0
name (vla-get-ObjectName pmesh-obj))
(cond
((= name "AcDbPolygonMesh")
(setq vertices (* (vla-get-MVertexCount pmesh-obj)
(vla-get-NVertexCount pmesh-obj))))
((= (vla-get-ObjectName pmesh-obj) "AcDbPolyFaceMesh")
(setq vertices (vla-get-NumberOfVertices pmesh-obj)))
(t
(prompt
"\nThe selected object must be a Polygonal or Polyface mesh.")
(exit)))
(repeat vertices
(setq pt (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinate pmesh-obj i))))
(vla-put-coordinate
pmesh-obj
i
(vlax-3d-point
(list (nth 0 pt)
(nth 1 pt)
(+ (nth 2 pt) (nth i lst-z)))))
(setq i (1+ i)))
(vla-Update pmesh-obj))
;;;Listing 16.24. Modification of the vertices of a Polygon or Polyface mesh.
No comments:
Post a Comment