[LISP程序]：处理BLOCK内实体的图层和颜色

iVox

v1.0 2003-08-15

目的：
修改块内实体的图层和颜色到指定的值。

适用版本：
AutoCAD2002、AutoCAD2004，其他尚未尝试。

操作：
1。选择一个INSERT
2。接受缺省选项或指定目标图层、目标颜色
3。完成一次修改，屏幕暂时无变化
4。继续选择其他INSERT……
5。REGEN，完成

说明：
1。图层选项目前有点问题，不能运行。我脑筋短路，一时看不出问题的根源 ：（
已经改好。原因是我原来使用了系统保留关键字L或LA来代表layer。[/COLOR]
2。颜色选项支持代称，比如你可以输入2，或者Y，或者Yellow来选择黄色。但蓝色BLue是个例外，必须输入BL而不是B，因为B分配给了byBlock。

以下为v1.0源代码。请勿修改作者信息。

2. 
   
3.   [FONT=courier new]
   
4. ;;; FISHLISP
   
5. ;;; Little Fish Studio [url]http://ivox.bjht.com[/url]
   
6. ;;; C:BKC
   
7. ;;; Change layer(s), color(s) of entities within a block.
   
8. ;;; History:
   
9. ;;; 03-08-15 v1.0 original version.
   
10. 
    
11. (defun c:bkc (/ olderr bkc_alias bk en ent cnt )
    
12.   (setq olderr *error*)
    
13.   (defun *error* (s)
    
14.     (command "regen")
    
15.     (princ)
    
16.   )
    
17.   (setq bkc_layer (if bkc_layer bkc_layer "0"))
    
18.   (setq bkc_color (if bkc_color bkc_color 0))
    
19.   (setq bkc_alias
    
20.     (cond
    
21.       ( (= bkc_color 0) "ByBlock")
    
22.       ( (= bkc_color 1) "Red")
    
23.       ( (= bkc_color 2) "Yellow")
    
24.       ( (= bkc_color 3) "Green")
    
25.       ( (= bkc_color 4) "Cyan")
    
26.       ( (= bkc_color 5) "Blue")
    
27.       ( (= bkc_color 6) "Magenta")
    
28.       ( (= bkc_color 7) "White")
    
29.       ( (= bkc_color 256) "ByLayer")
    
30.       ( t (rtos bkc_color 2 0))
    
31.     );cond
    
32.   );setq bkc_alias
    
33.   (princ "\nFISHLISP: BKC v1.0. Little Fish Studio. 2003-08-15")
    
34.   (princ (strcat "\nTarget Layer: " bkc_layer ", target Color: " bkc_alias))
    
35.   (while (setq bk (getbk))
    
36.     (setq en (cdr (assoc -2 (tblsearch "block" bk))))
    
37.     (setq cnt 0)
    
38.     (while en
    
39.       (setq ent (entget en))
    
40.       (setq ent (subst (cons 8 bkc_layer) (assoc 8 ent) ent))
    
41.       (if (assoc 62 ent)
    
42.         (setq ent (subst (cons 62 bkc_color) (assoc 62 ent) ent))
    
43.         (if (= bkc_color 256) nil
    
44.           (setq ent (append ent (list (cons 62 bkc_color))))
    
45.         )
    
46.       );
    
47.       (entmod ent)
    
48.       (setq cnt (1+ cnt))
    
49.       (setq en (entnext en))
    
50.     );while
    
51.     (princ (strcat "\n" (rtos cnt 2 0) " entitie(s) in Block " bk " changed. Regen required. "))
    
52.   );while bk
    
53.   (princ "\n")
    
54.   (command "regen")
    
55.   (setq *error* olderr)
    
56.   (princ)
    
57. )
    
58. 
    
59. (defun getbk (/ bk_en bl bc bk_name)
    
60.   (initget "laYer Color")
    
61.   (setq bk_en (entsel "\n[laYer/Color] Select INSERT to edit: "))
    
62.   (cond
    
63.     ( (= bk_en "laYer")
    
64.       (princ (strcat "\nTarget Layer: <" bkc_layer "> "))
    
65.       (setq bl (getstring t))
    
66.       (setq bl
    
67.         (cond
    
68.           ( (= bl "") bkc_layer)
    
69.           ( (not (tblsearch "layer" bl))
    
70.             (princ "\nLayer not found. ")
    
71.             bkc_layer
    
72.           )
    
73.           ( t bl)
    
74.         );cond
    
75.       ); setq bl
    
76.       (setq bkc_layer bl)
    
77.       (getbk)
    
78.     ); layer
    
79.     ( (= bk_en "Color")
    
80.       (princ (strcat "\nTarget Color: <" bkc_alias "> "))
    
81.       (initget "byBlock byLayer Red Yellow Green Cyan BLue Magenta White")
    
82.       (setq bc (getint))
    
83.       (setq bc
    
84.         (cond
    
85.           ( (not bc) bkc_color)
    
86.           ( (= bc "byBlock") 0)
    
87.           ( (= bc "Red") 1)
    
88.           ( (= bc "Yellow") 2)
    
89.           ( (= bc "Green") 3)
    
90.           ( (= bc "Cyan") 4)
    
91.           ( (= bc "BLue") 5)
    
92.           ( (= bc "Magenta") 6)
    
93.           ( (= bc "White") 7)
    
94.           ( (= bc "byLayer") 256)
    
95.           ( t
    
96.             (if (>= 256 bc 0)
    
97.               bc
    
98.               (progn
    
99.                 (princ "\nInvalid color index ignored! ")
    
100.                 bkc_color
     
101.               )
     
102.             );if
     
103.           );else
     
104.         );cond
     
105.       );setq
     
106.       (setq bkc_color bc)
     
107.       (getbk)
     
108.     ); color
     
109.     ( (listp bk_en)
     
110.       (setq bk_ent (entget (car bk_en)))
     
111.       (setq bk_name (if (= "INSERT" (cdr (assoc 0 bk_ent))) (cdr (assoc 2 bk_ent))))
     
112.       bk_name
     
113.     )
     
114.     ( t nil)
     
115.   );cond
     
116. ); getbk
     
