轻尘 发表于 2023-3-8 15:06:53

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

本帖最后由 轻尘 于 2023-3-9 12:54 编辑

脚本需求：作为专业间提资，需要多重分解在0-GPS图层上的块，然后保留含有*vp*关键字图层上的图元并删除其余图元。chatgpt最终代码如下：
(defun unlock-all-layers() ;定义一个函数，解锁所有图层
(setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层
(vla-foreach layer layers ;遍历所有图层
(vla-put-locked layer :vlax-false) ;将图层锁定状态改为false
)
)

(defun explode-gps-blocks() ;定义一个函数，多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块
(setq blkref (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) ;获取当前文档中所有块参照
(setq blkrefcount (vla-get-count blkref)) ;获取块参照数量
(setq gpslayer (vl-catch-all-apply 'vla-getlayer (list "0-GPS"))) ;获取名为"0-GPS"的图层
(setq i 0) ;初始化计数器i
(while (< i blkrefcount) ;循环遍历所有块参照
(setq curblkref (vla-item blkref i)) ;获取当前块参照
(if (eq (vla-get-layer curblkref) gpslayer) ;判断当前块参照是否在"0-GPS"图层上
(progn ;如果在"0-GPS"图层上
(vl-catch-all-apply 'vla-explode (list curblkref)) ;执行块参照分解操作
(setq i -1) ;将计数器i设为-1，下一轮循环重新开始
)
)
(setq i (+ i 1)) ;计数器i加1
)
)

(defun delete-objects-without-vp() ;定义一个函数，删除不含有vp关键字的图层上的图元对象
(setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;获取所有图层
(vla-foreach layer layers ;遍历所有图层
(setq layername (vla-get-name layer)) ;获取图层名
(if (not (vl-string-search "vp" layername)) ;判断图层名中是否含有"vp"关键字
(progn ;如果不含有"vp"关键字
(setq objects (vla-get-objects layer)) ;获取当前图层上的所有图元对象
(vla-foreach obj objects ;遍历所有图元对象
(vla-delete obj)) ;删除当前图元对象
)
)
)
)

(unlock-all-layers) ;解锁所有图层
(repeat 100 ;执行100次以下操作
(explode-gps-blocks) ;多次分解在0-GPS图层上的块，直到不再有0-GPS图层的块
)
(delete-objects-without-vp) ;删除不含有vp关键字的图层上的图元对象

x_s_s_1 发表于 2023-3-8 15:06:54

试试，先保存图哈，不保证不崩溃
(defun c:tt (/ allx ss n)
(defun allx (blkobj / lst lst1)
    (setq lst (vlax-safearray->list
    (vlax-variant-value (vla-explode blkobj))
    )
    )
    (vla-delete blkobj)
    (foreach n lst
      (if (equal (vla-get-ObjectName n) "AcDbBlockReference")
(allx n)
(if (null (vl-string-search "vp" (vla-get-layer n)))
    (vla-delete n)
    )
)
      )
    )
(setq ss (ssget "x" '((0 . "INSERT") (8 . "0-GPS"))))
(repeat (setq n (sslength ss))
    (setq blkobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    (allx blkobj)
    )
)

wzg356 发表于 2023-3-8 17:17:41

牛逼，我们落伍了

wzg356 发表于 2023-3-8 17:23:48

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

轻尘 发表于 2023-3-8 17:39:06

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

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

liuhe 发表于 2023-3-8 21:25:32

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

muwind 发表于 2023-3-8 22:22:55

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

轻尘 发表于 2023-3-9 10:16:47

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

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

liuhe 发表于 2023-3-9 19:57:09

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

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

wzg356 发表于 2023-3-9 20:29:19

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

那句话，就一闪而过的纳闷
页: [1] 2
查看完整版本: 求大神帮我修改下lisp代码，chatgpt写的在cad报错.