【K:RevLay】图层对调

kucha007

图层对调，不知道各位坛友是否还有更好的写法？

1. ;图层对调 by kucha - 202305
   
2. (defun K:RevLay (OriLay / TGTLay SS i en obj Lay)
   
3.   (if (setq SS (ssget))
   
4.     (repeat (setq i (sslength SS))
   
5.       (setq en  (ssname SS (setq i (1- i)))
   
6.             obj (vlax-ename->vla-object en)
   
7.             Lay (cdr (Assoc 8 (Entget en)))
   
8.       )
   
9.       (if
   
10.           (setq TgtLay (car
    
11.                         (vl-remove-if-not
    
12.                           '(lambda (x)
    
13.                               (or
    
14.                                 (eq (strcase Lay) (strcase (car x)))
    
15.                                 (eq (strcase Lay) (strcase (cadr x)))
    
16.                               )
    
17.                             )
    
18.                           OriLay
    
19.                         )
    
20.                       )
    
21.           );返回对应的图层列表
    
22.           (Vla-Put-Layer obj
    
23.             (if (eq (strcase Lay) (strcase (car TgtLay)))
    
24.               (cadr TgtLay)
    
25.               (car TgtLay)
    
26.             )
    
27.           );图层对调
    
28.       )
    
29.     )
    
30.   )
    
31.   (princ "\n→图层已经对调") (princ)
    
32. )
    

;图层对调 by kucha - 202305<br /> (defun K:RevLay (OriLay / TGTLay SS i en obj Lay)<br />   (if (setq SS (ssget))<br />     (repeat (setq i (sslength SS)) <br />       (setq en  (ssname SS (setq i (1- i)))<br />             obj (vlax-ename->vla-object en)<br />             Lay (cdr (Assoc 8 (Entget en)))<br />       )<br />       (if <br />           (setq TgtLay (car <br />                         (vl-remove-if-not <br />                           '(lambda (x) <br />                               (or <br />                                 (eq (strcase Lay) (strcase (car x)))<br />                                 (eq (strcase Lay) (strcase (cadr x)))<br />                               )<br />                             )<br />                           OriLay<br />                         )<br />                       )<br />           );返回对应的图层列表<br />           (Vla-Put-Layer obj <br />             (if (eq (strcase Lay) (strcase (car TgtLay)))<br />               (cadr TgtLay)<br />               (car TgtLay)<br />             )<br />           );图层对调<br />       )<br />     )<br />   )<br />   (princ "\n→图层已经对调") (princ)<br /> )<br />

1. ;用法:
   
2. (K:RevLay '(("A" "B") ("C" "D") ("E" "F")))
   

;用法:<br /> (K:RevLay '(("A" "B") ("C" "D") ("E" "F")))<br />

VBALISPER

把图层名对调是否可行。

moshouhot

代码不错，参考写了个转移图层的命令。

2. (defun K:MoveEntitiesToLayer (srcLayer tgtLayer)
   
3.   (setq ss (ssget "_X" (list (cons 8 (strcase srcLayer)))))
   
4.   (if (and ss (> (sslength ss) 0))
   
5.     (progn
   
6.       (sssetfirst nil ss)
   
7.       (while (setq en (ssname ss 0))
   
8.         (setq obj (vlax-ename->vla-object en))
   
9.         (vla-put-layer obj tgtLayer)
   
10.         (ssdel en ss)
    
11.       )
    
12.       (princ (strcat "Entities on " srcLayer " layer moved to " tgtLayer " layer."))
    
13.     )
    
14.     (princ (strcat "No entities found on " srcLayer " layer or source layer does not exist."))
    
15.   )
    
16.   (princ)
    
17. )
    

(defun K:MoveEntitiesToLayer (srcLayer tgtLayer)<br />   (setq ss (ssget "_X" (list (cons 8 (strcase srcLayer)))))<br />   (if (and ss (> (sslength ss) 0))<br />     (progn<br />       (sssetfirst nil ss)<br />       (while (setq en (ssname ss 0))<br />         (setq obj (vlax-ename->vla-object en))<br />         (vla-put-layer obj tgtLayer)<br />         (ssdel en ss)<br />       )<br />       (princ (strcat "Entities on " srcLayer " layer moved to " tgtLayer " layer."))<br />     )<br />     (princ (strcat "No entities found on " srcLayer " layer or source layer does not exist."))<br />   )<br />   (princ)<br /> )<br />

2. (defun K:MoveObjToLayer (srcLayer tgtLayer objName)
   
3.   (setq srcLayer (strcase srcLayer) tgtLayer (strcase tgtLayer))
   
4.   (setq ss (ssget "_X" (list (cons 8 srcLayer) (cons 0 objName))))
   
5.   (if (and ss (> (sslength ss) 0))
   
6.     (progn
   
7.       (sssetfirst nil ss)
   
8.       (while (setq en (ssname ss 0))
   
9.         (setq obj (vlax-ename->vla-object en))
   
10.         (vla-put-layer obj tgtLayer)
    
11.         (ssdel en ss)
    
12.       )
    
13.       (sssetfirst nil ss) ; 取消选择集
    
14.       (princ (strcat "Entities on " srcLayer " layer with object type " objName " moved to " tgtLayer " layer."))
    
15.     )
    
16.     (princ (strcat "No entities found on " srcLayer " layer with object type " objName " or source layer does not exist."))
    
17.   )
    
18.   (princ)
    
19. )

(defun K:MoveObjToLayer (srcLayer tgtLayer objName)<br />   (setq srcLayer (strcase srcLayer) tgtLayer (strcase tgtLayer))<br />   (setq ss (ssget "_X" (list (cons 8 srcLayer) (cons 0 objName))))<br />   (if (and ss (> (sslength ss) 0))<br />     (progn<br />       (sssetfirst nil ss)<br />       (while (setq en (ssname ss 0))<br />         (setq obj (vlax-ename->vla-object en))<br />         (vla-put-layer obj tgtLayer)<br />         (ssdel en ss)<br />       )<br />       (sssetfirst nil ss) ; 取消选择集<br />       (princ (strcat "Entities on " srcLayer " layer with object type " objName " moved to " tgtLayer " layer."))<br />     )<br />     (princ (strcat "No entities found on " srcLayer " layer with object type " objName " or source layer does not exist."))<br />   )<br />   (princ)<br /> )

magicheno

感谢大佬分享