Jump to content

LISP to Grab Layer from a block

rwsice9

By rwsice9
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

rwsice9 Contributor

rwsice9

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

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
rwsice9 Contributor

rwsice9

Posted
  • Author
Posted

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!

Lee Mac Grand Master

Lee Mac

Posted
Posted
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.

Lee Mac Grand Master

Lee Mac

Posted
Posted

You're very welcome!

Ask if you have any questions about the code.

rwsice9 Contributor

rwsice9

Posted
  • Author
Posted

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

Lee Mac Grand Master

Lee Mac

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

rwsice9 Contributor

rwsice9

Posted
  • Author
Posted
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!

rwsice9 Contributor

rwsice9

Posted
  • Author
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted
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!

rwsice9 Contributor

rwsice9

Posted
  • Author
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

rwsice9 Contributor

rwsice9

Posted
  • Author
Posted

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

 

Thanks again!

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.

×
 Share
Go to topic listing
×
×
  • Create New...