Jump to content

Need lisp for layer prompt before object creation


neeboy

Recommended Posts

A jolly hello to all:

 

I'm getting annoyed with myself; sometimes I forget to change my current layer setting, and end up placing drawing elements on incorrect layers. SO....I want to have a LISP that forces me to enter a layer name whenever I use (for example) the LINE command; I would start the command, then ACAD would bring up a prompt that asks me for a layer name. (i don't plan on physically entering the layer name everytime, I have a small programmable keyboard I will set up for entering layer names with one-button-push). This whole thing may sound silly, but I've only got about 6 layers to work with so it's not as laborious it may sound. Can someone help me out here? Thanks!

Link to comment
Share on other sites

You could do it a number of ways the simplest way is to search here for "copy command" it allows you to pick an existing object and make a new one the same but with all the objects colour layer etc.

 

Alternatively if you want a line on a layer and only have 6 layers then a series of defuns would be the easiest L1 L2 etc C1 C2

 

(defun C:L1 () (setvar "clayer" "layer1")(command "line"))

(defun C:C1 () (setvar "clayer" "layer1")(command "Circle"))

 

Or make a toolbar or menu with ^c^c(setvar "clayer" "layer1") line

Link to comment
Share on other sites

Thanks for your contribution; I think I will certainly make use of it for other things, but I'd also like to know how to do what I originally posted, which was to invoke the command (like LINE) and then ask the user for the name of the layer. The act of the program asking me for input will help "jar me" into making the correct decision.

Link to comment
Share on other sites

Either redefine the line command or use a command reactor.

 

