AutoCAD合並圖層命令laymrg
如果圖紙用參照方法導入圖元，圖層名稱會有$這樣的內容添加，會造成圖層很多的情況，如果把$後面名稱相同的圖層合並，手動的話就比較麻煩。
要合並相同後綴的圖層，可以使用程序來解決，autolisp代碼如下：
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;壹鍵所有圖層去除#及$前綴的命名;;;;
(defun c:tes ( / ss5)
(setvar "cmdecho" 0) (setvar "blipmode" 0) (if (null vlax-dump-object) (vl-load-com) ) (setq ss5 (x1812031));檢查圖層是否有凍結，鎖定或者關閉 (s1811301);修改圖層名稱 (if (car ss5) (x1812032 ss5) );還原圖層 (princ))
;取得所有圖層名稱
(defun w1810232 (doc / doc lay obj ss tc)
(setq lay (vla-get-layers doc) ss '()) (vlax-for obj lay (setq tc (vla-get-name obj));取得圖層名稱 (setq ss (cons (list tc obj) ss)) ) ss)
;修改圖層名稱
(defun s1811301 ( / doc n obj s2 ss1 ss2 ss3 ss4 ss5 tc1 tc2 x y)
(setq doc (vla-get-activedocument (vlax-get-acad-object));取得當前所有對象集合msp (vla-get-ModelSpace doc);取得模型空間
;ss1 (s1811302 doc msp);取得所有對象
ss2 (w1810232 doc);圖層集合
ss3 (mapcar 'strcase (mapcar 'car ss2));圖層名稱集合
;tc1 (getvar "clayer");取得當前圖層名稱
) ;(if (or (vl-string-search "\#" tc1 0) (vl-string-search "$" tc1 0)) (setvar "clayer" "0") );如果當前圖層需要修改，就轉換圖層為"0" (setvar "clayer" "0") (while (setq s2 (car ss2));處理圖層 (setq ss2 (cdr ss2) tc1 (car s2) tc2 tc1 obj (cadr s2)) (while (vl-string-search "\#" tc2 0) (setq tc2 (vl-string-subst "" "\#" tc2)));處理有#的圖層名稱 (while (setq n (vl-string-search "$" tc2 0)) (setq tc2 (substr tc2 (+ 2 n))));處理有$的圖層名稱 ;(while (setq n (vl-string-search "A-" tc2 0)) (setq tc2 (substr tc2 (+ 3 n))));處理有A-的名稱 (if (= tc2 "") (setq tc2 "0") );如果是空就修改圖層為"0" (if (/= tc2 tc1);如果名稱發生變化(progn;;1
(if (member (strcase tc2) ss3);2;如果已經有這個圖層名稱
?(progn;;2
? (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)));刪除這個圖層
(progn
(vl-catch-all-apply 'vl-cmdf (list "laymrg" "N" tc1 "" "N" tc2 "Y"))
;(Command "laymrg" "N" tc1 "" "N" tc2 "Y");如果圖層不能刪除就合並
)
? );if;4
?);progn;2-1
?(progn;;2-2
? (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list obj tc2))));如果沒有相同命名的圖層就改變圖層名稱
(setq ss3 (cons (strcase tc2) ss3))
? );if;3
?);progn;2-2
);if;2
);progn;1
);if;1 );while)
;還原圖層狀態
(defun x1812032 (ss / ss x y)
(setq ss (vl-remove-if '(lambda (x) (vlax-erased-p (cadr x))) ss));排除已經刪除的圖層 (mapcar '(lambda (y) (vla-put-lock y :vlax-true));鎖定 (mapcar 'cadr (vl-remove-if-not '(lambda (x) (= (car x) 1)) ss)) ) (mapcar '(lambda (y) (vla-put-Freeze y :vlax-true));凍結 (mapcar 'cadr (vl-remove-if-not '(lambda (x) (= (car x) 2)) ss)) ) (mapcar '(lambda (y) (vla-put-LayerOn y :vlax-false));關閉 (mapcar 'cadr (vl-remove-if-not '(lambda (x) (= (car x) 3)) ss)) ))
;;提取圖層狀態
(defun x1812031 ( / lay ss)
(setq ss '()) (vlax-for lay (vla-get-layers (vla-get-activedocument? (vlax-get-acad-object))) (if (= (vla-get-lock lay) :vlax-true);如果圖層鎖定(progn
(vla-put-lock lay :vlax-false) ;解鎖
(setq ss (cons (list 1 lay) ss))
)
) (if (= (vlax-get-property lay "Freeze") :vlax-true);凍結(progn
(vla-put-Freeze lay :vlax-False);解凍
(setq ss (cons (list 2 lay) ss))
)
) (if (= (vlax-get-property lay "LayerOn") :vlax-false);關閉(progn
(vla-put-LayerOn lay :vlax-true);打開
(setq ss (cons (list 3 lay) ss))
)
) ) ss)
;;;;;;;;;;;;;;;;;;;;;;程序結束;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;復制以上代碼，粘貼到記事本，以.lsp為後綴命名，在CAD裏面，appload命令添加到啟動組，輸入命令TES，就可以壹鍵合並圖層，TES命令可以自己修改。