批量块内对象图层修改,请高手编一个小程序

Nico

生成的图形,打印出来 不清楚，请高手做个批量程序  更一下块内对象的图层


功能：
1、框选对象，过滤只留块
2、对多全块内的对象进行修改（具体要求见备注或.dwg文件）。
3、完成

请看附件.dwg文件
原图形 的虚线  （颜色：172.172.172   线型：  线宽   ）  改为默认   (颜色： ByLayer ,  线型： ByLayer , 线宽  ByLayer ) 并放置在A2图层上面。

原图形 的实线  （颜色：白  线型：  线宽:0.09   ）  改为默认   (颜色： ByLayer ,  线型： ByLayer , 线宽  ByLayer ) 并放置在0图层上面。

vitalgg

1. (defun c:hc ()
   
2.   ;; 选择需要改色的块
   
3.   (setq blks (pickset:to-list (ssget '((0 . "insert")))))
   
4.   ;; 取得无重复的块名列表
   
5.   (setq blk-names (list:remove-duplicates
   
6.                     (mapcar '(lambda (x) (entity:getdxf x 2)) blks)
   
7.                   ))
   
8.   (foreach blkname blk-names
   
9.     (foreach ent (block:ent-list blkname)
   
10.       (cond
    
11.         ((or
    
12.            (= (entity:getdxf ent 62) 253)
    
13.            (= (entity:getdxf ent 420) 11316396))
    
14.          ;;对ent 颜色为 172.172.172的进行处理
    
15.          ;; 删除真彩色,色号
    
16.          (entity:deldxf ent 420)
    
17.          (entity:putdxf ent 62 256)
    
18.          ;; 删除线型线宽
    
19.          (vla-put-Linetype (e2o ent) "bylayer")
    
20.          (vla-put-Lineweight (e2o ent) acLnWtByLayer)
    
21.          ;; 设图层为 A2
    
22.          (entity:putdxf ent 8 "A2")
    
23.         )
    
24.         ((or
    
25.            (= (entity:getdxf ent 62) 7))
    
26.          ;;对ent 颜色为 7 的进行处理
    
27.          ;; 删除真彩色,色号
    
28.          (entity:deldxf ent 420)
    
29.          (entity:putdxf ent 62 256)
    
30.          ;; 删除线型线宽
    
31.          (vla-put-Linetype (e2o ent) "bylayer")
    
32.          (vla-put-Lineweight (e2o ent) acLnWtByLayer)
    
33.          ;; 设图层为 0
    
34.          (entity:putdxf ent 8 "0")
    
35.         )
    
36.       )
    
37.     )
    
38.   )
    
39.   (@:cmd "regen")
    
40. )

(defun c:hc () <br />   ;; 选择需要改色的块<br />   (setq blks (pickset:to-list (ssget '((0 . "insert")))))<br />   ;; 取得无重复的块名列表<br />   (setq blk-names (list:remove-duplicates <br />                     (mapcar '(lambda (x) (entity:getdxf x 2)) blks)<br />                   ))<br />   (foreach blkname blk-names <br />     (foreach ent (block:ent-list blkname) <br />       (cond <br />         ((or <br />            (= (entity:getdxf ent 62) 253)<br />            (= (entity:getdxf ent 420) 11316396))<br />          ;;对ent 颜色为 172.172.172的进行处理<br />          ;; 删除真彩色,色号<br />          (entity:deldxf ent 420)<br />          (entity:putdxf ent 62 256)<br />          ;; 删除线型线宽<br />          (vla-put-Linetype (e2o ent) "bylayer")<br />          (vla-put-Lineweight (e2o ent) acLnWtByLayer)<br />          ;; 设图层为 A2<br />          (entity:putdxf ent 8 "A2")<br />         )<br />         ((or <br />            (= (entity:getdxf ent 62) 7))<br />          ;;对ent 颜色为 7 的进行处理<br />          ;; 删除真彩色,色号<br />          (entity:deldxf ent 420)<br />          (entity:putdxf ent 62 256)<br />          ;; 删除线型线宽<br />          (vla-put-Linetype (e2o ent) "bylayer")<br />          (vla-put-Lineweight (e2o ent) acLnWtByLayer)<br />          ;; 设图层为 0<br />          (entity:putdxf ent 8 "0")<br />         )<br />       )<br />     )<br />   )<br />   (@:cmd "regen")<br /> )

上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn

00放飞梦想00

vitalgg 发表于 2023-5-25 20:02
上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn

不开文件可以改吗？

Nico

vitalgg 发表于 2023-5-25 20:02
上面的代码需要在有 @lisp 环境下运行。
在 CAD 中 安装 @lisp ，请至 http://atlisp.cn

网站上  没看懂  要下载哪一个安装包

vitalgg

Nico 发表于 2023-6-2 20:09
网站上  没看懂  要下载哪一个安装包

只安装核心程序就可以执行上面的代码了。

Nico

vitalgg 发表于 2023-6-2 22:15
只安装核心程序就可以执行上面的代码了。

感谢  会用了，建议网站  做一页  安装说明放显眼的位置。

tensir

感谢作者的分享！