Jump to content

Need to Voxel 3D Solid

ColinHolloway

By ColinHolloway
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

ColinHolloway Contributor

ColinHolloway

Posted
Posted (edited)

Hi All,

 

Below is the first draft of my routine to Voxelize a 3D solid in AutoCAD. The method I have used is to check for interference between each voxel cube and the original 3D solid. If there is an overlap (greater than 50%) keep that voxel and move on. It works but runs quite slowly.

 

Any and all input to optimize this would be greatly appreciated.

 

(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)
)

Edited by ColinHolloway
Code added
Link to comment
Share on other sites
hanhphuc Mentor

hanhphuc

Posted
Posted (edited)
Hi All,

 

Below is the first draft of my routine to Voxelize a 3D solid in AutoCAD. The method I have used is to check for interference between each voxel cube and the original 3D solid. If there is an overlap (greater than 50%) keep that voxel and move on. It works but runs quite slowly.

 

Any and all input to optimize this would be greatly appreciated.

 

(defun c:voxelize ()
  ..

 

I was curious 0 respond i decided to try but noticed that you have added the code! Thanks for sharing anyway.:thumbsup:

 

1.To optimize the performance, IMO turn off visual effect plan view.

2.Avoid using command especially in loop (while repeat etc..), entmake or vla- method are faster

 

My attempt is very slow too.

(It takes about 1minit for 20x15x10 at size=1x1x1 :oops:)

perhaps due to using 3DArray method to fill up the bounding box.

then taking time interference with main body then remove the residual.

3Darray has limitation which can not exceed approx 1M !!

 

i tried to adopt from your idea which user input as Row x Column x Height allows user to decide the appropriate size of voxel.

 


(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)

Edited by hanhphuc
typo - car to caddr
Link to comment
Share on other sites
ColinHolloway Contributor

ColinHolloway

Posted
  • Author
Posted (edited)

Hi Hahn,

 

Thank you for your collaboration on this project. This is what I love about CadTutor! :-)

 

Over the last few days I have refined my code to incorporate Octree's to speed up the process. The code now defines a cube that contains the selected solid and then sequentially divides each cube into 8 smaller cubes based on whether the interference solid has 100% of the voxel volume. The process continues until the total volume of the voxels is 70% of the original solid (a figure that works well for my application).

 

Here is my latest code. I look forward to your feedback, suggestions and code refinements.

 

(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

Edited by ColinHolloway
Code Updated
Link to comment
Share on other sites
ColinHolloway Contributor

ColinHolloway

Posted
  • Author
Posted
Hi colin

 

Your octodivide function has a dependency which you didn't include (DVMID function)

 

Added to code section.

Link to comment
Share on other sites
hanhphuc Mentor

hanhphuc

Posted
Posted

Nice! no doubt octree fractal is the best solution :thumbsup:

 

 

FWIW 

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

 

another way optimize, have you tried lisp compiled as vlx?

boost faster

 

p/s: ac2007 only allows 3 arguments, though was quoted comment but after search autodesk HELP online, an added argument for newer version

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

Link to comment
Share on other sites
ColinHolloway Contributor

ColinHolloway

Posted
  • Author
Posted

Hi Hanh,

 

Thanks for the feedback and tips! This LSP will be compiled into a VLX with other routines for this project.

 

Colin

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted

FWIW 

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

 

 

BTW I've seen Marko using the angtof function:

(angtof "90" 0) >> 1.5708

Link to comment
Share on other sites
hanhphuc Mentor

hanhphuc

Posted
Posted
BTW I've seen Marko using the angtof function:

(angtof "90" 0) >> 1.5708

 

my suggestion was - by supplying constant variable (setq 90° ), are we possible to optimize the speed for very large iterations? shall this take into account?

so your suggestion is appreciated too ;)

 

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]

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted

Just included something about easy angle-conversion, Anyway talking about speed then this should be even faster: (* 1.5708 1.5708 ) , but harder to interpreter for the programmer. :)

Link to comment
Share on other sites
Jef! Rising Star

Jef!

Posted
Posted
Just included something about easy angle-conversion, Anyway talking about speed then this should be even faster: (* 1.5708 1.5708 ) , but harder to interpreter for the programmer.

I would not recommend using an approach like that because there is no time gain but the precision is lost compared to using pi

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

Using pi is also faster than using angtof 

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

 

While Hanhphuc is right, (instead of using angtof like functions) this is the comparison of using a var containing an operation made on pi vs making the pi operation. 

Elapsed milliseconds / relative speed for 16384 iteration(s):
   (+ 90DEG 90DEG)...........1856 / 1.38 <fastest>
   (+ (/ PI 2) (/ PI 2)).....2558 / 1.00 <slowest>

