批量块内对象图层修改,请高手编一个小程序
本帖最后由 Nico 于 2023-5-25 16:38 编辑生成的图形,打印出来 不清楚，请高手做个批量程序更一下块内对象的图层
功能：
1、框选对象，过滤只留块
2、对多全块内的对象进行修改（具体要求见备注或.dwg文件）。
3、完成
请看附件.dwg文件
原图形 的虚线（颜色：172.172.172 线型：线宽 ）改为默认 (颜色： ByLayer ,线型： ByLayer , 线宽ByLayer ) 并放置在A2图层上面。
原图形 的实线（颜色：白线型：线宽:0.09 ）改为默认 (颜色： ByLayer ,线型： ByLayer , 线宽ByLayer ) 并放置在0图层上面。
本帖最后由 vitalgg 于 2023-5-25 20:08 编辑
(defun c:hc ()
;; 选择需要改色的块
(setq blks (pickset:to-list (ssget '((0 . "insert")))))
;; 取得无重复的块名列表
(setq blk-names (list:remove-duplicates
(mapcar '(lambda (x) (entity:getdxf x 2)) blks)
))
(foreach blkname blk-names
(foreach ent (block:ent-list blkname)
(cond
((or
(= (entity:getdxf ent 62) 253)
(= (entity:getdxf ent 420) 11316396))
;;对ent 颜色为 172.172.172的进行处理
;; 删除真彩色,色号
(entity:deldxf ent 420)
(entity:putdxf ent 62 256)
;; 删除线型线宽
(vla-put-Linetype (e2o ent) "bylayer")
(vla-put-Lineweight (e2o ent) acLnWtByLayer)
;; 设图层为 A2
(entity:putdxf ent 8 "A2")
)
((or
(= (entity:getdxf ent 62) 7))
;;对ent 颜色为 7 的进行处理
;; 删除真彩色,色号
(entity:deldxf ent 420)
(entity:putdxf ent 62 256)
;; 删除线型线宽
(vla-put-Linetype (e2o ent) "bylayer")
(vla-put-Lineweight (e2o ent) acLnWtByLayer)
;; 设图层为 0
(entity:putdxf ent 8 "0")
)
)
)
)
(@:cmd "regen")
)
上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn
vitalgg 发表于 2023-5-25 20:02
上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn
不开文件可以改吗？ vitalgg 发表于 2023-5-25 20:02
上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn
网站上没看懂要下载哪一个安装包 Nico 发表于 2023-6-2 20:09
网站上没看懂要下载哪一个安装包
只安装核心程序就可以执行上面的代码了。
vitalgg 发表于 2023-6-2 22:15
只安装核心程序就可以执行上面的代码了。
感谢会用了，建议网站做一页安装说明放显眼的位置。 感谢作者的分享！
页:
[1]