I personally use a command reactor for commands such as MVIEW, and XATTACH, etc., which also changes the layer back, once the command has ended (or is canceled). (Thanks to Alan's suggestion!)

Link to comment
Share on other sites

Either redefine the line command or use a command reactor.

 

Would you please tell me what is the meaning of command reactor ?

 

My regards.

Link to comment
Share on other sites

Yep, I'd also go the reactor route. Basically I'd have an associated list of command names, together with the layers allowed for them. E.g.

('("LINE" "A-Wall" "A-Grid" "A-Door") ("MTEXT,TEXT" "A-Text" "A-Notes"))

Notice multiple command names separated by commas or even wildcards if you want, else you'll need duplicates for each command with the same layer list. Then I have a modified assoc function:

(defun assocwc (code lst / found)
 (while (and lst (not found))
   (if (wcmatch code (caar lst)
     (setq found (car lst))
     (setq lst (cdr lst))
   )
 )
 found
)

Then you will have a few vlr-command-reactors (see the developer help). The one for :vlr-CommandWillStart call-back contains most of your code. It'll check the passed command name using the assocwc function above to get hold of the item containing the allowed layer names. Then compare them using either member / vl-position with the CLayer sysvar. If not found it should set some global variable to the current value of CLayer. Then use a getstring function to ask the user to input the layer name (if there's more than one in the list - else just use the one as it's the only option), create it if it doesn't exist, then set clayer to that layer name.

 

All of the :vlr-CommandEnded :vlr-CommandCanceled and :vlr-CommandFailed callbacks can be the same function. All it needs to do is check if the global variable saved by the vlr-CommandWillStart callback has some value, then set the CLayer to that value and reset the global var to nil.

Link to comment
Share on other sites

All of the :vlr-CommandEnded :vlr-CommandCanceled and :vlr-CommandFailed callbacks can be the same function. All it needs to do is check if the global variable saved by the vlr-CommandWillStart callback has some value, then set the CLayer to that value and reset the global var to nil.

 

 

That is exactly what my command reactors/callbacks do. :wink:

Link to comment
Share on other sites

(defun C:PCOM ()
(setq e (car(entsel "Pick your command. "))
      e (entget e)
      lyr (cdr(assoc 8 e))
      lt (cdr(assoc 6 e))
      txts (cdr(assoc 7 e))
      blk (cdr(assoc 2 e))
      com (cdr(assoc 0 e)))
(command "layer" "s" lyr "")
(if (/= lt nil)
  (command "linetype" "s" lt "")
  (command "linetype" "s" "bylayer" ""))
(if (/= txts nil)
  (command "style" txts "" "" "" "" "" "" ""))
(if (= com "TEXT") (setq com "DTEXT"))
(if (= com "LWPOLYLINE") (setq com "PLINE"))
(if (= com "LINE") (setq com "LINE"))
(if (= com "CIRCLE") (setq com "CIRCLE"))
(if (= com "INSERT")((setq comm com)(setq com "INSERT")
  (command comm blk)))
(command com)
(prin1))

 

how about this one, I use it for example, writing pcom, then select the object, it is a line, it activates the line command in the layer the selected object was created, it also works for polylines, inserting blocks, drawing circles, writing texts, hope it'll help you.

Edited by rkmcswain
ADDED CODE TAGS AND DISABLED SMILIES
Link to comment
Share on other sites

At the command line type:

(command "undefine" "line")

Then type:

(defun c:LINE () (command "layer" "set" pause "" ".line"))

Does this do what you're looking for?

 

if you want to go back to the original LINE command, type this at the command line:

(command "redefine" "line")

Link to comment
Share on other sites

Well between his two similar threads (same question) he should have plenty of options. Now it's up to him to decide what suits his needs best unless he has another demand.

Link to comment
Share on other sites

That is exactly what my command reactors/callbacks do. :wink:
Actually it's not the "best" solution. The problem is it's not recommended to have input functions inside a reactor call-back. The reason being the reactor fires when a command starts, but then pauses until the user gives some input. It "shouldn't" give problems generally, but could cause hassles with things like scripts or command calls from other lisp functions.

 

Unfortunately there's no way of getting around the problem, since the OP wants to be able to select the layer from a list.

Link to comment
Share on other sites

Actually it's not the "best" solution. The problem is it's not recommended to have input functions inside a reactor call-back. The reason being the reactor fires when a command starts, but then pauses until the user gives some input. It "shouldn't" give problems generally, but could cause hassles with things like scripts or command calls from other lisp functions.

 

Unfortunately there's no way of getting around the problem, since the OP wants to be able to select the layer from a list.

 

 

I do not believe I suggested that using a command reactor is the "best" solution (at least not in this thread).

 

I meant my statement quite literally; to clarify...

 

All of the :vlr-CommandEnded :vlr-CommandCanceled and :vlr-CommandFailed callbacks can be the same function.

 

 

Depending on the specific command being called, the three reactors you specified have the same callback function (in my code).

 

All it needs to do is check if the global variable saved by the vlr-CommandWillStart callback has some value, then set the CLayer to that value and reset the global var to nil.

 

 

I use a global var with :vlr-CommandWillStart that stores the current layer prior to changing the layer to a predefined layer for the calling command (i.e., ._XREF command = XREF Layer). Once the command is complete (or canceled, etc.), my callback(s) restore the starting layer (via the global var), and reset said var to nil.

 

Edit:

Additionally, one could *potentially* use ActiveX to provide the user an option list, to select a layer, then set the layer accordingly... all without issuing a secondary command, no?

 

The issue there being how many layers can be used as options, certainly not all for a large layer list. Perhaps a custom DCL would tackle this? (I think that's overkill, but still).

Link to comment
Share on other sites

Here's what I use

 

;;--------------------=={ Layer Director }==------------------;;
;;                                                            ;;
;;  Uses a command reactor to automatically set the layer     ;;
;;  upon the user invoking certain commands.                  ;;
;;                                                            ;;
;;  Layer settings are stored in the list at the top of the   ;;
;;  program. The first entry in the list is the command on    ;;
;;  which the reactor will trigger, it may use wildcards.     ;;
;;  The second entry is the designated layer for the command  ;;
;;  entered, this layer will be created if non-existent.      ;;
;;  The third entry is the layer colour that will be used if  ;;
;;  the layer is to be created in the drawing.                ;;
;;                                                            ;;
;;  The Reactor is set to be enabled upon loading the program ;;
;;  it can furthermore be toggled on and off using by typing  ;;
;;  'LD' at the command line.                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:LD nil (LM:LayerDirector T))

(defun LM:LayerDirector ( msg )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq *LayerData*
  '(
    ("*TEXT"           "TEXT"       2)
    ("*DIM*,*QLEADER"  "DIMENSIONS" 2)
    ("*VPORT*"         "DEFPOINTS"  7)
    ("*EXECUTETOOL"    "4"          4)
   )
 )      

 (
   (lambda ( data callback1 callback2 / react )
     (if
       (setq react
         (vl-some
           (function
             (lambda ( reactor )
               (if (eq data (vlr-data reactor))
                 reactor
               )
             )
           )
           (cdar (vlr-reactors :vlr-command-reactor))
         )
       )
       (if (vlr-added-p react)
         (vlr-remove react)
         (vlr-add react)
       )
       (setq react
         (vlr-command-reactor data
           (list
             (cons :vlr-commandWillStart callback1)
             (cons :vlr-commandEnded     callback2)
             (cons :vlr-commandCancelled callback2)
           )
         )
       )
     )

     (if msg
       (if (and react (vlr-added-p react))
         (princ "\n<< Layer Director Enabled >>" )
         (princ "\n<< Layer Director Disabled >>")
       )
     )
   )

   "LayerDirector"
   'LayerDirectorSet
   'LayerDirectorReset
 )

 (princ)
)

(defun LM:MakeLayer ( name colour )
 (or (tblsearch "LAYER" name)
   (entmakex
     (list
       (cons 0   "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2   name)
       (cons 62  colour)
       (cons 70  0)
     )
   )
 )
)

(defun LayerDirectorSet ( reactor arguments / layerdetails layer )
 (vl-load-com)
 ;; © Lee Mac 2010

 (if
   (and
     (setq layerdetails
       (vl-some
         (function
           (lambda ( x )
             (if (wcmatch (strcase (car arguments)) (car x))
               (cdr x)
             )
           )
         )
         *LayerData*
       )
     )
     (LM:MakeLayer (setq layer (car layerdetails)) (cadr layerdetails))
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" layer)
           )
         )
       )
     )
   )
   (progn
     (setq *oldlayer* (getvar 'CLAYER))      
     (setvar 'CLAYER layer)
   )
 )

 (princ)
)

(defun LayerDirectorReset ( reactor arguments )
 (vl-load-com)
 ;; © Lee Mac 2010

 (if
   (and (not (wcmatch (strcase (car arguments)) "*UNDO")) *oldlayer*
     (tblsearch "LAYER" *oldlayer*)
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" *oldlayer*)
           )
         )
       )
     )
   )
   (progn
     (setvar 'CLAYER *oldlayer*)
     (setq *oldlayer* nil)
   )
 )
 
 (princ)
)

