kucha007 发表于 2023-5-4 23:57:56

【K:RevLay】图层对调

本帖最后由 kucha007 于 2023-5-5 00:21 编辑

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

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



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


VBALISPER 发表于 2023-5-6 16:45:32

把图层名对调是否可行。

moshouhot 发表于 2023-5-24 11:36:29

本帖最后由 moshouhot 于 2023-5-24 16:22 编辑

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

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

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

magicheno 发表于 2023-5-31 19:59:41

感谢大佬分享
页: [1]
查看完整版本: 【K:RevLay】图层对调