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

aeo

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

和图块在的层的颜色一样，不是当前层。

yyx616

我是初学者请原谅

红太阳

使用打印打式更方便一些。

lshpool

你们的工具都不支持块中块

eachy

2. 
   
3. (defun c:tt (/ blocks obj blk)
   
4.   (setq        blocks (vla-get-blocks
   
5.                  (vla-get-activedocument (vlax-get-acad-object))
   
6.                )
   
7.   )
   
8.   (vlax-for blk        blocks
   
9.     (if        (not (wcmatch (vla-get-name blk) "`**_Space*"))
   
10.       (vlax-for        obj blk
    
11.         (vla-put-layer obj "0")
    
12.         (vla-put-color obj acByblock)
    
13.       )
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )

<br /> (defun c:tt (/ blocks obj blk)<br />   (setq        blocks (vla-get-blocks<br />                  (vla-get-activedocument (vlax-get-acad-object))<br />                )<br />   )<br />   (vlax-for blk        blocks<br />     (if        (not (wcmatch (vla-get-name blk) "`**_Space*"))<br />       (vlax-for        obj blk<br />         (vla-put-layer obj "0")<br />         (vla-put-color obj acByblock)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

lshpool

大虾们帮我看看,如何让下面图块改颜色\图层的程序支持块中块,多谢了

2. 
   
3. (defun C:BKMD ()
   
4.   (prompt "**********更改块内图元********** \n")
   
5.   (setq cmd (getvar "CMDECHO"))
   
6.   (setvar "cmdecho" 0)
   
7.   (prompt "\n选择需要改动的块: ")
   
8.   (setq ent_blk (ssget '((0 . "INSERT"))))
   
9.   (setq count (sslength ent_blk))
   
10.   (setq index 0)
    
11.   (initget 1 "1 2 3 ")
    
12.   (setq setkey (getkword "\nCOLOR 1/LAYER 2/LINETYPE 3/ <>   "))
    
13.   (cond
    
14.     ((= setkey "1")
    
15.       (setq attr (acad_colordlg 7)
    
16.         dxfcode 62
    
17.       )
    
18.     )
    
19.     ((= setkey "2")
    
20.       (setq attr (getstring "改到何层? ")
    
21.         dxfcode 8
    
22.       )
    
23.     )
    
24.     ((= setkey "3")
    
25.       (setq attr (getstring "改为何种线型? ")
    
26.         dxfcode 6
    
27.       )
    
28.     )
    
29.     (t   nil)
    
30.   )
    
31.   (repeat count
    
32.     (setq eg1 (entget (ssname ent_blk index)))
    
33.     (setq en1 (ssname ent_blk index))
    
34.     (redraw en1 3)
    
35.     (setq en1 nil)
    
36.     (setq nam (cdr (assoc 2 eg1)))
    
37.     (setq en2 (cdr (assoc -2 (tblsearch "block" nam))))
    
38.     (BKMD_PR dxfcode attr en2 nam)
    
39.     (setq index (+ index 1))
    
40.   )
    
41.   (setvar "CMDECHO" cmd)
    
42.   (princ)
    
43. )
    
44. (defun BKMD_PR (dxfcode attr en2 nam)
    
45.   (setq cnt 0)
    
46.   (while en2
    
47.     (setq cnt (1+ cnt)
    
48.       eg2 (entget en2)
    
49.       en2 (entnext (cdr (assoc -1 eg2)))
    
50.     )
    
51.     (grtext -2 (strcat nam " block entity # " (itoa cnt)))
    
52.     (if (= (cdr (assoc 0 eg2)) "insert")
    
53.       (progn
    
54.     (setq nm2 (cdr (assoc 2 eg2))
    
55.           en3 (cdr (assoc -2 (tblsearch "block" nm2)))
    
56.     )
    
57.     (BKMD_PR dxfcode attr en3 nm2)
    
58.       )
    
59.       (progn
    
60.     (if (assoc dxfcode eg2)
    
61.       (setq eg2 (subst
    
62.               (cons dxfcode attr)
    
63.               (assoc dxfcode eg2)
    
64.               eg2
    
65.             )
    
66.       )
    
67.       (setq eg2 (append
    
68.               eg2
    
69.               (list (cons dxfcode attr))
    
70.             )
    
71.       )
    
72.     )
    
73.     (entmod eg2)
    
74.       )
    
75.     )
    
76.   )
    
77.   (setq ss1 (ssget "x" (list (cons 2 nam)))
    
78.     cnt 0
    
79.   )
    
80.   (while (setq en1 (ssname ss1 cnt))
    
81.     (setq cnt (1+ cnt))
    
82.     (entupd en1)
    
83.   )
    
84. )
    
85. (princ)
    
86. (princ "BKMD loaded! Start command with BKMD")

<br /> (defun C:BKMD () <br />   (prompt "**********更改块内图元********** \n") <br />   (setq cmd (getvar "CMDECHO")) <br />   (setvar "cmdecho" 0) <br />   (prompt "\n选择需要改动的块: ") <br />   (setq ent_blk (ssget '((0 . "INSERT")))) <br />   (setq count (sslength ent_blk)) <br />   (setq index 0) <br />   (initget 1 "1 2 3 ") <br />   (setq setkey (getkword "\nCOLOR 1/LAYER 2/LINETYPE 3/ <>   ")) <br />   (cond <br />     ((= setkey "1") <br />       (setq attr (acad_colordlg 7) <br />         dxfcode 62 <br />       ) <br />     ) <br />     ((= setkey "2") <br />       (setq attr (getstring "改到何层? ") <br />         dxfcode 8 <br />       ) <br />     ) <br />     ((= setkey "3") <br />       (setq attr (getstring "改为何种线型? ") <br />         dxfcode 6 <br />       ) <br />     ) <br />     (t   nil) <br />   ) <br />   (repeat count <br />     (setq eg1 (entget (ssname ent_blk index))) <br />     (setq en1 (ssname ent_blk index)) <br />     (redraw en1 3) <br />     (setq en1 nil) <br />     (setq nam (cdr (assoc 2 eg1))) <br />     (setq en2 (cdr (assoc -2 (tblsearch "block" nam)))) <br />     (BKMD_PR dxfcode attr en2 nam) <br />     (setq index (+ index 1)) <br />   ) <br />   (setvar "CMDECHO" cmd) <br />   (princ) <br /> ) <br /> (defun BKMD_PR (dxfcode attr en2 nam) <br />   (setq cnt 0) <br />   (while en2 <br />     (setq cnt (1+ cnt) <br />       eg2 (entget en2) <br />       en2 (entnext (cdr (assoc -1 eg2))) <br />     ) <br />     (grtext -2 (strcat nam " block entity # " (itoa cnt))) <br />     (if (= (cdr (assoc 0 eg2)) "insert") <br />       (progn <br />     (setq nm2 (cdr (assoc 2 eg2)) <br />           en3 (cdr (assoc -2 (tblsearch "block" nm2))) <br />     ) <br />     (BKMD_PR dxfcode attr en3 nm2) <br />       ) <br />       (progn <br />     (if (assoc dxfcode eg2) <br />       (setq eg2 (subst <br />               (cons dxfcode attr) <br />               (assoc dxfcode eg2) <br />               eg2 <br />             ) <br />       ) <br />       (setq eg2 (append <br />               eg2 <br />               (list (cons dxfcode attr)) <br />             ) <br />       ) <br />     ) <br />     (entmod eg2) <br />       ) <br />     ) <br />   ) <br />   (setq ss1 (ssget "x" (list (cons 2 nam))) <br />     cnt 0 <br />   ) <br />   (while (setq en1 (ssname ss1 cnt)) <br />     (setq cnt (1+ cnt)) <br />     (entupd en1) <br />   ) <br /> ) <br /> (princ) <br /> (princ "BKMD loaded! Start command with BKMD")

eachy

图形窗口显示的 Block 准确应该叫 Insert （BlockReference），使  Insert 改变应该修改对应的 BlockDeference。每个 Insert 都对应唯一的 BlockDeference，将所有的 BlockDeference 修改后，图形中的所有块都会改变，不论是单纯的 Insert 还是 Insert 中的 Insert。

这里面唯一例外的是 Attrib ，不知Autodesk怎么设计的，Blockdef 中的是 Attdef，而 Attrib 不属于 BlockDef 也不在 Modelspace ，只能在 Insert 下找，就像一个分支。

yxljx

感觉好像不太有用。不过楼主精神可嘉。

az98hxq

困惑我多时的问题今天终于可以解决了
谢谢楼上诸位的无私奉献呀!!

+突破+

学习。。。
有个小问题，请教一下改图层的时候，能否让颜色改随层。。。

TYEEXDD

晓东工具箱里有这个功能，很全面很好用的呀！

dandan

xue xi

luohonghe

红色箭头改为0层，颜色随层，蓝色箭头改为0层，颜色不变怎么设置？

                               
登录/注册后可看大图