检查和/或创建图层

waders · 发表于 2022-7-6 07:04:55

我正在寻找一些关于如何改善这一习惯的帮助或建议。它按原样工作，但我认为这不是做我想做的事情的最佳方式。

我们在图形中有一个称为“a-HIST”的图层，我们所做的是将该图层上的所有对象移动到一个称为“a-HIST-2012”的新图层。但如果这已经存在，我希望命令结束。如果没有，则创建层并将所有内容移动到其中。这项工作做得很好。如果“A-HIST”不存在，或者如果我在该层上没有任何对象，那么它就会失败。所以我简单地添加了一条线，并在最后删除它。有更好的方法吗。谢谢

copy


(defun C:layerhist2012 ()
 (vl-load-com)
 (setq layers
 (vla-get-layers
   (vla-get-activedocument
     (vlax-get-acad-object)
   )
 )
 )
 (if
   (not
     (vl-catch-all-error-p
(setq mylayer
       (vl-catch-all-apply
  'vla-item
  (list layers "A-HIST-2012")
       )
)
     )
   )
    (princ "\nLayer A-HIST-2012 was found!")
    (c:layerhist)
 )
 (princ)
)
(defun c:layerhist ()
 (command "-layer" "make" "A-HIST-2012" "ltype" "PHANTOM" "" "")
 (vl-load-com)
 (setq layers
 (vla-get-layers
   (vla-get-activedocument
     (vlax-get-acad-object)
   )
 )
 )
 (if
   (not
     (vl-catch-all-error-p
(setq mylayer
       (vl-catch-all-apply
  'vla-item
  (list layers "A-HIST")
       )
)
     )
   )
    (princ "\nLayer A-HIST was found!")
    (c:changehist)
 )
 (princ)
)
(defun c:changehist ()
 (command "-layer" "make" "A-HIST" "ltype" "PHANTOM" "" "")
 (command "line" "0,0" "1,1" "")
 (setq $blk (ssget "x" '((8 . "A-HIST"))))
 (command "change" $blk "" "Properties" "layer" "A-HIST-2012" "")
 (command "erase" "last" "")
 (princ)
 )
(defun c:HIST2012 ()
 (setq echo$ (getvar 'cmdecho))
 (setvar "cmdecho" 0)
 (setq CLayer$ (getvar "clayer"))
 (setq $tilemode (getvar "tilemode"))
 (command "tilemode" "1")
 (c:layerhist2012)
 (setvar "clayer" CLayer$)
 (command "-layer" "freeze" "a-hist-2012,a-hist" "")
 (setvar "tilemode" $tilemode)
 (setvar "cmdecho" echo$)
 (princ)
 )

hmsilva · 发表于 2022-7-6 07:15:30

只是一种不同的方法

copy


(defun c:test ()
 (if (tblsearch "LAYER" "A-HIST")
   (command "._-rename" "la" "A-HIST" "A-HIST-2012")
 )
 (princ)
)

亨里克

Tharwat · 发表于 2022-7-6 07:21:47

Henrique您必须检查新层名称是否也不存在。

hmsilva · 发表于 2022-7-6 07:30:55

哎呀。。。我的错

copy


(defun c:test ()
 (if (and (tblsearch "LAYER" "A-HIST")
   (not (tblsearch "LAYER" "A-HIST-2012"))
     )
   (command "._-rename" "la" "A-HIST" "A-HIST-2012")
   (prompt "\nLayer A-HIST-2012 already exists! ")
 )
 (princ)
)

亨里克

BlackBox · 发表于 2022-7-6 07:42:16

稍微不同的适应：

copy


(vl-load-com)
(defun c:FOO (/ newName oldName)
 (if (tblsearch "layer" (setq newName "A-HIST-2012"))
   (prompt "\n** Layer "A-HIST-2012" already exists ** ")
   (if (tblsearch "layer" (setq oldName "A-HIST"))
     (vla-put-name
       (vla-item (vla-get-layers
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
                 oldName
       )
       newName
     )
   )
 )
 (princ)
)