按顏色分層(紅色指定到0層並將色改為紅色)

2564277832

請教 highflybir  龙龙仔 板主
以下內容是兩位所提供的內容，
在下若是想把1號色的"1"號層搬到"0"並將顏色改成1號色的紅色。
該如何著手修改
請指教。

在下用很笨的方法
(command "-layer" "color" 1  "0" "")
(if (setq ss (ssget "X"'((8 . "1"))))
(command ".chprop" ss "" "LA" "0" "c" "1" "")
將圖搬到0層改顏色為紅，但是此方法無法在圖塊中搬動

2. 
   
3. (defun C:DDDD (/ *DOC *OBJ *LAY blocks layers)
   
4.    (setvar "CMDECHO" 0)
   
5. (vl-load-com)
   
6.   (setq *OBJ (vlax-get-acad-object))
   
7.   (setq *DOC (vla-get-activedocument *OBJ))
   
8.   (setq *LAY (vla-get-layers *DOC))              ;取得層集合
   
9.   (table)
   
10.   (setq blocks (vla-get-blocks *DOC))            ;取得塊集合
    
11.   (vlax-for block blocks           ;遍歷塊集合
    
12.     (vlax-for n block            ;遍歷單個塊
    
13.       (ccb n)
    
14.     )
    
15.   )
    
16. 
    
17. (setvar "CMDECHO" 1)
    
18.   (princ)
    
19. )
    
20. (defun ccb (object / colour laynam laycol)
    
21.   (setq colour (itoa (vla-get-color object)))    ;取得物體顏色號
    
22.   (cond            
    
23.     ( (or (= colour "256") (= colour "0"))       ;如果物體顏色隨層或隨塊
    
24.       (setq laynam (vla-get-layer object))       ;取得物體所在層名
    
25.       (setq laycol (cdr (assoc laynam layers)))  ;取得層顏色
    
26.       (setq colour (itoa laycol))            
    
27.       (ML)                                      
    
28.     )
    
29.     ( (ML)
    
30.       (vla-put-color object 256)                 ;否則改變物體顏色為隨層
    
31.     )
    
32.   )
    
33.   (vla-put-layer object colour)                  ;對物體改層到顏色號層
    
34. )
    
35. (defun ML (/ layobj)
    
36.    (if (not (assoc colour layers))                ;如果顏色號不在圖層表中
    
37.      (progn
    
38.      (setq layers (cons (cons colour laycol) layers))
    
39.       
    
40.                                                            ;重新構造圖層表
    
41.       (setq layobj (vla-add *LAY colour )    )   ;創建顏色號圖層
    
42.       
    
43.       (vla-put-color layobj colour)
    
44.              ;對顏色號層賦色
    
45. 
    
46.    
    
47. )
    
48. 
    
49.   )
    
50. )
    
51. (defun table (/ name color Nname)
    
52.   (vlax-for n *LAY                               ;遍歷層集合
    
53.     (setq name (vla-get-name n))                 ;取得層名
    
54.     (setq color (vla-get-color n))               ;取得層顏色
    
55.     (setq layers (cons (cons name color) layers));獲得層名和顏色號表
    
56.     (setq Nname (read name))
    
57.     (if (= (type Nname) (type 1))                ;如果層名是整數
    
58.       (if (= (strlen (itoa Nname)) (strlen name))
    
59.         (if (and (> Nname 0) (< Nname 256))      ;並且>0,<256
    
60.           (if (/= color Nname)                   ;如果層顏色不等於層名
    
61.             (vla-put-color n Nname)              ;則改層顏色為層名
    
62. 
    
63.           )
    
64.         )
    
65.       )
    
66.     )
    
67.   )
    
68. )
    

<br /> (defun C:DDDD (/ *DOC *OBJ *LAY blocks layers)<br />    (setvar "CMDECHO" 0)<br /> (vl-load-com)<br />   (setq *OBJ (vlax-get-acad-object))<br />   (setq *DOC (vla-get-activedocument *OBJ))<br />   (setq *LAY (vla-get-layers *DOC))              ;取得層集合<br />   (table) <br />   (setq blocks (vla-get-blocks *DOC))            ;取得塊集合<br />   (vlax-for block blocks           ;遍歷塊集合<br />     (vlax-for n block            ;遍歷單個塊<br />       (ccb n)<br />     )<br />   )<br /> <br /> (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br /> (defun ccb (object / colour laynam laycol)<br />   (setq colour (itoa (vla-get-color object)))    ;取得物體顏色號<br />   (cond             <br />     ( (or (= colour "256") (= colour "0"))       ;如果物體顏色隨層或隨塊<br />       (setq laynam (vla-get-layer object))       ;取得物體所在層名<br />       (setq laycol (cdr (assoc laynam layers)))  ;取得層顏色<br />       (setq colour (itoa laycol))             <br />       (ML)                                      <br />     )<br />     ( (ML)<br />       (vla-put-color object 256)                 ;否則改變物體顏色為隨層<br />     )<br />   )<br />   (vla-put-layer object colour)                  ;對物體改層到顏色號層<br /> )<br /> (defun ML (/ layobj)<br />    (if (not (assoc colour layers))                ;如果顏色號不在圖層表中<br />      (progn <br />      (setq layers (cons (cons colour laycol) layers))<br />       <br />                                                            ;重新構造圖層表<br />       (setq layobj (vla-add *LAY colour )    )   ;創建顏色號圖層<br />       <br />       (vla-put-color layobj colour)<br />              ;對顏色號層賦色<br /> <br />     <br /> )<br /> <br />   ) <br /> )<br /> (defun table (/ name color Nname)<br />   (vlax-for n *LAY                               ;遍歷層集合<br />     (setq name (vla-get-name n))                 ;取得層名<br />     (setq color (vla-get-color n))               ;取得層顏色<br />     (setq layers (cons (cons name color) layers));獲得層名和顏色號表<br />     (setq Nname (read name))<br />     (if (= (type Nname) (type 1))                ;如果層名是整數<br />       (if (= (strlen (itoa Nname)) (strlen name))<br />         (if (and (> Nname 0) (< Nname 256))      ;並且>0,<256<br />           (if (/= color Nname)                   ;如果層顏色不等於層名<br />             (vla-put-color n Nname)              ;則改層顏色為層名<br /> <br />           )<br />         )<br />       )<br />     )<br />   )<br /> )<br />