The diff is negligible and the difference is only due to the (/) operations. (After all whether you use 90DEG or pi, they are the same, a variable containing a float)

 

For the 4th argument of vla-CheckInterference, it could be used to see if there is an interference without actually creating a solid that would require to be erased afterward if not needed. If the solid is needed then one could use directly the function return value (# vs nil)

 

ColinHolloway! :)

Based on my understanding of your code:

  1. if checkval is nil, it means the voxel is outside the starting solid, and is erased and removed from the voxlst list.
  2. if checkval is bigger than 0, it means the voxel is inside the starting solid, and is kept in the voxlst list.
  3. voxlst is the one that is used to cumulate the volume to see if it exceeds 0.70.
  4. if a cube is partially outside (checkval 0), it is removed from the list and replaced by the 8 octodivision with a car of 0, which should make them be excluded in the count on the cumulative volume.

Am I right on all these? If do, something baffles me

 

Draw a radius of 6 shpere. Run voxelize2. You end up with 1 sphere and 208 cubes, 48 of which are partially outside the sphere.

The sphere volume is 904.779.

The volume of the 160 cubes 100% included in the sphere is 540.0 (59.6%)

The volume of all the 208 cubes (including the ones partially outside the sphere) is 702.0 (77.58%).

I just don't see where in your code cubes partially outside could get counted towards the total volume (unless I missed something or it is due to an error making or manipulating some lists somewhere)

 

I'm asking because I made a version that doesn't use any command calls. It requires lots of safe-arrays>pline>region>3Dsolid to handle.

If cubes has 100% interference I stop processing them and add their volume to the cumulative total volume.

If no interference I delete them.

If partially outside I plan the next subdivision

If i'm under the 0.70 I create the next subdivision cubes, and process the new cubes with the same criteria.

My runtime is not better BUT I end up with 560 cubes (worth 1568!) which are 100% included in the sphere. Basically for that sphere I process 8x more cubes using 2 1/2 your time using vl- calls. To make an apple to apple comparison, we need to have the same result tho. Is your routine not doing enough or is it mine doing too much? :D

Link to comment
Share on other sites
ColinHolloway Contributor

ColinHolloway

Posted
  • Author
Posted (edited)

Hi Jef!

Thank you for your input to this project!

 

I found the logic bomb that allowed my routine to have cubes outside the original solid... I am working in a metric mm system so I was testing on a 200 radius sphere, so when I set the tolerance for the interference volume comparison I made it 1.0. This worked fine for large items but not a sphere of radius 6! :-)

 

Below is the revised version of my routine. It creates 1568 cubes for any size sphere.

 

To answer your question in Point 4... yes I am octree-ing those cubes and NOT using them in the volume calculation. This is one area where I could gain some efficiency by only dividing the cube if the volume ratio is less that 0.7, but because of the way I am working through the list I am OK with this other head for now.

 

I look forward to seeing how the runtimes compare with the different approaches to the same problem :-)

 

(defun c:voxelize ()
   (command "undo" "begin")
   (setq
oosmode		(getvar "osmode")
o3Dosmode	(getvar "3Dosmode")
clayer		(getvar "clayer")
90deg		(* 0.5 pi)
   )
   (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 (list (cons 0 (list minoct maxoct))) )

   (while (< volratio 0.7)
(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 curtotalvoxvol 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)
		curtotalvoxvol	(+ curtotalvoxvol curvoxvol)
	    )
	    (entdel curvox)
	)
    )
)
(setq volratio (/ curtotalvoxvol 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) )
   )

;;;	Sort Voxel List by Z value
   (setq voxlst (vl-sort voxlst (function (lambda (x y) (< (caddr (cadr x)) (caddr (cadr y)))))) )

   (setq totalvoxvol 0.)

;;;    Draw Final Sorted Voxels
   (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)
	)
    )
)
   )

   (setq voxcnt (length voxlst))
   (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"))
   (princ (strcat "\n Final Voxel to Volume Ratio: " (rtos (/ totalvoxvol voxsldvol) 2 3)))
   (command "undo" "end")
   (princ)
)




;;;	Helper Sub-Routines
(defun DVmid ( a b )(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b))		;; Midpoint  -  Lee Mac Returns the midpoint of two points

