非递归模式获取块中深度嵌套的图元

dcl1214

块中块深度嵌套的时候，要想获取块中所有图元，很多同仁一开始就想到递归，其实我是比较抵触递归的，所以，随手写了一个非递归模式获取块中块图元的代码，哪位还有速度更快的（块中块深度嵌套很多），可以一起切磋一下
请下载vlx测试，速度极快

1. (defun $kuai-nei-tu-yuan$ (ENT-B lst / $kn-objs$ a blks e ents-all obj)
   
2.           ;非递归模式获取块内图元
   
3.   (defun $kn-objs$ (ENT-B / a blk ents km obj)
   
4.     (if
   
5.       (= (TYPE ENT-B) 'ENAME)
   
6.        (SETQ OBJ (vlax-ename->vla-object ENT-B))
   
7.     )
   
8.     (IF  (and OBJ (= (type obj) 'VLA-object))
   
9.       (if (vlax-property-available-p obj 'effectivename)
   
10.   (setq km (vla-get-effectivename obj))
    
11.   (if (vlax-property-available-p obj 'name)
    
12.     (setq km (vla-get-name obj))
    
13.   )
    
14.       )
    
15.     )
    
16.     (setq blk (vl-catch-all-apply
    
17.     'vla-item
    
18.     (list (vla-get-blocks
    
19.       (vla-get-activedocument
    
20.         (vlax-get-acad-object)
    
21.       )
    
22.           )
    
23.           km
    
24.     )
    
25.         )
    
26.     )
    
27.     (if  blk
    
28.       (vlax-for  a blk
    
29.   (setq ents (cons a ents))
    
30.       );遍历blk对象
    
31.     )
    
32.     ents
    
33.   )
    
34.   (setq ents-all nil)
    
35.   (setq obj nil)
    
36.   (setq blks ($kn-objs$ ENT-B));块中obj对象
    
37.   (while (setq obj (car blks));循环第一个obj
    
38.     (setq e nil)
    
39.     (setq e (vlax-vla-object->ename obj));转换为图元
    
40.     (if  (= (vla-get-objectname obj) "AcDbBlockReference");如果是块对象
    
41.       (setq blks (append blks ($kn-objs$ e)));获取块中obj对象，拼接到blks尾巴上
    
42.       (setq ents-all (cons e ents-all));如果不是块对象就收集到ents-all里面，下面要返回给上一级
    
43.     )
    
44.     (setq blks (cdr blks));下一个obj对象
    
45.   )
    
46.   (setq ents-all (reverse ents-all));倒置
    
47.   ents-all
    
48. )
    

(defun $kuai-nei-tu-yuan$ (ENT-B lst / $kn-objs$ a blks e ents-all obj)<br />           ;非递归模式获取块内图元<br />   (defun $kn-objs$ (ENT-B / a blk ents km obj)<br />     (if<br />       (= (TYPE ENT-B) 'ENAME)<br />        (SETQ OBJ (vlax-ename->vla-object ENT-B))<br />     )<br />     (IF  (and OBJ (= (type obj) 'VLA-object))<br />       (if (vlax-property-available-p obj 'effectivename)<br />   (setq km (vla-get-effectivename obj))<br />   (if (vlax-property-available-p obj 'name)<br />     (setq km (vla-get-name obj))<br />   )<br />       )<br />     )<br />     (setq blk (vl-catch-all-apply<br />     'vla-item<br />     (list (vla-get-blocks<br />       (vla-get-activedocument<br />         (vlax-get-acad-object)<br />       )<br />           )<br />           km<br />     )<br />         )<br />     )<br />     (if  blk<br />       (vlax-for  a blk<br />   (setq ents (cons a ents))<br />       );遍历blk对象<br />     )<br />     ents<br />   )<br />   (setq ents-all nil)<br />   (setq obj nil)<br />   (setq blks ($kn-objs$ ENT-B));块中obj对象<br />   (while (setq obj (car blks));循环第一个obj<br />     (setq e nil)<br />     (setq e (vlax-vla-object->ename obj));转换为图元<br />     (if  (= (vla-get-objectname obj) "AcDbBlockReference");如果是块对象<br />       (setq blks (append blks ($kn-objs$ e)));获取块中obj对象，拼接到blks尾巴上<br />       (setq ents-all (cons e ents-all));如果不是块对象就收集到ents-all里面，下面要返回给上一级<br />     )<br />     (setq blks (cdr blks));下一个obj对象<br />   )<br />   (setq ents-all (reverse ents-all));倒置<br />   ents-all<br /> )<br />

2. ;;; 示例
   
3. (setq ent-b (car (entsel)))
   
4. (setq ents ($kuai-nei-tu-yuan$ ent-b nil))
   
5. (mapcar  (function
   
6.     (lambda (a)
   
7.       (vl-catch-all-apply
   
8.         'vla-put-color
   
9.         (list
   
10.     (vl-catch-all-apply 'vlax-ename->vla-object (list a))
    
11.     1
    
12.         )
    
13.       )
    
14.     )
    
15.   )
    
16.   ents
    
17. )

;;; 示例<br /> (setq ent-b (car (entsel)))<br /> (setq ents ($kuai-nei-tu-yuan$ ent-b nil))<br /> (mapcar  (function<br />     (lambda (a)<br />       (vl-catch-all-apply<br />         'vla-put-color<br />         (list<br />     (vl-catch-all-apply 'vlax-ename->vla-object (list a))<br />     1<br />         )<br />       )<br />     )<br />   )<br />   ents<br /> )

你有种再说一遍

我也有一段时间跟你一样觉得,
既然递归会爆栈,那么全改循环不就好了,后来发现其实不然.
如果不喜欢递归,这通常对于编译器的信心不足引起的,
因为尾递归优化是可以消除新栈帧的,
而且存入堆容器再拿出来,比起开辟栈帧再拿出来效率更低,
所以其实建议是多写递归,尤其是尾递归,
毕竟有成千上万的人来实现编译器优化,就连Lisp内部也会做的.

kozmosovia

这样获取出来的图元列表没有任何用途，块内定义的图形，其parent都是各自上层块定义，一堆父亲不一样的图元弄到一个列表里，你咋做下一步处理？有啥实际需求要做这种处理？同时，同名的图块如果嵌套在不同的层次，或者同一个层级有若干同名图块，会返回一堆图形重复，都混合在一个表里，这种垃圾数据表有存在的意义吗？

wudechao

有bug.但是速度很快，我用在关闭图块所有图层（建筑提资的图，很多块中块，比如想关闭某些块，这些块是块中块），先获取图块所有图元，取块中每个图元的图层，消重复图层，最后逐个关闭图层，速度非常快，比我原来用递归快一倍。反复执行这个函数，就出现错误，不知道是什么原因。

ssyfeng

你有种再说一遍 发表于 2024-12-21 23:05
我也有一段时间跟你一样觉得,
然后递归会爆栈,那么全改循环不就好了,
后来发现其实不然.

确实尾递归比其它递归要快一倍，比楼主的也稍微快一点

kozmosovia

wudechao 发表于 2024-12-22 12:16
有bug.但是速度很快，我用在关闭图块所有图层（建筑提资的图，很多块中块，比如想关闭某些块，这些块是块中 ...

这种需求，直接用DBX比这种递归快n倍，尤其是大图。

dcl1214

kozmosovia 发表于 2024-12-22 11:30
这样获取出来的图元列表没有任何用途，块内定义的图形，其parent都是各自上层块定义，一堆父亲不一样的图元 ...

我编译成【独立空间】了，提速9000倍

dcl1214

ssyfeng 发表于 2024-12-22 13:31
确实尾递归比其它递归要快一倍，比楼主的也稍微快一点

下载我的vlx试试，我编译成【独立空间】了，提速9000倍

wuyunpeng888

同一个图元重复处理无数次，有什么意义？

wuyunpeng888

根本不存在快不快的概念，同一图元重复处理无数次，本身就是慢的方案，CAD数据库块里只有参照，不存在多层的概念，块参照就是一个图元，n个参照的图元数量就只有块内图元数量+n,而并不是块内图元数量*n