(princ)
(LM:LayerDirector nil)

Link to comment
Share on other sites

Sorry, I didn't mean to insinuate your method's wrong, also not to try and dissuade you (or anyone else) from using this particular method. I was just trying to show some places where it could cause things to break in this case. What I'm suggesting is that this reactor should not fire if a script / lisp / other customization has issued the command, otherwise it effectively introduces an extra prompt (at best) or a dialog (at worst) which would cause errors. I.e. it needs to at least check the CMDACTIVE sysvar for bit codes 4 (script) and 64 (ObjectARX), although the bit code 32 (AutoLisp) is not set when checking it from AutoLisp :shock:. This is where I'm a bit sceptical about this idea for the choice with multiple layers. So you would need something else to check, or you would need to disable the reactor manually through your other Lisp / VBA / whatever.

 

If there was only one layer per command, then it would not have this problem. As Lee's code is doing, and I'm suspecting yours as well. I wasn't referring to issuing a command from a reactor call-back (which is a nettle of a different sting due to possible infinite loops), and as Lee's code shows you need not do that - nor should you.

 

Something else you could do is open a non-modal dialog (either DotNet or OpenDCL) to show these layer options. Thus the command can continue without any further user / script / lisp input. It might be preferable in this case to have the dialog's action modify any new entities instead of simply setting the current layer though. I can see how one could truly go overboard with this.

 

The only other means of accomplishing this is to redefine the suspect commands as others have shown. Although then you definitely need your other lisp / script to use the . prefix when calling these commands. And you'd need to redefine each command you want to check - it could be automated by stepping through a list, generating the undefine call and defun into a string then use the read & eval functions to redefine the commands from that string.

 

Actually I should've said, there's NO "best" solution. All of them have problems, you need to decide which problems you can live with.

Link to comment
Share on other sites

I agree with you on many counts, and one day, I might be able to digest all of the knowledge you share. :beer:

 

A command reactor is great for a specific sequence (a given command always sets a specified layer current, etc.).

 

Instead, I might consider writing a set of commands (or macros?) that are indicative of the layer on which the line would be drawn, for example:

 

