[分享]：把块的颜色改为随层.

aeo

经常插了一些颜色很乱的图，打出来很难看.
现改到块所在的层.

2. 
   
3. ;;;By Aeo
   
4. (defun c:tk( / blk blkref blocks doc ent name )
   
5. (vl-load-com)
   
6.   (if(and (setq BLK     (car (entsel "\n选要随层的块: ")))
   
7.           (setq BLKREF  (vlax-ename->vla-object BLK))
   
8.           (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference")
   
9.               (princ"\n不是块:"))
   
10.            )
    
11.           (setq name(vla-get-name BLKREF))
    
12.       )
    
13.     (progn
    
14.           (command"undo""group")
    
15.           (setq DOC     (vla-get-activedocument (vlax-get-acad-object))
    
16.                 BLOCKS  (vla-get-blocks doc)
    
17.                 blk     (vla-item BLOCKS name)
    
18.           )
    
19.            (vlax-for ENT blk
    
20.              (vla-put-layer ent "0")
    
21.              (vla-put-color ent 256)
    
22.            )
    
23.         (vla-regen doc acActiveViewport)
    
24.         (vlax-release-object blk)
    
25.         (vlax-release-object BLOCKS)
    
26.         (vlax-release-object DOC)
    
27.         (command"undo""end")
    
28.         (princ"\nUndo后请regen.")
    
29.      )
    
30.   )
    
31. (princ))
    

<br /> ;;;By Aeo<br /> (defun c:tk( / blk blkref blocks doc ent name )<br /> (vl-load-com)<br />   (if(and (setq BLK     (car (entsel "\n选要随层的块: ")))<br />           (setq BLKREF  (vlax-ename->vla-object BLK))<br />           (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference")<br />               (princ"\n不是块:"))<br />            )<br />           (setq name(vla-get-name BLKREF))<br />       )<br />     (progn<br />           (command"undo""group")<br />           (setq DOC     (vla-get-activedocument (vlax-get-acad-object))<br />                 BLOCKS  (vla-get-blocks doc)<br />                 blk     (vla-item BLOCKS name)<br />           )<br />            (vlax-for ENT blk<br />              (vla-put-layer ent "0")<br />              (vla-put-color ent 256)<br />            )<br />         (vla-regen doc acActiveViewport)<br />         (vlax-release-object blk)<br />         (vlax-release-object BLOCKS)<br />         (vlax-release-object DOC)<br />         (command"undo""end")<br />         (princ"\nUndo后请regen.")<br />      )<br />   )<br /> (princ))<br />

gww

没那么麻烦。做快时,搞到0层上即可

PLgis

"把块的颜色改为随层"这个程序在工作中，会很有用的。

wcf

R14有不少用户，能否编一个R14版本的。

cxzr8

写得不错，不过我们作业时一般都是全图要素都设为随层的。

大尾巴狼

简单 好用 谢谢

kehello

就是呀，只能一个一个的选，有点点足呀，老大，能不能改一下呀，这样实用性更高

自由的鱼

不错的程序，对复杂的图形很管用！

fu2046

不错的工具！先用用！

andyhua5240

谢谢楼主，不过最好能支持窗选！谢谢！

穹心

好东西，不过不能窗选，好可惜，改进就好了。

ljs026

是丫！如果可以窗選或複選的話就更好了！而且如果能夠編出個制作無名塊，更同時將無名塊改為當前層的程序更好！另外發現只能作一次而已說，更換當前層後，再作一次就無法更改了說

xgwl

我不太会编程，看到那么多网友有同样的要求，我就试着改了改! 只是“再作一次就无法更改”的问题，我也无能为力了！

2. 
   
3.   [FONT=courier new]
   
4. ;;;By Aeo
   
5. (defun c:tksc( / blk blkref blocks doc ent name ss )
   
6. (vl-load-com)
   
7. (command"undo""group")
   
8. (prompt "选要随层的块:")
   
9.     (setq ss(ssget))
   
10.     (setq n 0)
    
11. (repeat (sslength ss)
    
12.     (setq BLK (ssname ss n))
    
13.   (if(and (setq BLKREF  (vlax-ename->vla-object BLK))
    
14.           (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference")
    
15.               (princ"\n不是块:"))
    
16.            )
    
17.           (setq name(vla-get-name BLKREF))
    
18.       )
    
19.     (progn         
    
20.           (setq DOC     (vla-get-activedocument (vlax-get-acad-object))
    
21.                 BLOCKS  (vla-get-blocks doc)
    
22.                 blk     (vla-item BLOCKS name)
    
23.           )
    
24.            (vlax-for ENT blk
    
25.              (vla-put-layer ent "0")
    
26.              (vla-put-color ent 256)
    
27.            )
    
28.         (vla-regen doc acActiveViewport)
    
29.         (vlax-release-object blk)
    
30.         (vlax-release-object BLOCKS)
    
31.         (vlax-release-object DOC)      
    
32.         (princ"\nUndo后请regen.")
    
33.      )
    
34.   )
    
35.   (setq n (1+ n))
    
36. )
    
37.   (command"undo""end")
    
38. (princ))
    
39.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;By Aeo<br /> (defun c:tksc( / blk blkref blocks doc ent name ss )<br /> (vl-load-com)<br /> (command"undo""group")<br /> (prompt "选要随层的块:")<br />     (setq ss(ssget))<br />     (setq n 0)<br /> (repeat (sslength ss)<br />     (setq BLK (ssname ss n))<br />   (if(and (setq BLKREF  (vlax-ename->vla-object BLK))<br />           (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference")<br />               (princ"\n不是块:"))<br />            )<br />           (setq name(vla-get-name BLKREF))<br />       )<br />     (progn          <br />           (setq DOC     (vla-get-activedocument (vlax-get-acad-object))<br />                 BLOCKS  (vla-get-blocks doc)<br />                 blk     (vla-item BLOCKS name)<br />           )<br />            (vlax-for ENT blk<br />              (vla-put-layer ent "0")<br />              (vla-put-color ent 256)<br />            )<br />         (vla-regen doc acActiveViewport)<br />         (vlax-release-object blk)<br />         (vlax-release-object BLOCKS)<br />         (vlax-release-object DOC)       <br />         (princ"\nUndo后请regen.")<br />      )<br />   )<br />   (setq n (1+ n))<br /> )<br />   (command"undo""end")<br /> (princ))<br />   [/FONT]<br />

月影水飘飘

怎么定义新的颜色？

andyhua5240

最初由 xgwl 发布
[B]我不太会编程，看到那么多网友有同样的要求，我就试着改了改! 只是“再作一次就无法更改”的问题，我也无能为力了！

[CODE]
  
;;;By Aeo
(defun c:tksc( / blk blkref blocks doc ent name... [/B]

改了改就是好用，不过就是只能用一次，意思：
我的块是红，当前层为0白色，用程序后，块改为当前层0白色。
可当我的当前层又变为图层1绿色时，用程序后，块不改为图层1，仍然是图层0白色。
能不能改改，能多次使用谢谢！