[编程交流] 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)
 )

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

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