(defun c:LINE_LAYER1 ()
 (if (/= "Layer1" (getvar 'clayer))
   (setvar 'clayer "Layer1"))
 (command "._line"))

(defun c:L1 ()
 (c:LINE_LAYER1))

(defun c:CIRCLE_LAYER2 ()
 (if (/= "Layer2" (getvar 'clayer))
   (setvar 'clayer "Layer2"))
 (command "._circle"))

(defun c:C2 ()
 (c:CIRCLE_LAYER2))

 

 

Keyboard shortcuts are my preferred method, but I included 'full name' function for completeness.

 

** Note - Error checking not included.

 

Edit:

Perhaps something more elementary:

 

(defun c:MYLINE ()
 (command "._-layer" "_set" pause "")
 (command "._line"))

Link to comment
Share on other sites

That's probably the "safest" method. To make it easier to accomplish:

(vl-load-com)
(setq *cmdlayers* ; List of commands with layers
                   '(("LINE" "Layer1" "Layer2")
                     ("CIRCLE" "Layer2" "Layer3")
                    )
     *laysettings* ; List of layers with their settings
                   '(("Layer1" 1 "DASHED")
                     ("Layer2" 4 "Continuous")
                     ("Layer3" 7 "HIDDEN")
                    )
)

;;; Ensure a reference to the acad application
(or *acad* (setq *acad* (vlax-get-acad-object)))
;;; Ensure a reference to the active document
(or *ActiveDoc* (setq *ActiveDoc* (vla-get-ActiveDocument *acad*)))

;;; Function to ensure a linetype exists in the current DWG
(defun LoadLinetype (ltName / fn result)
 ;; Ensure a reference to the linetypes collection
 (or *LineTypes* (setq *LineTypes* (vla-get-LineTypes *ActiveDoc*)))
 (setq result T) ;Initialize result
 ;; Check if the linetype already exists
 (if (not (tblsearch "LTYPE" ltName))
   ;; If not
   (cond
     ;; Check for using Imperial measures
     ((and (= (getvar "MEASUREMENT") 0) (setq fn (findfile "ACAD.LIN")))
      (setq result (vl-catch-all-apply 'vla-Load (list *LineTypes* ltName fn)))
     )
     ;; Check for using Metric measures
     ((and (= (getvar "MEASUREMENT") 1) (setq fn (findfile "ACADISO.LIN")))
      (setq result (vl-catch-all-apply 'vla-Load (list *LineTypes* ltName fn)))
     )
   )
   (setq result nil) ; Set when linetype exists
 )
 ;; If there was an error
 (if (vl-catch-all-error-p result)
   (progn
     ;; Show it on the command line
     (print (vl-catch-all-error-message result))
     nil ;Return nil
   )
   (not result) ;Return true if no error / linetype already loaded, nil if file not found
 )
)

;;; Function to ensure a layer is created, on, thawed, unlocked & current
(defun CLayerChange (layName / layData lay)
 ;; Ensure  a reference to the layers collection
 (or *Layers* (setq *Layers* (vla-get-Layers *ActiveDoc*)))
 ;; Check if the layer already exists
 (if (setq lay (tblsearch "LAYER" layName))
   ;; Get its reference
   (setq lay (vla-Item *Layers* (cdr (assoc 2 lay))))
   ;; If the layer can't be created
   (if (not (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-Add (list *Layers* layName)))))
     ;; Else check if properites are stored
     (if (setq layData (assoc layName *laysettings*))
       ;; Change to these properties
       (progn
         (vla-put-Color lay (cadr layData)) ;Set the colour
         (if (LoadLinetype (caddr layData)) ;Ensure the line type exists
           (vla-put-Linetype lay (caddr layData)) ;Set the layer to it
         )
       )
     )
   )
 )
 ;; Check if the layer now exists
 (if lay
   (cond
     ;; Check if an error happened
     ((vl-catch-all-error-p lay)
      (print (vl-catch-all-error-message lay)) ;Show the reason
      nil
     )

     ;; Ensure it's turned on, unlocked, thawed & current
     ((= (type lay) 'VLA-object)
      (vla-put-LayerOn lay :vlax-true)
      (vla-put-Freeze lay :vlax-false)
      (vla-put-Lock lay :vlax-false)
      (setvar "CLAYER" (vla-get-Name lay))
      t
     )

     (t (print "There was an unknown error setting the layer.") nil)
   )
   (progn (print "There was an unknown error setting the layer.") nil)
 )
)

;;; Function to run a command after setting the required layer, then reset the layer back
(defun RunCmdLay (Cmd Lay / *error* OldLay)
 (defun *error* (msg)
   (if OldLay
     (setvar "CLAYER" OldLay)
   )
   (cond ((not msg)) ; normal exit, no error
         ((member msg '("Function cancelled" "quit / exit abort"))) ; escape
         ((princ (strcat "\nError: " msg)) ; display fatal error
          (cond (*debug* (vl-bt)))
         )
   )
   (princ)
 )
 (setq OldLay (getvar "CLAYER"))
 (CLayerChange Lay)
 (command Cmd)
 (while (> (getvar "CMDACTIVE") 0) (command pause))
 (*error* nil) ;Normal exit
)

;;; Function to generate layer particular commands
(defun MakeRunCmdLay (lst / item lay str)
 (foreach item lst
   (foreach lay (cdr item)
     (setq str (strcat "(defun C:"
                       (car item)
                       "_"
                       (vl-string-translate " ()" "___" lay)
                       " () (RunCmdLay \""
                       (car item)
                       "\" \""
                       lay
                       "\"))"
               )
     )
     (eval (read str))
   )
 )
)

;;; Setup the Command-Layer commands
(MakeRunCmdLay *cmdlayers*)

Now simply modify those 1st 2 lists for each command - unfortunately not with wildcard matching for the command names though. It creates a command for each command-layer combination.

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