请求完善自动合并图层程序

ddvcx

经常打开别的图纸，每次改图层很浪费时间，所以想用List自动处理
程序如下：
(defun c:mergelayers ( / lst)
        (setq lst '(
                ("*Door*" "A-Door")
                ("*门*" "A-Door")
        ))
          (foreach e lst (mergelayers (car e) (cadr e)))
        (princ)
)
(defun mergelayers (match to / lst def lay)
        (setq str "")
        (while (setq def (tblnext "LAYER" (null lay)))
                (if (wcmatch (setq lay (cdr (assoc 2 def))) match)
                        (setq lst (cons lay lst))))
        (if lst
                (progn
                        (command "_.LAYMRG")
                        (foreach e lst (command "_Name" e))
                        (command "" "_N" to "_Y")))
        (princ)
)
现在程序运行有几点问题，求大神指点
1、("*Door*" "A-Door")，*Door*会匹配到目标图层A-Door，而导致程序停止，有办法排除目标图层吗？
2、("*Door*" "A-Door")        ("*门*" "A-Door")有没有办法合并成("*Door*" "*门*" "A-Door")这样？
3、如果匹配到外部参照的图层也会导致程序停止，应该怎么规避？

xyp1964

ddvcx 发表于 2023-7-28 08:34
谢谢回复，这个参数变多之后还是会有目标图层被选择的问题，这是测试dwg：

strcase 误写成了 strcat，修改代码见7楼

ssyfeng

看看是不是这样





支持图层名称的表：'(("A-Door" "*Door*" "*门*" "后面可以添加") ("A-Window" "*Wind*" "*窗*" "后面可以添加"))

xyp1964

