需要体素3D实体

Jef! · 发表于 2022-7-5 15:58:49

嗯，这是一个有趣的事实：
我认为PI将被解释为一个受保护的符号，它将保持值3.1416。。。因此，符号值访问可能会减慢速度。
但这个基准意味着PI不是一个符号，而是一个实数。

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

因此：

根据上面的结论，实际上比较了“/”函数和“angtof”，所以是的，它更快。

你们大多数人可能都知道这一点：
访问符号的值总是比计算函数更快（无论计算多么简单）。
你的基准是我意思的完美例子。

我最初的想法是，如果PI是一个受保护的符号-定义如下：

copy


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

然后，访问其值的速度应该减慢，而不是提供实际的val：

copy

_$ (type PI) >> REAL

然后：

copy

(setq MyPI PI)

但我同意你们的观点，精度可能会降低，我可能会使用Hanhphuc的建议。

ColinHolloway · 发表于 2022-7-5 16:03:59

你有些事是对的，有些事是错的。圆周率是一个符号。PI也是一个受保护的符号。一个符号可以绑定到许多东西，一个字符串、一个实数、一个整数或一个函数。你设定的一切都是一个符号。Setq是一种符号处理函数。其功能是“将一个或多个符号的值设置为相关表达式”。
即使你可以成为一个符号，只要你自己设定！

至于你的哪个应该/不应该更快，你也不太对。

copy


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

它们都是完全一样的，也就是把实数除以2。（基准测试并不是一门精确的科学，根据cpu在同一时间所做的事情而略有不同。每个表达式可以相差几%，因此如果差异不显著，则会改变顺序。请查看1467@1498第一次尝试上16384次迭代的ms与1170@1201ms，用于第二次迭代的相同数量。显然，我的cpu第一次在后台做了一些事情）

关于受保护/不受保护的符号，您可以将任何符号更改为受保护的符号，反之亦然。受保护的符号在vlide中显示为蓝色，但分解的可能性非常大，有点像玩qaflags变量。可能是因为这个原因，没有关于实现该功能所需的官方文献，但如果深入挖掘，你仍然可以找到关于它的旧的非官方内容。函数为（pragma’（（protect assign）和（pragma’（（protect unassign）。在将******放在风扇附近之前，请备份您的系统

如果使用1.5708，则精度将丢失。如果使用pi，即使在屏幕上它以图形方式截断值，也具有完全精度。（所以始终使用pi！）

嘿，科林！这很有趣，我很高兴我帮你找到了逻辑炸弹。对于额外的八进制除法计算（第4点），它只是列表处理。即使不是最优的，这也不是最耗时的部分。

对于运行时，我在卷选择之后添加了（setq ms（getvar'毫秒）），并在最终的princ之前添加了（princ（strcat“\n在“（vl princ to string（-getvar'毫秒））ms”中创建的体素）。
对于一个6半径的球体，你的例程需要85255毫秒，而我的例程需要13806毫秒（快6.17倍）
这还不完全是一个苹果对苹果的比较，因为每当一个立方体完全在里面时，我都保持原样，所以我有8个立方体，边缘为3个单位（值512（8x8x8）），72个为1.5（值576（72 x），480个为0.75（512+576+480=1568）。我不确定是否需要分解更大的盒子，但预见到它们可能是我制作var masterlst的原因。它包含assoc子列表中的MinP/MaxP框，assoc是实体的生成。

assoc1不存在，因为前8个盒子都部分在外面。我总是使用cons（比append快），所以新的项目（较小的立方体）在开始时就出现了
命令：（length（nth 0 masterlst））返回481（具有480个坐标对的assoc（4））
命令：（length（nth 1 masterlst））返回73（具有72个坐标对的assoc（3））
命令：（length（nth 2 masterlst））返回9（具有8个坐标对的assoc（2））
这是assoc 2的内容，所以8个最大的立方体
（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.0））（…+其他6个立方体b的坐标

Grrr · 发表于 2022-7-5 16:05:19

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.

copy

_$ (type PI) >> REAL

So:

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

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.

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

copy

(setq MyPI PI)

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

copy

(/ MyPI 2) ;  1.5708

Then:

copy

(+ 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.

Jef! · 发表于 2022-7-5 16:08:33

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!

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

copy

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

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

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

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

copy

(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  ;  (vla-CheckInterference OBJ1 OBJ2 :vl...).....1170 / 1.01 ;  (vla-CheckInterference OBJ2 OBJ1 :vl...).....1185 / 1.00  (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)        )    ) ))    )

ColinHolloway · 发表于 2022-7-5 16:13:15

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:

copy

(defun c:voxelize ()   (setq acadObj (vlax-get-acad-object) )   (vla-StartUndoMark (vla-get-activedocument acadObj))   (setqacadObj                (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))) ))   )   (setqvoxsldobj        (vlax-ename->vla-object voxsld)voxsldvol        (vla-get-volume voxsldobj)   )   (setq ms (getvar 'millisecs))   (vla-GetBoundingBox voxsldobj 'MinP 'MaxP)   (setqminsld                (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)     (setqcellmin                (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)   (setqreturn                0voxobj                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)

Grrr · 发表于 2022-7-5 16:16:15

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

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.

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!
Conclusion for today: (/= thoughts facts).

hanhphuc · 发表于 2022-7-5 16:19:51

@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

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

Jef! · 发表于 2022-7-5 16:22:29

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

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

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

copy

Elapsed milliseconds / relative speed for 32768 iteration(s):   PI..........1419 / 1.04    3.14159.....1482 / 1.00 ------------------------------------Elapsed milliseconds / relative speed for 32768 iteration(s):   3.14159.....1404 / 1.00    PI..........1404 / 1.00 ------------------------------------Elapsed milliseconds / relative speed for 32768 iteration(s):   3.14159.....1294 / 1.07    PI..........1389 / 1.00 and 1 out of the blue showing an obviously busy elsewhere cpu, reason why it isbetter to always benchmark on a new cad session, with minimal things running inbackground and run it few times to get more of a real idea.   3.14159.....1030 / 5.32    PI..........5475 / 1.00

copy

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.

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

发表回复

精选推荐