社区 › Auto Lisp › 检查和/或创建图层

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

检查和/或创建图层

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

(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

 
只是一种不同的方法
 
 

(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

哎呀。。。我的错
 
 

(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

稍微不同的适应：
 

(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)
)

Lee Mac 发表于 2022-7-6 07:49:23

你可能会发现这个有趣的帖子：
http://www.cadtutor.net/forum/showthread.php?65302&p=447101&viewfull=1#post447101

waders 发表于 2022-7-6 07:50:58

谢谢RenderMan，这很有效。

waders 发表于 2022-7-6 08:04:22

嘿，李，谢谢你给我那个帖子的链接。这是一个有趣的帖子。我把它保存起来以备将来参考。

Lee Mac 发表于 2022-7-6 08:11:38

 
不客气，我希望这能有所帮助。

查看完整版本: 检查和/或创建图层