Jump to content

LISP to Grab Layer from a block


rwsice9

Recommended Posts

Hey guys. I have a LISP I wrote this morning that asks for an insertion point, grabs the layer of the object, then draws a MLEADER on an associated layer. I have it working completely, except when a block is selected. Can anyone take a look at the code and help out? Thanks in advance!

 

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

Link to comment
Share on other sites

Try something like this 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)
)

Edited by Lee Mac
Link to comment
Share on other sites

Thanks Lee! Works perfect as far as setting the correct layers, but it doesn't want to fill in the text now. I do appreciate the help!

Link to comment
Share on other sites

Thanks Lee! Works perfect as far as setting the correct layers, but it doesn't want to fill in the text now. I do appreciate the help!

 

Oops! Sorry, I forgot the hyphen on each of the layer name patterns. I have now corrected the above code, and have used a cond expression in place of an association list for safety, should the layer name pattern not appear in the list.

Link to comment
Share on other sites

I think I sort of at least understand what the code is doing, but not enough to modify on my own with no help. I do have one last question for you (I think). Is there a way to have it prompt for an MLEADER value when the object selected is on the F-ALRM-WIRE layer? While most of the layers have pre-set tags, the general F-ALRM-WIRE layer does not. The current code just draws in the blank mleader. (dont get me wrong, the code you whipped up is awesome :) )

Link to comment
Share on other sites

I do have one last question for you (I think). Is there a way to have it prompt for an MLEADER value when the object selected is on the F-ALRM-WIRE layer?

 

Sure, try this:

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

Link to comment
Share on other sites

Sure, try this:

                       (   (command "" "_.ddedit" (entlast) ""))
                 

I probably should have been able to figure that one out.. Now that I see it it seems like the obvious solution. :oops: Thanks again, man. Works absolutely perfectly!

Link to comment
Share on other sites

I probably should have been able to figure that one out.. Now that I see it it seems like the obvious solution. :oops: Thanks again, man. Works absolutely perfectly!

 

And it even worked on the F-ALRM-WIRE-CTRL layer! That's not even in the code at all!! Awesome!

 

Excellent to hear dude :thumbsup:

Cheers!

Link to comment
Share on other sites

Well, now that we have this all working properly, the company has changed their mind about what layer the mleaders should be on. Now they want them to be on whichever WIRE layer. I modified the code you wrote to do that, however this has created another issue. A couple of the wire layers are not a "continuous" linetype. How can I add a linetype override in the code to force all the leaders to be drawn with the continuous linetype?

 

Once again, thank you very much for all the help! :D

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

Link to comment
Share on other sites

Try this:

(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 [color=red]"_L" "Continuous" la[/color] "_S" la "")
                       (command "_.-layer" "_M" la [color=red]"_L" "Continuous" la[/color] "")
                   )
                   (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)
)

Link to comment
Share on other sites

Know what I just realized? All I needed to do was modify the MLeader style to make the linetype continuous.. duh!

 

Thanks again!

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...