(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) 0. (/ cellabsx 2)) (polar (cadr newcell1) 0. (/ cellabsx 2)))
newcell3	(list (polar (car newcell1) 90deg (/ cellabsy 2)) (polar (cadr newcell1) 90deg (/ cellabsy 2)))
newcell4	(list (polar (car newcell2) 90deg (/ cellabsy 2)) (polar (cadr newcell2) 90deg (/ cellabsy 2)))
newcell5	(list (list (caar newcell1) (cadr (car newcell1)) (caddr (cadr newcell1))) (list (car (cadr newcell1)) (cadr (cadr newcell1)) (caddr cellmax)))
newcell6	(list (polar (car newcell5) 0. (/ cellabsx 2)) (polar (cadr newcell5) 0. (/ cellabsx 2)))
newcell7	(list (polar (car newcell5) 90deg (/ cellabsy 2)) (polar (cadr newcell5) 90deg (/ 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))
newcellabsx	(/ cellabsx 2)
newcellabsy	(/ cellabsy 2)
newcellabsz	(/ cellabsy 2)
   )
   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 0.0) ; tolerance changed to 0.0 to ensure 100% overlap
	(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
)

Edited by ColinHolloway
Clarification on point 4
Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted
I would not recommend using an approach like that because there is no time gain but the precision is lost compared to using pi

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

 

Hm this is interesting fact:

I thought that PI would be interpreted as a protected symbol, which would hold the value 3.1416... so that symbol-value accessing would potentially slow-down.

But this benchmark means that PI is not a symbol, and is interpreted as a REAL.

 

_$ (type PI) >> REAL

 

So:

Anyway talking about speed then this should be even faster: (* 1.5708 1.5708 ) , but harder to interpreter for the programmer.

 

 

Using pi is also faster than using angtof 

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

 

With the conclusion above, you actually compare the '/' function with 'angtof', so yeah its faster.

 

 

While Hanhphuc is right, (instead of using angtof like functions) this is the comparison of using a var containing an operation made on pi vs making the pi operation. 

Elapsed milliseconds / relative speed for 16384 iteration(s):
(+ 90DEG 90DEG)...........1856 / 1.38 <fastest>
(+ (/ PI 2) (/ PI 2)).....2558 / 1.00 <slowest>

The diff is negligible and the difference is only due to the (/) operations. (After all whether you use 90DEG or pi, they are the same, a variable containing a float)

 

Most of you probably know this:

Accessing symbol's value is always faster, than evaluating a function (no matter how simple the evaluation is).

Your benchmark is the perfect example of what I mean. :roll:

 

 

My initial thought was if PI was a protected symbol - defined like this:

(setq MyPI PI)

Then accessing its value should slowdown, rather than supplying the actual val:

(/ MyPI 2) ; <- should be slower 
(/ 3.1416 2) ; <- should be faster

So if 

_$ (/ PI 2) >> 1.5708

Then:

(+ 1.5708 1.5708) ; should be fastest
(+ 90DEG 90DEG) ; should be in the middle
(+ (/ PI 2) (/ PI 2)) ; obviously slowest

But I agree with you that precision will/might be lost, and I'd probably use suggestion like Hanhphuc's.

Link to comment
Share on other sites
Jef! Rising Star

Jef!

Posted
Posted
Hm this is interesting fact:

I thought that PI would be interpreted as a protected symbol, which would hold the value 3.1416... so that symbol-value accessing would potentially slow-down.

But this benchmark means that PI is not a symbol, and is interpreted as a REAL.

You got some things right, and some wrong. Pi IS a symbol. PI is also a protected symbol. A symbol could be bound to many things, a string, a real, an integer or a function. Everything you set is a symbol. Setq is a symbol-handling function. Its function is to "Set the value of a symbol or symbols to associated expressions".

Even you could be a symbol as long as you Setq yourself!

Command: (setq Grrr ":)")

":)"

Command: (vl-symbolp 'Grrr)

T

 

As for your which should be/not be faster you are not quite right either.

1rst try:
Elapsed milliseconds / relative speed for 16384 iteration(s):
   (/ MYPI 2).......1467 / 1.02 <fastest>
   (/ PI 2).........1497 / 1.00
   (/ 3.1416 2).....1498 / 1.00 <slowest>
2nd try: 
Elapsed milliseconds / relative speed for 16384 iteration(s):
   (/ PI 2).........1170 / 1.03 <fastest>
   (/ MYPI 2).......1201 / 1.00
   (/ 3.1416 2).....1201 / 1.00 <slowest>

They are all exactly the same as they all do the same, which is divide a real by 2. (benchmarking is not an exact science, and vary slightly depending on what the cpu is doing at the same time. Each expression can vary by few%, thus changing the order if the difference is not significant. look at the 1467@1498 ms for 16384 iterations on the 1rst try compared to the 1170@1201 ms for the same amount of iterations of the 2nd. Obviously my cpu was doing something in the background the 1rst time)

 

On the subject of protected/non protected symbols, you can change any symbol to a protected one and vice versa. Protected symbols appear blue in the vlide but the potential of breaking things up is very present, a little bit like playing with the qaflags var. Probably for that reason there is no official literature on the function needed to do that, but you still can find old unofficial stuff about it if you dig deep. the functions are (pragma '((protect-assign and (pragma '((protect-unassign. Backup your system before you put ***** near the fan :D

 

But I agree with you that precision will/might be lost, and I'd probably use suggestion like Hanhphuc's.

if you use 1.5708, the precision IS lost. If you use pi, even if at the screen it graphically truncate the value, it has full precision. (so always use pi!) :)

Command: !pi

3.14159

Command: (- 3.14159 pi)

-2.65359e-006

 

I found the logic bomb that allowed my routine to have cubes outside the original solid...

Below is the revised version of my routine. It creates 1568 cubes for any size sphere.

 

To answer your question in Point 4... yes I am octree-ing those cubes and NOT using them in the volume calculation. This is one area where I could gain some efficiency by only dividing the cube if the volume ratio is less that 0.7

 

I look forward to seeing how the runtimes compare with the different approaches to the same problem :-)

Hey Colin! It was fun, and i'm glad I helped you find the logic bomb. For the extra octodivide calculations you do (point 4) it is just list handling. Even if not optimal as is, this is not the most time consuming part.

 

For the runtimes, I added (setq ms (getvar 'millisecs)) after the volume selection and (princ (strcat "\n Voxels Created in "(vl-princ-to-string (- (getvar 'millisecs) ms))" ms")) before the final princ.