117. 
     
118. (princ "loaded. Start as C:BKC ")
     
119. (princ)
     
120.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;;; FISHLISP<br /> ;;; Little Fish Studio [url]http://ivox.bjht.com[/url]<br /> ;;; C:BKC<br /> ;;; Change layer(s), color(s) of entities within a block.<br /> ;;; History:<br /> ;;; 03-08-15 v1.0 original version.<br /> <br /> (defun c:bkc (/ olderr bkc_alias bk en ent cnt )<br />   (setq olderr *error*)<br />   (defun *error* (s)<br />     (command "regen")<br />     (princ)<br />   )<br />   (setq bkc_layer (if bkc_layer bkc_layer "0"))<br />   (setq bkc_color (if bkc_color bkc_color 0))<br />   (setq bkc_alias<br />     (cond <br />       ( (= bkc_color 0) "ByBlock")<br />       ( (= bkc_color 1) "Red")<br />       ( (= bkc_color 2) "Yellow")<br />       ( (= bkc_color 3) "Green")<br />       ( (= bkc_color 4) "Cyan")<br />       ( (= bkc_color 5) "Blue")<br />       ( (= bkc_color 6) "Magenta")<br />       ( (= bkc_color 7) "White")<br />       ( (= bkc_color 256) "ByLayer")<br />       ( t (rtos bkc_color 2 0))<br />     );cond<br />   );setq bkc_alias<br />   (princ "\nFISHLISP: BKC v1.0. Little Fish Studio. 2003-08-15")<br />   (princ (strcat "\nTarget Layer: " bkc_layer ", target Color: " bkc_alias))<br />   (while (setq bk (getbk))<br />     (setq en (cdr (assoc -2 (tblsearch "block" bk))))<br />     (setq cnt 0)<br />     (while en<br />       (setq ent (entget en))<br />       (setq ent (subst (cons 8 bkc_layer) (assoc 8 ent) ent))<br />       (if (assoc 62 ent)<br />         (setq ent (subst (cons 62 bkc_color) (assoc 62 ent) ent))<br />         (if (= bkc_color 256) nil<br />           (setq ent (append ent (list (cons 62 bkc_color))))<br />         )<br />       );<br />       (entmod ent)<br />       (setq cnt (1+ cnt))<br />       (setq en (entnext en))<br />     );while<br />     (princ (strcat "\n" (rtos cnt 2 0) " entitie(s) in Block " bk " changed. Regen required. "))<br />   );while bk<br />   (princ "\n")<br />   (command "regen")<br />   (setq *error* olderr)<br />   (princ)<br /> )<br /> <br /> (defun getbk (/ bk_en bl bc bk_name)<br />   (initget "laYer Color")<br />   (setq bk_en (entsel "\n[laYer/Color] Select INSERT to edit: "))<br />   (cond<br />     ( (= bk_en "laYer")<br />       (princ (strcat "\nTarget Layer: <" bkc_layer "> "))<br />       (setq bl (getstring t))<br />       (setq bl<br />         (cond<br />           ( (= bl "") bkc_layer)<br />           ( (not (tblsearch "layer" bl))<br />             (princ "\nLayer not found. ")<br />             bkc_layer<br />           )<br />           ( t bl)<br />         );cond<br />       ); setq bl<br />       (setq bkc_layer bl)<br />       (getbk)<br />     ); layer<br />     ( (= bk_en "Color")<br />       (princ (strcat "\nTarget Color: <" bkc_alias "> "))<br />       (initget "byBlock byLayer Red Yellow Green Cyan BLue Magenta White")<br />       (setq bc (getint))<br />       (setq bc<br />         (cond<br />           ( (not bc) bkc_color)<br />           ( (= bc "byBlock") 0)<br />           ( (= bc "Red") 1)<br />           ( (= bc "Yellow") 2)<br />           ( (= bc "Green") 3)<br />           ( (= bc "Cyan") 4)<br />           ( (= bc "BLue") 5)<br />           ( (= bc "Magenta") 6)<br />           ( (= bc "White") 7)<br />           ( (= bc "byLayer") 256)<br />           ( t<br />             (if (>= 256 bc 0)<br />               bc<br />               (progn<br />                 (princ "\nInvalid color index ignored! ")<br />                 bkc_color<br />               )<br />             );if<br />           );else<br />         );cond<br />       );setq<br />       (setq bkc_color bc)<br />       (getbk)<br />     ); color<br />     ( (listp bk_en)<br />       (setq bk_ent (entget (car bk_en)))<br />       (setq bk_name (if (= "INSERT" (cdr (assoc 0 bk_ent))) (cdr (assoc 2 bk_ent))))<br />       bk_name<br />     )<br />     ( t nil)<br />   );cond<br /> ); getbk<br /> <br /> (princ "loaded. Start as C:BKC ")<br /> (princ)<br />   [/FONT]<br />

cdjtsf

能否直接编辑块内文字

aeo

块中块没改过来.

对insert  (entupd )就不要regen了.