1. (defun c:tt (/ lst)
   
2.   (setq lst '(("*Door*" "*门*") "A-Door"))
   
3.   (mergelayers (car lst) (cadr lst))
   
4.   (princ)
   
5. )
   
6. (defun mergelayers (lst-match to / lst def la)
   
7.   (while (setq def (tblnext "LAYER" (null la)))
   
8.     (foreach a lst-match
   
9.       (if (wcmatch (setq la (cdr (assoc 2 def))) a)
   
10.         (setq lst (cons la lst))
    
11.       )
    
12.     )
    
13.   )
    
14.   (if (setq lst (vl-remove to lst))
    
15.     (progn
    
16.       (command "_.LAYMRG")
    
17.       (foreach e lst (command "_Name" e))
    
18.       (command "" "_N" to "_Y")
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )
    

(defun c:tt (/ lst)<br />   (setq lst '(("*Door*" "*门*") "A-Door"))<br />   (mergelayers (car lst) (cadr lst))<br />   (princ)<br /> )<br /> (defun mergelayers (lst-match to / lst def la)<br />   (while (setq def (tblnext "LAYER" (null la)))<br />     (foreach a lst-match<br />       (if (wcmatch (setq la (cdr (assoc 2 def))) a)<br />         (setq lst (cons la lst))<br />       )<br />     )<br />   )<br />   (if (setq lst (vl-remove to lst))<br />     (progn<br />       (command "_.LAYMRG")<br />       (foreach e lst (command "_Name" e))<br />       (command "" "_N" to "_Y")<br />     )<br />   )<br />   (princ)<br /> )<br />

ddvcx

xyp1964 发表于 2023-7-25 22:18

多谢大佬，完美运行

ddvcx

xyp1964 发表于 2023-7-25 22:18

再请教下，这段代码
(("*Door*" "*门*") "A-Door")
怎么再增加
(("*Wind*" "*窗*") "A-Window")

ddvcx

xyp1964 发表于 2023-7-25 22:18

另外，如果重复运行命令的时候还是会匹配到目标图层，然后报错：

图层名无效。
选定的图层: A-Door。
*无效选择*
需要点或上一个(L)/名称(N)
; 错误: 函数已取消

怎样才能排除目标图层呢

xyp1964

ddvcx 发表于 2023-7-27 16:02
另外，如果重复运行命令的时候还是会匹配到目标图层，然后报错：

图层名无效。

1. (defun c:tt (/ lst)
   
2.   (setq        lst '((("*Door*" "*门*") "A-Door")
   
3.               (("*Wind*" "*窗*") "A-Window")
   
4.              )
   
5.   )
   
6.   (foreach a lst (Ulaymrg (car a) (cadr a)))
   
7.   (princ)
   
8. )
   
9. (defun Ulaymrg (lst-match to / lst def la)
   
10.   (while (setq def (tblnext "LAYER" (null la)))
    
11.     (foreach a lst-match
    
12.       (if (wcmatch (setq la (strcase (cdr (assoc 2 def)))) (strcase a))
    
13.         (setq lst (cons la lst))
    
14.       )
    
15.     )
    
16.   )
    
17.   (if (setq lst (vl-remove (strcase to) lst))
    
18.     (progn
    
19.       (command "_.LAYMRG")
    
20.       (foreach e lst (command "_Name" e))
    
21.       (command "" "_N" to "_Y")
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

(defun c:tt (/ lst)<br />   (setq        lst '((("*Door*" "*门*") "A-Door")<br />               (("*Wind*" "*窗*") "A-Window")<br />              )<br />   )<br />   (foreach a lst (Ulaymrg (car a) (cadr a)))<br />   (princ)<br /> )<br /> (defun Ulaymrg (lst-match to / lst def la)<br />   (while (setq def (tblnext "LAYER" (null la)))<br />     (foreach a lst-match<br />       (if (wcmatch (setq la (strcase (cdr (assoc 2 def)))) (strcase a))<br />         (setq lst (cons la lst))<br />       )<br />     )<br />   )<br />   (if (setq lst (vl-remove (strcase to) lst))<br />     (progn<br />       (command "_.LAYMRG")<br />       (foreach e lst (command "_Name" e))<br />       (command "" "_N" to "_Y")<br />     )<br />   )<br />   (princ)<br /> )

ddvcx

ssyfeng 发表于 2023-7-27 17:44
看看是不是这样

谢谢回复，这个参数变多之后还是会有目标图层被选择的问题，这是测试dwg：


命令: TT
选定的图层: DOOR。
******** 警告 ********
将要把图层“DOOR”合并到图层“A-Door”中。
删除图层“DOOR”。
已删除 1 个图层。
选定的图层: A-WINDOW。
选定的图层: A-WINDOW,WINDOW_TEXT。
选定的图层: A-WINDOW,WINDOW_TEXT,WINDOW。
无法将图层与其自身合并。图层 A-WINDOW 已选定。
*无效选择*
需要点或上一个(L)/名称(N)]:
; 错误: 函数已取消

(defun c:tt (/ lay0 lst mergelayers)
        (defun mergelayers (match to / lst def lay)
                (while (setq def (tblnext "LAYER" (null lay)))
                        (if (wcmatch (setq lay (cdr (assoc 2 def))) match)
                                (setq lst (cons lay lst))
                        )
                )
                (setq lst (vl-remove to lst))
                (if lst
                        (progn
                                (if (null (tblsearch "LAYER" to)) (command "-layer" "n" to ""))
                                (command "_.LAYMRG")
                                (foreach e lst (command "_Name" e))
                                (command "" "_N" to "_Y")
                        )
                )
                (princ)
        )
        ;;;--------------------------------------
        (setvar "CMDECHO" 0)
        (vl-cmdf "_.undo" "be")
        (setq lay0 (getvar "CLAYER"))
        (setvar "CLAYER" "0")
        (setq lst '(
                                                         ("A-Door" "*Door*" "*DOOR*" "*门*")
                                                         ("A-Window" "*Wind*" "*WIND*" "*窗*")
                                                         ("A-Stair" "*Stai*" "*STAI*" "*梯*")
                                                 )
        )
        (foreach e lst (foreach a (cdr e) (mergelayers a (car e))))
        (if (tblsearch "LAYER" lay0) (setvar "CLAYER" lay0))
        (vl-cmdf "_.undo" "e")
        (princ)
)

ddvcx

xyp1964 发表于 2023-7-27 18:33

谢谢回复，这个参数变多之后还是会有目标图层被选择的问题，这是测试dwg：



命令: TT
_.LAYMRG
选择要合并的图层上的对象或 [命名(N)]: _Name
输入图层名称或 [?]: DOOR
选定的图层: DOOR。
选择要合并的图层上的对象或 [名称(N)/放弃(U)]:
选择目标图层上的对象或 [名称(N)]: _N
输入图层名称或 [?]: A-Door
******** 警告 ********
将要把图层“DOOR”合并到图层“A-Door”中。
是否继续？ [是(Y)/否(N)] <否(N)>: _Y
删除图层“DOOR”。
已删除 1 个图层。
命令: _.LAYMRG
选择要合并的图层上的对象或 [命名(N)]: _Name
输入图层名称或 [?]: A-WINDOW
选定的图层: A-WINDOW。
选择要合并的图层上的对象或 [名称(N)/放弃(U)]: _Name
输入图层名称或 [?]: WINDOW_TEXT
选定的图层: A-WINDOW,WINDOW_TEXT。
选择要合并的图层上的对象或 [名称(N)/放弃(U)]: _Name
输入图层名称或 [?]: WINDOW
选定的图层: A-WINDOW,WINDOW_TEXT,WINDOW。
选择要合并的图层上的对象或 [名称(N)/放弃(U)]:
选择目标图层上的对象或 [名称(N)]: _N
输入图层名称或 [?]: A-Window
无法将图层与其自身合并。图层 A-WINDOW 已选定。
选择目标图层上的对象或 [名称(N)]: _Y
*无效选择*
需要点或上一个(L)/名称(N)]:
; 错误: 函数已取消
选择目标图层上的对象或 [名称(N)]: *取消*




(defun c:tt (/ lst)
  (setq        lst '((("*Door*" "*DOOR*" "*门*") "A-Door")
              (("*Wind*" "*WIND*" "*窗*") "A-Window")
              (("*Stair*" "*STAI*" "*梯*") "A-Stair")
             )
  )
  (foreach a lst (Ulaymrg (car a) (cadr a)))
  (princ)
)
(defun Ulaymrg (lst-match to / lst def la)
  (while (setq def (tblnext "LAYER" (null la)))
    (foreach a lst-match
      (if (wcmatch (setq la (strcat (cdr (assoc 2 def)))) (strcat a))
        (setq lst (cons la lst))
      )
    )
  )
  (if (setq lst (vl-remove (strcat to) lst))
    (progn
      (command "_.LAYMRG")
      (foreach e lst (command "_Name" e))
      (command "" "_N" to "_Y")
    )
  )
  (princ)
)

ssyfeng

ddvcx 发表于 2023-7-28 08:28
谢谢回复，这个参数变多之后还是会有目标图层被选择的问题，这是测试dwg：

再试试这个：
(defun c:tt (/ lay0 lst mergelayers)
        (defun mergelayers (match to / lst def lay)
                (while (setq def (tblnext "LAYER" (null lay)))
                        (if (wcmatch (setq lay (cdr (assoc 2 def))) match)
                                (setq lst (cons (strcase lay) lst))
                        )
                )
                (setq lst (vl-remove (strcase to) lst))
                (if lst
                        (progn
                                (if (null (tblsearch "LAYER" to)) (command "-layer" "n" to ""))
                                (command "_.LAYMRG")
                                (foreach e lst (command "_Name" e))
                                (command "" "_N" to "_Y")
                        )
                )
                (princ)
        )
        ;;;--------------------------------------
        (setvar "CMDECHO" 0)
        (vl-cmdf "_.undo" "be")
        (setq lay0 (getvar "CLAYER"))
        (setvar "CLAYER" "0")
        (setq lst '(
                                                         ("A-Door" "*Door*" "*DOOR*" "*门*")
                                                         ("A-Window" "*Wind*" "*WIND*" "*窗*")
                                                         ("A-Stair" "*Stai*" "*STAI*" "*梯*")
                                                 )
        )
        (foreach e lst (foreach a (cdr e) (mergelayers a (car e))))
        (if (tblsearch "LAYER" lay0) (setvar "CLAYER" lay0))
        (vl-cmdf "_.undo" "e")
        (princ)
)