[转贴]：圖層合併，摘自明經

taner

2. 
   
3.   [FONT=courier new]
   
4. (defun mergelays (lay1 lay2 / cnt space blocks attrs)
   
5.   (command "-layer" "u" lay1 "")
   
6.   (setq blocks (vla-get-blocks (vla-get-activedocument
   
7.                                                        (vlax-get-acad-object)
   
8.                                )
   
9.                )
   
10.   )
    
11.   (setq cnt 0)
    
12.   (while (< cnt (vla-get-count blocks))
    
13.     (setq space (vla-item blocks cnt))
    
14.     (vlax-for itm space (if (= (strcase (vla-get-layer itm))
    
15.                                (strcase lay1)
    
16.                             )
    
17.                           (vla-put-layer itm lay2)
    
18.                         ) (if (and
    
19.                                 (= (vla-get-objectname itm)
    
20.                                    "AcDbBlockReference"
    
21.                                 )
    
22.                                 (= (vla-get-hasattributes itm) :vlax-true)
    
23.                               )
    
24.                             (progn
    
25.                               (setq attrs (vlax-safearray->list
    
26.                                                                 (vlax-variant-value
    
27.                                                                                     (vla-getattributes itm)
    
28.                                                                 )
    
29.                                           )
    
30.                               )
    
31.                               (foreach attr attrs
    
32.                                 (if (= (strcase (vla-get-layer attr))
    
33.                                        (strcase lay1)
    
34.                                     )
    
35.                                   (vla-put-layer attr lay2)
    
36.                                 )
    
37.                               )
    
38.                             )
    
39.                           )
    
40.     )
    
41.     (setq cnt (1+ cnt))
    
42.   )
    
43.   (if (= (getvar "CLAYER") lay1)
    
44.     (setvar "CLAYER" lay2)
    
45.   )
    
46.   (command "_.purge" "lay" lay1 "_n")  
    
47.   (princ)
    
48. )
    
49.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun mergelays (lay1 lay2 / cnt space blocks attrs)<br />   (command "-layer" "u" lay1 "")<br />   (setq blocks (vla-get-blocks (vla-get-activedocument<br />                                                        (vlax-get-acad-object)<br />                                )<br />                )<br />   )<br />   (setq cnt 0)<br />   (while (< cnt (vla-get-count blocks))<br />     (setq space (vla-item blocks cnt))<br />     (vlax-for itm space (if (= (strcase (vla-get-layer itm))<br />                                (strcase lay1)<br />                             )<br />                           (vla-put-layer itm lay2)<br />                         ) (if (and<br />                                 (= (vla-get-objectname itm)<br />                                    "AcDbBlockReference"<br />                                 )<br />                                 (= (vla-get-hasattributes itm) :vlax-true)<br />                               )<br />                             (progn<br />                               (setq attrs (vlax-safearray->list<br />                                                                 (vlax-variant-value<br />                                                                                     (vla-getattributes itm)<br />                                                                 )<br />                                           )<br />                               )<br />                               (foreach attr attrs<br />                                 (if (= (strcase (vla-get-layer attr))<br />                                        (strcase lay1)<br />                                     )<br />                                   (vla-put-layer attr lay2)<br />                                 )<br />                               )<br />                             )<br />                           )<br />     )<br />     (setq cnt (1+ cnt))<br />   )<br />   (if (= (getvar "CLAYER") lay1)<br />     (setvar "CLAYER" lay2)<br />   )<br />   (command "_.purge" "lay" lay1 "_n")  <br />   (princ)<br /> )<br />   [/FONT]<br />