For a 6 radius sphere your routine took 85255 ms while mine took 13806 (6.17 times faster)

It is not quite an apple to apple comparison yet, because whenever a cube is totally inside I leave it as is, so I have 8 cubes with an edge of 3 units (worth 512 (8x8x8 )), and 72 of 1.5 (worth 576 (72 x 8)) along with 480 of 0.75 (512+576+480=1568). Im not sure if the bigger boxes have to be broken down, but foreseeing that they might is the reason I made the var masterlst. It contains the boxes MinP/MaxP in assoc sublists, the assoc being the generation of solid.

 

The assoc1 doesn't exist as the first 8 boxes were all partially outside. I always use cons (faster than append) so newer items (smaller cubes) are at the beginning

Command: (length (nth 0 masterlst)) returns 481 (the assoc (4) with 480 coord pairs)

Command: (length (nth 1 masterlst)) returns 73 (the assoc (3) with 72 coord pairs)

Command: (length (nth 2 masterlst)) returns 9 (the assoc (2) with 8 coord pairs)

Here's the content of assoc 2, so the 8 biggest cubes

(2 ((0.0 0.0 0.0) (3.0 3.0 3.0)) ((0.0 0.0 -3.0) (3.0 3.0 0.0)) (...+coord of the 6 other cubes bounding boxes...) )

 

If you need to have all cubes broken down to the size of the smallest, the advantage is that these coords can be parsed to the first part of the function octodivide (would have to be made as separate subfunctions) along with the setq masterlst part (same here) to create the bounding box coordinates to feed the solid creation part. The advantage is that by taking the difference between the assoc of the sublist (here it is assoc 2, so 2) and the (caar masterlst) which is the gen of the smallest cubes (4), you know how many times you have to map the coords in octodivide's first part. (You take these 8 coords pairs, feed em to octodivide, get 64 pairs that you feed again to get the final 512) As a result you skip the making of 3d solids of any intermediate steps. In this case (8>64>512)it represents 64 less solids to create. If that is the case some list would be needed to store the cubes enames/vlobj name to entdel them, and about 2/3 of the cubes would need to be created, which roughly means that the vl- version would still be about twice as fast as the command box version (instead of 6x+ faster). Heres the code's draft, I left plenty of comments to explain what I did. Like yours, no error trapping and vars arnt localized yet.

 

