[编程交流] 需要体素3D实体

(defun c:voxelize ()
   (command "undo" "begin")
   (setq
oosmode                (getvar "osmode")
o3Dosmode        (getvar "3Dosmode")
clayer                (getvar "clayer")
   )
   (setvar "osmode" 0)
   (setvar "3Dosmode" 0)
   (setq
voxsld                (car (entsel "\nSelect Solid to Voxelize: "))
voxsldobj        (vlax-ename->vla-object voxsld)
   )
   (vla-GetBoundingBox voxsldobj 'MinP 'MaxP)
   (setq
minsld        (vlax-safearray->list MinP)
maxsld        (vlax-safearray->list MaxP)
abssldx        (- (car maxsld) (car minsld))
abssldy        (- (cadr maxsld) (cadr minsld))
abssldz        (- (caddr maxsld) (caddr minsld))
           voxsize        (getint (strcat "\nVoxel Size (Bounding box is " (rtos abssldx 2 0) "x" (rtos abssldy 2 0) "x" (rtos abssldy 2 0) "): "))
xcount        (1+ (fix (/ abssldx voxsize)))
ycount        (1+ (fix (/ abssldy voxsize)))
zcount        (1+ (fix (/ abssldz voxsize)))
voxcnt        1
xcnt        0
ycnt        0
zcnt        0
voxx        (car minsld)
voxy        (cadr minsld)
voxz        (caddr minsld)
voxvol        (expt voxsize 3)
   )
   (setq
voxx1        (- voxx (/ voxsize 2))
voxy1        (- voxy (/ voxsize 2))
voxz1        (- voxz (/ voxsize 2))
voxpnt1        (list voxx1 voxy1 voxz1)
   )
   (setq nl (open "c:/temp/pointfile.csv" "w") )
  
   (command "._layer" "_m" "cons" "")
   (command "._box" voxpnt1 "_C" voxsize)
   (setq curvox (entlast))
   (while (< zcnt zcount)
(while (< ycnt ycount)
    (while (< xcnt xcount)
        (setq
            xcnt        (1+ xcnt)
            voxxcen        (+ voxx (* xcnt voxsize))
            voxx2        (- voxxcen (/ voxsize 2))
            voxycen        (+ voxy (* ycnt voxsize))
            voxy2        (- voxycen (/ voxsize 2))
            voxzcen        (+ voxz (* zcnt voxsize))
            voxz2        (- voxzcen (/ voxsize 2))
            voxpnt2        (list voxx2 voxy2 voxz2)
        )
        (if (vla-CheckInterference (vlax-ename->vla-object curvox) (vlax-ename->vla-object voxsld) :vlax-true 'test)
            (progn
                (setq
                    curvoxint                (entlast)
                    curvoxintobj        (vlax-ename->vla-object curvoxint)
                )
                (if (> (vla-get-volume curvoxintobj) (/ voxvol 2.01))
                    (progn
                        (entdel curvoxint)
                        (command "._copy" curvox "" voxpnt1 voxpnt2)
                        (setq curvox (entlast))
                        (write-line (strcat (itoa voxcnt) "," (rtos voxxcen 2 3) "," (rtos voxycen 2 3) "," (rtos voxzcen 2 3)) nl)
                        (setq voxcnt (1+ voxcnt) )
                    )
                    (progn
                        (entdel curvoxint)
                        (command "._move" curvox "" voxpnt1 voxpnt2)
                    )
                )
            )
            (command "._move" curvox "" voxpnt1 voxpnt2)
        )
        (setq
            voxx1        voxx2
            voxy1        voxy2
            voxz1        voxz2
            voxpnt1        voxpnt2
        )
    )
    (setq
        xcnt        0
        ycnt        (1+ ycnt)
    )
)
(setq
    ycnt        0
    zcnt        (1+ zcnt)
)
   )
   (entdel (entlast))
   (close nl)
   (setvar "clayer" clayer)
   (setvar "osmode" oosmode)
   (setvar "3Dosmode" o3Dosmode)
   (if (> voxcnt 1)
(setq cntplrl "s")
(setq cntplrl "")
   )
   (princ (strcat "\n" (itoa voxcnt) " Voxel" cntplrl " Created"))
   (command "undo" "end")
   (princ)
)

(defun c:voxel (/ *error* doc s os en i sol sob ss sz int bb xyz box a b z)
;hanhphuc .29.03.2018 
[color="green"];Just for voxel test purpose, currently only WCS[/color]
 (defun *error* (msg) (if os (setvar 'osmode os)))
 (setq os (getvar 'osmode)
doc '((l / doc)
(setq doc (vlax-get-acad-object))
(foreach x l (setq doc (vlax-get doc x))))
)
 (setvar 'osmode 0)
 (princ "\nVoxelize Solid object..")
 (and 
     (while (not s)
             (setq s (ssget "_:S:E+." '((0 . "3DSOLID")))
              )
     )
      (setq sol (ssname s 0) sob (vlax-ename->vla-object sol))
      (progn (vla-GetBoundingBox sob 'a 'b)
      (setq bb (mapcar 'vlax-safearray->list (list a b)))
      (setq xyz (apply 'mapcar (cons '(lambda (a b) (rtos (- b a) 2 0)) bb)) )
      (initget 7)
      (setq sz (getint (strcat "\nSpecify voxel size (Bounding box is " (cadr xyz) "x" (car xyz) "x" (caddr xyz) "): ")))
 ); progn
 (setq xyz (mapcar 'atoi xyz))
             (setq box (vla-AddBox (doc '(ActiveDocument ActiveLayout Block))
                (vlax-3d-point (mapcar ''((x)(+ x (* 0.5 sz)))(car bb))) sz sz sz))
        (progn
 (vla-ArrayRectangular box (/(cadr xyz) sz) (/(car xyz) sz) (/([color="red"][b]caddr[/b][/color] xyz)sz) sz sz sz)
      (gc)
 (princ "\nSelect voxel " )
        (setq ss (ssget ":L" '((0 . "3DSOLID"))))
 );progn 
  (progn
      (ssdel sol ss)
      (repeat (setq i (sslength ss))
        (if (and (setq en (ssname ss (setq i (1- i))))
                 (setq int (vla-checkinterference (vlax-ename->vla-object en) sob :vlax-true))
                 ) 
          (ssdel en ss)
          )
        (if int (entdel (vlax-vla-object->ename int)))
        )
      (vl-cmdf "_.erase" ss "")
      (if os
        (setvar 'osmode os)
        ) 
      ); progn
      ) ;and
 
 (*error* nil)
 
 (princ)
 ) ;_ end of defun
(vl-load-com)

(defun c:voxelize2 ()
   (command "undo" "begin")
   (setq
oosmode                (getvar "osmode")
o3Dosmode        (getvar "3Dosmode")
clayer                (getvar "clayer")
   )
   (setvar "osmode" 0)
   (setvar "3Dosmode" 0)
   (setq
voxsld                (car (entsel "\nSelect Solid to Voxelize: "))
voxsldobj        (vlax-ename->vla-object voxsld)
voxsldvol        (vla-get-volume voxsldobj)
   )
   (vla-GetBoundingBox voxsldobj 'MinP 'MaxP)
   (setq
minsld                (vlax-safearray->list MinP)
maxsld                (vlax-safearray->list MaxP)
abssldx                (- (car maxsld) (car minsld))
abssldy                (- (cadr maxsld) (cadr minsld))
abssldz                (- (caddr maxsld) (caddr minsld))
volratio        0.
abslst                (list abssldx abssldy abssldz)
abslst                (vl-sort abslst '>)
octside                (car abslst)
minoct                minsld
maxoct                (list (+ (car minoct) octside) (+ (cadr minoct) octside) (+ (caddr minoct) octside))
octcnt                0
   )
   (command "._layer" "_m" "cons" "")
   (setq voxlst (octdivide (list minoct maxoct) 0) )
   (while (< volratio 0.7) ; 70% fill volume
(setq octcnt (1+ octcnt))
(foreach vox voxlst
    (if (= (car vox) 0)
        (progn
            (setq
                voxpnt1        (cadr vox)
                voxpnt2        (caddr vox)
            )
            (command "._box" voxpnt1 voxpnt2)
            (setq
                curvox                (entlast)
                checkval        (checkinterfere curvox voxsld)
            )
            (entdel curvox)
            (cond
                ((= checkval nil)        ;not inside solid (remove from list)
                 (setq voxlst (vl-remove vox voxlst))
                )
                ((= checkval 0)        ;partialy inside solid (octree)
                 (setq
                     voxlst        (vl-remove vox voxlst)
                     voxlst        (append voxlst (octdivide (list voxpnt1 voxpnt2) 0))
                 )
                )
                ((> checkval 0)        ;100% inside solid (no more work needed)
                 (setq voxlst (subst (cons octcnt (cdr vox)) vox voxlst))
                )
            )
        )
    )
)
(setq totalvoxvol 0.)
(foreach vox voxlst
    (if (> (car vox) 0)
        (progn
            (setq
                voxpnt1        (cadr vox)
                voxpnt2        (caddr vox)
            )
            (command "._box" voxpnt1 voxpnt2)
            (setq
                curvox                (entlast)
                    curvoxobj        (vlax-ename->vla-object curvox)
                curvoxvol        (vla-get-volume curvoxobj)
                totalvoxvol        (+ totalvoxvol curvoxvol)
            )
            (entdel curvox)
        )
    )
)
(setq volratio (/ totalvoxvol voxsldvol) )
   )
;;;    Remove un-used voxels
   (foreach vox voxlst
(if (= (car vox) 0)
    (setq voxlst (vl-remove vox voxlst))
)
   )
   
   (setq revoxcnt 1)
   
   (while (< revoxcnt octcnt)
(foreach vox voxlst
    (if (= (car vox) revoxcnt)
        (progn
            (setq
                voxpnt1        (cadr vox)
                voxpnt2        (caddr vox)
            )
            (setq
                voxlst        (vl-remove vox voxlst)
                voxlst        (append voxlst (octdivide (list voxpnt1 voxpnt2) (1+ revoxcnt)))
            )
        )
    )
)
(setq revoxcnt (1+ revoxcnt) )
   )
   (setq voxcnt 0)
;;;    Draw All Voxels
   (foreach vox voxlst
(setq
    voxpnt1        (cadr vox)
    voxpnt2        (caddr vox)
)
(command "._box" voxpnt1 voxpnt2)
(setq voxcnt (1+ voxcnt) )
   )
   (setvar "clayer" clayer)
   (setvar "osmode" oosmode)
   (setvar "3Dosmode" o3Dosmode)
   (if (> voxcnt 1)
(setq cntplrl "s")
(setq cntplrl "")
   )
   (princ (strcat "\n" (itoa voxcnt) " Voxel" cntplrl " Created"))
   (command "undo" "end")
   (princ)
)
(defun octdivide (cellcnrs octind)  
   (setq
cellmin                (car cellcnrs)
cellmax                (cadr cellcnrs)
cellabsx        (- (car cellmax) (car cellmin))
cellabsy        (- (cadr cellmax) (cadr cellmin))
cellabsz        (- (caddr cellmax) (caddr cellmin))
newcell1        (list cellmin (dvmid cellmin cellmax))
newcell2        (list (polar (car newcell1) (dtr 0.) (/ cellabsx 2)) (polar (cadr newcell1) (dtr 0.) (/ cellabsx 2)))
newcell3        (list (polar (car newcell1) (dtr 90.) (/ cellabsy 2)) (polar (cadr newcell1) (dtr 90.) (/ cellabsy 2)))
newcell4        (list (polar (car newcell2) (dtr 90.) (/ cellabsy 2)) (polar (cadr newcell2) (dtr 90.) (/ cellabsy 2)))
newcell5        (list (list (car (car newcell1)) (cadr (car newcell1)) (caddr (cadr newcell1))) (list (car (cadr newcell1)) (cadr (cadr newcell1)) (caddr cellmax)))
newcell6        (list (polar (car newcell5) (dtr 0.) (/ cellabsx 2)) (polar (cadr newcell5) (dtr 0.) (/ cellabsx 2)))
newcell7        (list (polar (car newcell5) (dtr 90.) (/ cellabsy 2)) (polar (cadr newcell5) (dtr 90.) (/ cellabsy 2)))
newcell8        (list (cadr newcell1) cellmax)
newcellscnrs        (list (cons octind newcell1) (cons octind newcell2) (cons octind newcell3) (cons octind newcell4) (cons octind newcell5) (cons octind newcell6) (cons octind newcell7) (cons octind newcell8))
   )
   newcellscnrs
)
(defun checkinterfere (vox sld)
   (setq
return                0
voxobj                (vlax-ename->vla-object vox)
voxvol                (vla-get-volume voxobj)
   )
   (if (vla-CheckInterference voxobj (vlax-ename->vla-object sld) :vlax-true 'test)
(progn
    (setq
        curvoxint        (entlast)
        curvoxintobj        (vlax-ename->vla-object curvoxint)
        curvoxintvol        (vla-get-volume curvoxintobj)
    )
    (if (equal curvoxintvol voxvol 1.)
        (setq return octcnt)                ; 100% overlap
        (setq return 0)                        ; less than 100% overlap (needs octree-ing)
    )
    (entdel curvoxint)
)
(setq return nil)                ; no overlap - remove from list
   )
   return
)
(defun DVmid ( a b )(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b))                ;; Midpoint  -  Lee Mac Returns the midpoint of two points

(car (car x )) = ([color="blue"]caar[/color] x)
(dtr 90) --> (setq 90° (* 0.5 pi)) ; <--- just use variable 90°
(dtr 0) = 0

(vla-CheckInterference voxobj sol :vlax-true '[color="red"]test[/color] )

(angtof "90" 0) >> 1.5708

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
   (* 90° 90°)..................................1014 / 6.62 <fastest>  [color="green"]; during iteration directly pointing to the value[/color]
   (* ([color="blue"]DTR[/color] 90.0) ([color="blue"]DTR[/color] 90.0))....................1186 / 5.66 [color="green"]; <-- a bit slow because we need a function to convert the value[/color]
   (* ([color="blue"]CVUNIT[/color] 90 "degrees" "radians") (...).....1794 / 3.74 [color="green"]; <-- function slows down due to lookup units degrees -> radians before conversion?[/color]
   (* ([color="blue"]ANGTOF[/color] "90" 0) ([color="blue"]ANGTOF[/color] "90" 0))..........6708 / 1 <slowest> [color="green"]; <-- extra conversion string->number->lookup units->evaluation ?[/color]
      

Elapsed milliseconds / relative speed for 32768 iteration(s):
   (/ PI 2).........1950 / 1.00 <fastest>
   (/ 3.1416 2).....1950 / 1.00 <slowest>

Elapsed milliseconds / relative speed for 16384 iteration(s):
   (/ PI 2)............1030 / 2.10 <fastest>
   (ANGTOF "90" 0).....2168 / 1.00 <slowest>