求大神帮我修改下lisp代码，chatgpt写的在cad报错.

轻尘

脚本需求：作为专业间提资，需要多重分解在0-GPS图层上的块，然后保留含有*vp*关键字图层上的图元并删除其余图元。chatgpt最终代码如下：

2. (defun unlock-all-layers() ;定义一个函数，解锁所有图层
   
3. (setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层
   
4. (vla-foreach layer layers ;遍历所有图层
   
5. (vla-put-locked layer :vlax-false) ;将图层锁定状态改为false
   
6. )
   
7. )
   
8. 
   
9. (defun explode-gps-blocks() ;定义一个函数，多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块
   
10. (setq blkref (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) ;获取当前文档中所有块参照
    
11. (setq blkrefcount (vla-get-count blkref)) ;获取块参照数量
    
12. (setq gpslayer (vl-catch-all-apply 'vla-getlayer (list "0-GPS"))) ;获取名为"0-GPS"的图层
    
13. (setq i 0) ;初始化计数器i
    
14. (while (< i blkrefcount) ;循环遍历所有块参照
    
15. (setq curblkref (vla-item blkref i)) ;获取当前块参照
    
16. (if (eq (vla-get-layer curblkref) gpslayer) ;判断当前块参照是否在"0-GPS"图层上
    
17. (progn ;如果在"0-GPS"图层上
    
18. (vl-catch-all-apply 'vla-explode (list curblkref)) ;执行块参照分解操作
    
19. (setq i -1) ;将计数器i设为-1，下一轮循环重新开始
    
20. )
    
21. )
    
22. (setq i (+ i 1)) ;计数器i加1
    
23. )
    
24. )
    
25. 
    
26. (defun delete-objects-without-vp() ;定义一个函数，删除不含有vp关键字的图层上的图元对象
    
27. (setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层
    
28. (vla-foreach layer layers ;遍历所有图层
    
29. (setq layername (vla-get-name layer)) ;获取图层名
    
30. (if (not (vl-string-search "vp" layername)) ;判断图层名中是否含有"vp"关键字
    
31. (progn ;如果不含有"vp"关键字
    
32. (setq objects (vla-get-objects layer)) ;获取当前图层上的所有图元对象
    
33. (vla-foreach obj objects ;遍历所有图元对象
    
34. (vla-delete obj)) ;删除当前图元对象
    
35. )
    
36. )
    
37. )
    
38. )
    
39. 
    
40. (unlock-all-layers) ;解锁所有图层
    
41. (repeat 100 ;执行100次以下操作
    
42. (explode-gps-blocks) ;多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块
    
43. )
    
44. (delete-objects-without-vp) ;删除不含有vp关键字的图层上的图元对象

(defun unlock-all-layers() ;定义一个函数，解锁所有图层<br /> (setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层<br /> (vla-foreach layer layers ;遍历所有图层<br /> (vla-put-locked layer :vlax-false) ;将图层锁定状态改为false<br /> )<br /> )<br /> <br /> (defun explode-gps-blocks() ;定义一个函数，多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块<br /> (setq blkref (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) ;获取当前文档中所有块参照<br /> (setq blkrefcount (vla-get-count blkref)) ;获取块参照数量<br /> (setq gpslayer (vl-catch-all-apply 'vla-getlayer (list "0-GPS"))) ;获取名为"0-GPS"的图层<br /> (setq i 0) ;初始化计数器i<br /> (while (< i blkrefcount) ;循环遍历所有块参照<br /> (setq curblkref (vla-item blkref i)) ;获取当前块参照<br /> (if (eq (vla-get-layer curblkref) gpslayer) ;判断当前块参照是否在"0-GPS"图层上<br /> (progn ;如果在"0-GPS"图层上<br /> (vl-catch-all-apply 'vla-explode (list curblkref)) ;执行块参照分解操作<br /> (setq i -1) ;将计数器i设为-1，下一轮循环重新开始<br /> )<br /> )<br /> (setq i (+ i 1)) ;计数器i加1<br /> )<br /> )<br /> <br /> (defun delete-objects-without-vp() ;定义一个函数，删除不含有vp关键字的图层上的图元对象<br /> (setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层<br /> (vla-foreach layer layers ;遍历所有图层<br /> (setq layername (vla-get-name layer)) ;获取图层名<br /> (if (not (vl-string-search "vp" layername)) ;判断图层名中是否含有"vp"关键字<br /> (progn ;如果不含有"vp"关键字<br /> (setq objects (vla-get-objects layer)) ;获取当前图层上的所有图元对象<br /> (vla-foreach obj objects ;遍历所有图元对象<br /> (vla-delete obj)) ;删除当前图元对象<br /> )<br /> )<br /> )<br /> )<br /> <br /> (unlock-all-layers) ;解锁所有图层<br /> (repeat 100 ;执行100次以下操作<br /> (explode-gps-blocks) ;多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块<br /> )<br /> (delete-objects-without-vp) ;删除不含有vp关键字的图层上的图元对象

x_s_s_1

试试，先保存图哈，不保证不崩溃

1. (defun c:tt (/ allx ss n)
   
2.   (defun allx (blkobj / lst lst1)
   
3.     (setq lst (vlax-safearray->list
   
4.     (vlax-variant-value (vla-explode blkobj))
   
5.     )
   
6.     )
   
7.     (vla-delete blkobj)
   
8.     (foreach n lst
   
9.       (if (equal (vla-get-ObjectName n) "AcDbBlockReference")
   
10.   (allx n)
    
11.   (if (null (vl-string-search "vp" (vla-get-layer n)))
    
12.     (vla-delete n)
    
13.     )
    
14.   )
    
15.       )
    
16.     )
    
17.   (setq ss (ssget "x" '((0 . "INSERT") (8 . "0-GPS"))))
    
18.   (repeat (setq n (sslength ss))
    
19.     (setq blkobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    
20.     (allx blkobj)
    
21.     )
    
22.   )

(defun c:tt (/ allx ss n)<br />   (defun allx (blkobj / lst lst1)<br />     (setq lst (vlax-safearray->list<br />     (vlax-variant-value (vla-explode blkobj))<br />     )<br />     )<br />     (vla-delete blkobj)<br />     (foreach n lst<br />       (if (equal (vla-get-ObjectName n) "AcDbBlockReference")<br />   (allx n)<br />   (if (null (vl-string-search "vp" (vla-get-layer n)))<br />     (vla-delete n)<br />     )<br />   )<br />       )<br />     )<br />   (setq ss (ssget "x" '((0 . "INSERT") (8 . "0-GPS"))))<br />   (repeat (setq n (sslength ss))<br />     (setq blkobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))<br />     (allx blkobj)<br />     )<br />   )

wzg356

牛逼，我们落伍了

wzg356

告诉它运行错误，修改看看

轻尘

wzg356 发表于 2023-3-8 17:23
告诉它运行错误，修改看看

试了还是不行，我百度应该是括号的问题。

liuhe

什么叫不删除关键字vp得图元

muwind

第一个defun确实少了个括号 ，内容没有测试

轻尘

liuhe 发表于 2023-3-8 21:25
什么叫不删除关键字vp得图元

就是图层名中包含vp的图元例如P-VPIPE-W

liuhe

轻尘 发表于 2023-3-9 10:16
就是图层名中包含vp的图元例如P-VPIPE-W

图元名是自动生成的编码。你怎么标记的？你说的是块名？扩展数据？上个图纸看看呗

wzg356

liuhe 发表于 2023-3-9 19:57
图元名是自动生成的编码。你怎么标记的？你说的是块名？扩展数据？上个图纸看看呗

那句话，就一闪而过的纳闷