rwsice9 发表于 2022-7-6 06:37:52

LISP从块中抓取层

嘿，伙计们。我今天早上写了一个LISP，它要求插入点，抓取对象的层，然后在相关层上绘制多重引线。我让它完全工作，除非选择了块。有人能看一下代码并提供帮助吗？提前感谢！
 
(defun c:wtags (/ p1 )
(setq oldlayer (getvar "clayer"))
(setq os (getvar "osmode"))
(setvar "osmode" 531)
(setq p1 (getpoint "\nSelect wire to tag: "))
(setq ent (entget (car (nentselp p1))))
(setq wlayer (cdr (assoc 8 ent)))
(if (= wlayer "F-ALRM-WIRE")(setvar "clayer" "F-ANNO-TAGS"))
(if (= wlayer "F-ALRM-WIRE-SPKR")(setvar "clayer" "F-ANNO-TAGS-SPKR"))
(if (= wlayer "F-ALRM-WIRE-INDC")(setvar "clayer" "F-ANNO-TAGS-INDC"))
(if (= wlayer "F-ALRM-WIRE-DTCT")(setvar "clayer" "F-ANNO-TAGS-DTCT"))
(if (= wlayer "F-ALRM-WIRE-PWR")(setvar "clayer" "F-ANNO-TAGS-PWR"))
(if (= wlayer "F-ALRM-WIRE")(SETQ TAG ""))
(if (= wlayer "F-ALRM-WIRE-SPKR")(SETQ TAG "S"))
(if (= wlayer "F-ALRM-WIRE-INDC")(SETQ TAG "V"))
(if (= wlayer "F-ALRM-WIRE-DTCT")(SETQ TAG "M"))
(if (= wlayer "F-ALRM-WIRE-PWR")(SETQ TAG "P"))
(command "_MLeader" p1 pause tag)
(setvar "osmode" os)
(setvar "clayer" oldlayer)
)

Lee Mac 发表于 2022-7-6 06:44:32

请尝试以下rwsice9：
(defun c:wtags ( / *error* la pt ss vl vr wl )

   (defun *error* ( msg )
       (mapcar 'setvar vr vl)
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
         (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (setq vr '(clayer osmode cmdecho)
         vl(mapcar 'getvar vr)
   )
   (setvar 'osmode 531)
   (setvar 'cmdecho 0)
   (if (setq pt (getpoint "\nSelect Wire to Tag: "))
       (if (setq ss (ssget pt))
         (if (wcmatch (setq wl (strcase (cdr (assoc 8 (entget (ssname ss 0)))))) "F-ALRM-WIRE*")
               (progn
                   (setq wl (substr wl 12)
                         la (strcat "F-ANNO-TAGS" wl)
                   )
                   (if (tblsearch "LAYER" la)
                     (command "_.-layer" "_U" la "_T" la "_ON" la "_S" la "")
                     (command "_.-layer" "_M" la "")
                   )
                   (command "_.mleader" "_non" pt "\\"
                     (cond
                           (   (= wl "-SPKR") "S")
                           (   (= wl "-INDC") "V")
                           (   (= wl "-DTCT") "M")
                           (   (= wl "-PWR")"P")
                           (   ""   )
                     )
                   )
               )
               (princ "\nObject not on \"F-ALRM-WIRE*\" layer.")                     
         )
         (princ "\nNo Object found at selected point.")
       )
   )
   (*error* nil)
   (princ)
)

rwsice9 发表于 2022-7-6 06:47:08

谢谢李！就设置正确的图层而言，效果很好，但它现在不想填充文本。我非常感谢你的帮助！

Lee Mac 发表于 2022-7-6 06:52:15

 
哎呀！对不起，我忘记了每个图层名图案上的连字符。现在，我已经更正了上述代码，并使用了一个cond表达式来代替关联列表，以确保安全，如果列表中没有出现层名称模式。

rwsice9 发表于 2022-7-6 06:55:25

令人惊叹的非常感谢你！

Lee Mac 发表于 2022-7-6 07:01:07

不客气！
询问您是否对代码有任何问题。

rwsice9 发表于 2022-7-6 07:05:43

我想我至少了解代码在做什么，但不足以在没有帮助的情况下独自修改。（我想）我还有最后一个问题要问你。当选定的对象位于F-ALRM-WIRE图层上时，是否有方法提示输入多重引线值？虽然大多数层都有预设标记，但通用F-ALRM-WIRE层没有。当前代码只是在空白的多重引线中绘制。（别误会，你编写的代码太棒了）

Lee Mac 发表于 2022-7-6 07:10:47

 
当然，试试这个：
(defun c:wtags ( / *error* la pt ss vl vr wl )

   (defun *error* ( msg )
       (mapcar 'setvar vr vl)
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
         (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (setq vr '(clayer osmode cmdecho)
         vl(mapcar 'getvar vr)
   )
   (setvar 'osmode 531)
   (setvar 'cmdecho 0)
   (if (setq pt (getpoint "\nSelect Wire to Tag: "))
       (if (setq ss (ssget pt))
         (if (wcmatch (setq wl (strcase (cdr (assoc 8 (entget (ssname ss 0)))))) "F-ALRM-WIRE*")
               (progn
                   (setq wl (substr wl 12)
                         la (strcat "F-ANNO-TAGS" wl)
                   )
                   (if (tblsearch "LAYER" la)
                     (command "_.-layer" "_U" la "_T" la "_ON" la "_S" la "")
                     (command "_.-layer" "_M" la "")
                   )
                   (command "_.mleader" "_non" pt "\\")
                   (cond
                     (   (= wl "-SPKR") (command "S"))
                     (   (= wl "-INDC") (command "V"))
                     (   (= wl "-DTCT") (command "M"))
                     (   (= wl "-PWR")(command "P"))
                     (   (command "" "_.ddedit" (entlast) ""))
                   )
               )
               (princ "\nObject not on \"F-ALRM-WIRE*\" layer.")                     
         )
         (princ "\nNo Object found at selected point.")
       )
   )
   (*error* nil)
   (princ)
)

rwsice9 发表于 2022-7-6 07:14:36

我可能应该能够弄清楚这个。。现在我明白了，这似乎是显而易见的解决方案。再次感谢，伙计。工作绝对完美！

rwsice9 发表于 2022-7-6 07:18:06

它甚至可以在F-ALRM-WIRE-CTRL层上运行！这根本不在代码中！！令人惊叹的
页: [1] 2
查看完整版本: LISP从块中抓取层