社区 › Auto Lisp › LISP从块中抓取层

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

 
 
好极了伙计
干杯

rwsice9 发表于 2022-7-6 07:26:17

好了，现在我们已经把这一切都做好了，公司已经改变了主意，关于MLEADER应该在哪一层。现在他们希望它们位于任何一个导线层上。我修改了您编写的代码来实现这一点，但是这又产生了另一个问题。两个导线层不是“连续”线型。如何在代码中添加线型替代以强制使用连续线型绘制所有引线？
 
再次感谢您的帮助！
(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-ALRM-WIRE" 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 "-POWR")(command "P"))
                (   (= wl "-CTRL")(command "R"))
                     (   (command "" "_.ddedit" (entlast) ""))
                   )
               )
               (princ "\nObject not on \"F-ALRM-WIRE*\" layer.")                     
         )
         (princ "\nNo Object found at selected point.")
       )
   )
   (*error* nil)
   (princ)
)

Lee Mac 发表于 2022-7-6 07:31:45

试试这个：
(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-ALRM-WIRE" wl)
                   )
                   (if (tblsearch "LAYER" la)
                     (command "_.-layer" "_U" la "_T" la "_ON" la "_L" "Continuous" la "_S" la "")
                     (command "_.-layer" "_M" la "_L" "Continuous" la "")
                   )
                   (command "_.mleader" "_non" pt "\\")
                   (cond
                     (   (= wl "-SPKR") (command "S"))
                     (   (= wl "-INDC") (command "V"))
                     (   (= wl "-DTCT") (command "M"))
                     (   (= wl "-POWR") (command "P"))
                     (   (= wl "-CTRL") (command "R"))
                     (   (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:37:36

知道我刚刚意识到什么吗？我所需要做的就是修改多重引线样式，使线型连续。。哼！
 
再次感谢！

Lee Mac 发表于 2022-7-6 07:40:51

别担心！

查看完整版本: LISP从块中抓取层