如何将块内某一颜色改为随层，其他颜色不变？

luohonghe

如何将块内某一颜色改为随层，其他颜色不变？将块内134颜色改为随层，其他颜色不变？

Lisphk

搜索下 图块 颜色

marting

1. (defun c:tt ()
   
2.   (if (and (setq e (car (entsel "\n拾取图块<退出>:")))
   
3.            (setq clr (getint "\n输入要修改为随层的颜色号<退出>:"))
   
4.            (setq o (vlax-ename->vla-object e))
   
5.            (setq blkname (vla-get-name o))
   
6.            (= (vla-get-objectname o)
   
7.               "AcDbBlockReference"
   
8.            )
   
9.       )
   
10.     (progn
    
11.       (setq tf nil)
    
12.       (vlax-for        item (vla-get-blocks
    
13.                        (setq *doc* (vla-get-activedocument
    
14.                                      (vlax-get-acad-object)
    
15.                                    )
    
16.                        )
    
17.                      )
    
18.         (if (and (= :vlax-false (vla-get-islayout item))
    
19.                  (= (vla-get-name item) blkname)
    
20.             )
    
21.           (progn
    
22.             (vlax-for item1 item
    
23.               (if (= clr (vla-get-color item1))
    
24.                 (progn
    
25.                   (vla-put-color item1 acbylayer)
    
26.                   (setq tf t)
    
27.                 )
    
28.               )
    
29.             )
    
30.           )
    
31.         )
    
32.       )
    
33.       (and tf
    
34.            (vla-regen *doc* 1)
    
35.       )
    
36.     )
    
37.   )
    
38.   (princ)
    
39. )
    

(defun c:tt ()<br />   (if (and (setq e (car (entsel "\n拾取图块<退出>:")))<br />            (setq clr (getint "\n输入要修改为随层的颜色号<退出>:"))<br />            (setq o (vlax-ename->vla-object e))<br />            (setq blkname (vla-get-name o))<br />            (= (vla-get-objectname o)<br />               "AcDbBlockReference"<br />            )<br />       )<br />     (progn<br />       (setq tf nil)<br />       (vlax-for        item (vla-get-blocks<br />                        (setq *doc* (vla-get-activedocument<br />                                      (vlax-get-acad-object)<br />                                    )<br />                        )<br />                      )<br />         (if (and (= :vlax-false (vla-get-islayout item))<br />                  (= (vla-get-name item) blkname)<br />             )<br />           (progn<br />             (vlax-for item1 item<br />               (if (= clr (vla-get-color item1))<br />                 (progn<br />                   (vla-put-color item1 acbylayer)<br />                   (setq tf t)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (and tf<br />            (vla-regen *doc* 1)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

hh_lj007

marting 发表于 2021-1-17 18:45

太厉害了，代码都出来了。