求助所有填充8号色，不改变原始图层

yangchao2005090

求助所有填充8号色，不改变原始图层

hb198075

程序名tt1

2. ;;;示例程序
   
3. (defun c:tt1 ()
   
4.   (changeColor "HATCH" 8)
   
5.   (princ)
   
6. )
   
7. 
   
8. ;;;变换颜色函数，ea图元名，cor颜色号
   
9. (defun changeColor (ea cor / ss n na obj)
   
10.   (if (setq ss (ssget "X"
    
11.                       (list
    
12.                         (cons 0 ea)
    
13.                       )
    
14.                )
    
15.       )
    
16.     (progn
    
17.       (setq n 0)
    
18.       (repeat (sslength ss)
    
19.         (setq na  (ssname ss n)
    
20.               obj (vlax-ename->vla-object na)
    
21.               n          (1+ n)
    
22.         )
    
23.         (vlax-put-property obj 'COLOR cor)
    
24.       )
    
25.     )
    
26.   )
    
27. )

;;;示例程序<br /> (defun c:tt1 ()<br />   (changeColor "HATCH" 8)<br />   (princ)<br /> )<br /> <br /> ;;;变换颜色函数，ea图元名，cor颜色号<br /> (defun changeColor (ea cor / ss n na obj)<br />   (if (setq ss (ssget "X"<br />                       (list<br />                         (cons 0 ea)<br />                       )<br />                )<br />       )<br />     (progn<br />       (setq n 0)<br />       (repeat (sslength ss)<br />         (setq na  (ssname ss n)<br />               obj (vlax-ename->vla-object na)<br />               n          (1+ n)<br />         )<br />         (vlax-put-property obj 'COLOR cor)<br />       )<br />     )<br />   )<br /> )

yangchao2005090

http://bbs.mjtd.com/thread-181562-1-1.html
这是以前求助过图块变色的帖子，不知道可否参考

yangchao2005090

hb198075 发表于 2020-7-16 18:01
程序名tt1

感谢感谢，这个比较通用