(progn 
(defun c:octovoxel (/ acadObj doc modelSpace lastent);minP maxP
 
 (defun DVmid ( a b )(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b))	;; Midpoint  -  Lee Mac Returns the midpoint of two points
 ;(setq VoxVol 0.)
 (setq targetratio 0.70)
 (setq acadObj (vlax-get-acad-object))
 (setq doc (vla-get-ActiveDocument acadObj))
 (setq modelSpace (vla-get-ModelSpace doc))
 (setq lastent (entlast)
voxsld		(car (entsel "\nSelect Solid to Voxelize: "))
voxsldobj	(vlax-ename->vla-object voxsld)
voxsldvol	(vla-get-volume voxsldobj)
 )
 (setq ms (getvar 'millisecs))
 (vla-GetBoundingBox voxsldobj 'MinP 'MaxP)
 (setq MinP (vlax-safearray->list MinP)
       MaxP (vlax-safearray->list MaxP)
       MidP (DVmid MinP MaxP)
       
       ; @Grrr!   Grrr!   Grrrr!  
       ;Here's an example of what we talked few days ago. I kept one "common" as comment to show you the "evolution"
       ;HalfLen (/ (max (- (car MaxP) (car MinP)) (- (cadr MaxP) (cadr MinP)) (- (caddr MaxP) (caddr MinP)) ) 2)
       Halflen (/ (apply 'max (mapcar '(lambda (x y) (- x y)) Maxp MinP))2)

       MaxP (mapcar '(lambda (x) (+ x HalfLen)) midp);make it a cube
       MinP (mapcar '(lambda (x) (- x HalfLen)) midp);make it a cube
       boxvol (apply '* (mapcar '(lambda (x y) (- x y)) Maxp MinP))
       Rndnumb 1
 )
 
 (createOctoBox MinP MaxP Rndnumb (setq boxvol (/ boxvol ))
 (while (or (null VoxVol) (< (/ VoxVol voxsldvol) targetratio))
        (setq Rndnumb (1+ Rndnumb))
        (setq boxvol (/ boxvol )
        (foreach pair (cdr (assoc (1- rndnumb) nxtlst))
          (createOctoBox (car pair) (cadr pair) Rndnumb boxvol)
        )
 )
 (princ (strcat "\n Voxels Created in "(vl-princ-to-string (- (getvar 'millisecs) ms))" ms"))
)
;(vla-CheckInterference (vlax-ename->vla-object (car (entsel)))(vlax-ename->vla-object (car (entsel))):vlax-true 'lala)
(defun createSolidIfInterfere (obj1 obj2 / tst)
 ;this func is TOTALLY USELESS. Just realized yesterday when I posted about the 4th arg, since if it interfere I always
 ;need to generate the interfering solid to calculate the % interference. (vla-CheckInterference obj1 obj2 :vlax-true 'lol) does the same
 ;Benchmark told me not to bother removing it even if it makes no sense. The result make no sense either. 
 ;Elapsed milliseconds / relative speed for 512 iteration(s):
 ;  (CREATESOLIDIFINTERFERE OBJ1 OBJ2)...........1124 / 1.05 <fastest>
 ;  (vla-CheckInterference OBJ1 OBJ2 :vl...).....1170 / 1.01
 ;  (vla-CheckInterference OBJ2 OBJ1 :vl...).....1185 / 1.00 <slowest>
 (vla-CheckInterference obj1 obj2 :vlax-false 'tst)
 (if (eq tst :vlax-true)
     (vla-CheckInterference obj1 obj2 :vlax-true :vlax-true)
     nil
 )
)

(defun createOctoBox (minp maxp rndnumb boxvol / );inspnts height points ) ; !minp (-10 -10 -10)  !maxp (10 10 10)
 ;I needed to be able to start from bounding box (only option?) but my needs are differents. I needed pline insertion points/elevation
 ;rather than MinP/MaxP for "box" command. To get the 8 regions req to subdivise a box in 8, you need 4 plines on the bottom
 ;(extruded half the heigth) and 4 at a height of the midpoint (extruded half the heigth as well). Same for the origins. 1/2 start from
 ;left and go to middle. Other half start on mid and go to right
 ;the coords of the bottom left corner of bottom regions are;(-10 -10 -10) (-10 0 -10) (0 -10 -10) (0 0 -10)
 ;the coords of the bottom left corner of top    regions are;(-10 -10  0 ) (-10 0  0 ) (0 -10  0 ) (0 0  0 )
 ;Cube's bounding box (-10-10-10) to (10 10 10), but the midP is (0 0 0)
 ;If you look carefully, you might notice that these are all of the coords possibile combinaison made from set A (MinP) and setb (midP)
 ;(a a a)(a a b)(a b a)(b a a)(b a b)(b b a) & (b b b). That is why I used MidP. That is the inspnts function purpose
 (setq inspnts ((lambda (woo / ret)
                  (foreach x (mapcar 'car woo)
                    (foreach y (mapcar 'cadr woo)
                      (foreach z (mapcar 'caddr woo)
                        (setq ret (cons (list x y z) ret))
                      )
                    )
                  )
                )
                (list minP (DVmid minP maxp))
               )
       height (distance (car inspnts)(cadr inspnts)) ; I will need that for the height of the solids, 
  )
  (foreach x inspnts
    (setq elev (caddr x))
    ;(setq p1 (reverse (cdr(reverse coord))))
    ;(setq p2 (mapcar '+ p1 (list 0 height)))
    ;(setq p3 (mapcar '+ p1 (list height height)))
    ;(setq p4 (mapcar '+ p1 (list height 0)))
    ;to create pline in vl you need an array with (x y z) coords. Fun part is that the Z coord is both required and ignored. Go figure.
    ;Since Z coords are ignored I just added 0 instead of uselessly evaluating (caddr x) 1568 times.
    ;I originally created p1@p4 separatly but combined them afterward directly in ptlst
    ;Here I calculate the Plines 4 coords using 1 ins point and the heigth (dist between 2 points too)
    (setq ptlst (list (car x)(cadr x)0 (car x)(+ height (cadr x))0 (+ height (car x))(+ height (cadr x))0 (+ height (car x))(cadr x)0 ))
 
    (setq points (vlax-make-safearray vlax-vbDouble '(0 . 11)));creating the safearray
    (vlax-safearray-fill points ptlst);filling it with the point list
    (setq plineObj (vla-AddPolyline modelSpace points));now use the safearray to create the pline
    (vla-put-Closed plineObj :vlax-true);need to close it (needed to make a region)
    (vla-put-Elevation PLINEOBJ elev);now you need to put the ignored z elevation
    (setq curves (vlax-make-safearray vlax-vbObject '(0 . 0)))
    (vlax-safearray-put-element curves 0 plineObj)
    (setq regionObj (vla-AddRegion modelSpace curves))
    ;(vla-AddRegion modelSpace (vlax-safearray-put-element (vlax-make-safearray vlax-vbObject '(0 . 0)) 0  plineObj))
    (setq solidObj (vla-AddExtrudedSolid modelSpace (vlax-safearray-get-element (vlax-variant-value regionObj) 0) height 0))
    (vla-delete plineObj);delete plines and regions on the fly
    (vla-delete (car (safearray-value(variant-value regionObj))))
    (if (null (setq tmpobj (createSolidIfInterfere SolidObj voxsldobj)))
        (vla-delete solidObj);no overlap
        (progn ;interference exists
          (if (= boxvol (setq tmpVol (vlax-get-property tmpobj 'volume)));all inside?
              (progn ; all inside
                (if (assoc rndnumb masterlst)
                    (setq masterlst (subst (cons rndnumb (cons (list x (mapcar '(lambda (y) (+ y height)) x))(cdr(assoc rndnumb masterlst)))) (assoc rndnumb masterlst)masterlst))
                    (setq masterlst (cons (cons rndnumb (cons (list x (mapcar '(lambda (y) (+ y height)) x))(assoc rndnumb masterlst))) masterlst))
                )
                (if VoxVol (setq VoxVol (+ VoxVol tmpVol)) (setq VoxVol tmpVol))
              )
              (progn ; partially inside
                (vla-delete solidObj)
                (if (assoc rndnumb NxtLst)
                    (setq NxtLst (subst (cons rndnumb (cons (list x (mapcar '(lambda (y) (+ y height)) x))(cdr(assoc rndnumb NxtLst)))) (assoc rndnumb NxtLst)NxtLst))
                    (setq NxtLst (cons (cons rndnumb (cons (list x (mapcar '(lambda (y) (+ y height)) x))(assoc rndnumb NxtLst))) NxtLst))
                )
              )
          )
          (vla-delete tmpobj)
        )
    )
 )
)
    
)

Link to comment
Share on other sites
ColinHolloway Contributor

ColinHolloway

Posted
  • Author
Posted (edited)

Hi Jef!

 

My application for voxelizing a solid is a precursor for doing A-Star (or similar) path-finding through the solid (which represents the negative space in a region), so I need to break all cubes down to their smallest level.

 

In the persuit of efficiency, I have swapped all the commands with vla methods and this seems to have made a conciderable difference. I can now process the 6 radius sphere into 1568 Voxels Created in 9859 ms.

 

I'm looking forward to learning more and pushing this routine as far as possible! :-)

 

Here is my revised code:

 

(defun c:voxelize ()
   (setq acadObj (vlax-get-acad-object) )
   (vla-StartUndoMark (vla-get-activedocument acadObj))
   (setq
acadObj		(vlax-get-acad-object)
doc		(vla-get-ActiveDocument acadObj)
modelSpace	(vla-get-ModelSpace doc)
oosmode		(getvar "osmode")
o3Dosmode	(getvar "3Dosmode")
clayer		(getvar "clayer")
90deg		(* 0.5 pi)
voxsld		nil
   )
   
   (setvar "osmode" 0)
   (setvar "3Dosmode" 0)
   (while (not voxsld)
(setq voxsld (car (entsel "\nSelect Solid to Voxelize: ")) )
(if voxsld
    (setq seltype (cdr (assoc 0 (entget voxsld))) )
)
   )
   (setq
voxsldobj	(vlax-ename->vla-object voxsld)
voxsldvol	(vla-get-volume voxsldobj)
   )
   (setq ms (getvar 'millisecs))
   (vla-GetBoundingBox voxsldobj 'MinP 'MaxP)
   (setq
minsld		(vlax-safearray->list MinP)
maxsld		(vlax-safearray->list MaxP)
midsld		(dvmid minsld maxsld)
volratio	0.
halfoctside	(/ (apply 'max (mapcar '(lambda (x y) (- x y)) maxsld minsld)) 2)
minoct		(mapcar '(lambda (x) (- x halfoctside)) midsld)
maxoct		(mapcar '(lambda (x) (+ x halfoctside)) midsld)
octcnt		0
   )
 
   (setq layerObj (vla-Add (vla-get-Layers doc) "Cons"))
   (vla-put-activeLayer doc layerObj)

   (setq voxlst (list (cons 0 (list minoct maxoct))) )

   (while (< volratio 0.7)
(setq octcnt (1+ octcnt))
(foreach vox voxlst
    (if (= (car vox) 0)
	(progn
	    (setq
		voxpnt1		(cadr vox)
		voxpnt2		(caddr vox)
		voxmid		(vlax-3d-point (dvmid voxpnt1 voxpnt2))
		voxside		(abs (- (car voxpnt2) (car voxpnt1)))
		curvox		(vla-AddBox modelSpace voxmid voxside voxside voxside)
		checkval	(checkinterfere curvox voxsld)
	    )
	    (vla-Delete 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)
		voxmid	(vlax-3d-point (dvmid voxpnt1 voxpnt2))
		voxside	(abs (- (car voxpnt2) (car voxpnt1)))
	    )
	    (setq
		curvox		(vla-AddBox modelSpace voxmid voxside voxside voxside)
		curvoxvol	(vla-get-volume curvox)
		totalvoxvol	(+ totalvoxvol curvoxvol)
	    )
	    (vla-Delete curvox)
	)
    )
)
(setq volratio (/ totalvoxvol voxsldvol) )
   )

;;;    Remove un-used voxels
   (setq voxlst (vl-remove-if (function (lambda (x) (= (car x) 0))) 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) )
   )

;;;	Sort Voxel List by Z value
   (setq voxlst (vl-sort voxlst (function (lambda (x y) (< (caddr (cadr x)) (caddr (cadr y)))))) )

;;;    Draw Final Sorted Voxels
   (foreach vox voxlst
(if (> (car vox) 0)
    (progn
	(setq
	    voxpnt1	(cadr vox)
	    voxpnt2	(caddr vox)
	    voxmid	(vlax-3d-point (dvmid voxpnt1 voxpnt2))
	    voxside	(abs (- (car voxpnt2) (car voxpnt1)))
	    curvox	(vla-AddBox modelSpace voxmid voxside voxside voxside)
	)
    )
)
   )

   (setq voxcnt (length voxlst))
   (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"))
   (princ (strcat "\n Final Voxel to Volume Ratio: " (rtos volratio 2 3)))
   (princ (strcat "\n Voxels Created in "(vl-princ-to-string (- (getvar 'millisecs) ms))" ms"))
   (vla-EndUndoMark (vla-get-activedocument acadObj))
   (princ)
)




;;;	Helper Sub-Routines
(defun DVmid ( a b )(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b))		;; Midpoint  -  Lee Mac Returns the midpoint of two points

(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) 0. (/ cellabsx 2)) (polar (cadr newcell1) 0. (/ cellabsx 2)))
newcell3	(list (polar (car newcell1) 90deg (/ cellabsy 2)) (polar (cadr newcell1) 90deg (/ cellabsy 2)))
newcell4	(list (polar (car newcell2) 90deg (/ cellabsy 2)) (polar (cadr newcell2) 90deg (/ cellabsy 2)))
newcell5	(list (list (caar newcell1) (cadr (car newcell1)) (caddr (cadr newcell1))) (list (car (cadr newcell1)) (cadr (cadr newcell1)) (caddr cellmax)))
newcell6	(list (polar (car newcell5) 0. (/ cellabsx 2)) (polar (cadr newcell5) 0. (/ cellabsx 2)))
newcell7	(list (polar (car newcell5) 90deg (/ cellabsy 2)) (polar (cadr newcell5) 90deg (/ 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))
newcellabsx	(/ cellabsx 2)
newcellabsy	(/ cellabsy 2)
newcellabsz	(/ cellabsy 2)
   )
   newcellscnrs
)

(defun checkinterfere (vox sld)
   (setq
return		0
voxobj		vox ;(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 0.0) ; tolerance changed to 0.0 to ensure 100% overlap
	(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
)

Edited by ColinHolloway
Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted
You got some things right, and some wrong. Pi IS a symbol. PI is also a protected symbol. A symbol could be bound to many things, a string, a real, an integer or a function. Everything you set is a symbol. Setq is a symbol-handling function. Its function is to "Set the value of a symbol or symbols to associated expressions".

Even you could be a symbol as long as you Setq yourself!

 

Re-tracing what I wrote and your comment here - looks I got messed up a little.

 

 

As for your which should be/not be faster you are not quite right either.

1rst try:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(/ MYPI 2).......1467 / 1.02 <fastest>
(/ PI 2).........1497 / 1.00
(/ 3.1416 2).....1498 / 1.00 <slowest>
2nd try: 
Elapsed milliseconds / relative speed for 16384 iteration(s):
(/ PI 2).........1170 / 1.03 <fastest>
(/ MYPI 2).......1201 / 1.00
(/ 3.1416 2).....1201 / 1.00 <slowest>

They are all exactly the same as they all do the same, which is divide a real by 2. (benchmarking is not an exact science, and vary slightly depending on what the cpu is doing at the same time. Each expression can vary by few%, thus changing the order if the difference is not significant. look at the 1467@1498 ms for 16384 iterations on the 1rst try compared to the 1170@1201 ms for the same amount of iterations of the 2nd. Obviously my cpu was doing something in the background the 1rst time)

 

This brought more confusion! So this benchmark shows that is faster to access the symbol's value, by providing the symbol itself rather than providing just the actual value.

Guess my thoughts != facts. :ouch:

 

 

On the subject of protected/non protected symbols, you can change any symbol to a protected one and vice versa. Protected symbols appear blue in the vlide but the potential of breaking things up is very present, a little bit like playing with the qaflags var. Probably for that reason there is no official literature on the function needed to do that, but you still can find old unofficial stuff about it if you dig deep. the functions are (pragma '((protect-assign and (pragma '((protect-unassign. Backup your system before you put ***** near the fan :D

 

I'm aware about pragma, but still one may be interested about it in our short talky-talk.

 

 

Again, thanks for clearing things up, Jef! :beer:

Conclusion for today: (/= thoughts facts).

Link to comment
Share on other sites
hanhphuc Mentor

hanhphuc

Posted
Posted

I'm looking forward to learning more and pushing this routine as far as possible! :-)

 

@Colin tho I haven't test yet it looks promising you had implemented ideas by jef & grrr as well, by participating in this forum i'm benefitted too.

@Jef! & @grrr like your both discussions. jef! as always explanation clear & informative just like LM :thumbsup:

 

p/s: Just noticed the bulletin board - Happy Birthday Lee Mac :beer:

Link to comment
Share on other sites
Jef! Rising Star

Jef!

Posted
Posted
@Jef! & @grrr like your both discussions. jef! as always explanation clear & informative just like LM

I'm glad you appreciate Hanhphuc, that comment just made my day :)

 

...and Happy Birthday Lee Mac from here too!

 

This brought more confusion! So this benchmark shows that is faster to access the symbol's value, by providing the symbol itself rather than providing just the actual value.

Not faster, probably just around the same imo. like I said "benchmarking is not an exact science, and vary slightly depending on what the cpu is doing at the same time. Each expression can vary by few%, thus changing the order if the difference is not significant"

Heres a demo of the same benchmark running 4 times in a row

Elapsed milliseconds / relative speed for 32768 iteration(s):
   PI..........1419 / 1.04 <fastest>
   3.14159.....1482 / 1.00 <slowest>
------------------------------------
Elapsed milliseconds / relative speed for 32768 iteration(s):

   3.14159.....1404 / 1.00 <fastest>
   PI..........1404 / 1.00 <slowest>
------------------------------------
Elapsed milliseconds / relative speed for 32768 iteration(s):

   3.14159.....1294 / 1.07 <fastest>
   PI..........1389 / 1.00 <slowest>

and 1 out of the blue showing an obviously busy elsewhere cpu, reason why it is
better to always benchmark on a new cad session, with minimal things running in
background and run it few times to get more of a real idea.
   3.14159.....1030 / 5.32 <fastest>
   PI..........5475 / 1.00 <slowest>

 

Grrr style conclusion:
(if (repeat alot benchmarks)
   (shows tendency)
   (null reliability)
)

...and it goes without saying you cannot compare benchmark results for different routines unless they are made on the same computer.

 

@colin

Already faster than mine. Vla-add-box. SMH! I knew there was a vla-addcylinder function, I should have known to look for "vla-addbox" and test its speed, I would have saved some time. Good Job. I knew the constant manipulation (lists>arrays>lwplines>regions>solids) in mine took some time even if much faster than command calls, but running some tests vla-addbox just blew my mind speedwise. Here are the time for 1000x...

vla-addbox (which place it at the correct position): 280ms

vla-copy then vla-move of the first box made: 983ms

just vla-copy of a single box: 783ms.

entgeting the first box and just entmakex-ing them: 1825ms

 

I would have bet creating a solid to be more time consuming then copying one, but with to my surprise vla-addbox is faster than vla-copy by a huge margin. Cannot see any other approach right now. You definitely picked the winning horse on that one.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...