Results 1 to 4 of 4

Thread: VLR_COMMAND.lsp

  1. #1
    Member
    Join Date
    2008-11
    Posts
    2
    Login to Give a bone
    0

    Default VLR_COMMAND.lsp

    I have been using the VLR_COMMAND.lsp by Peter Jamtgaard and really like this lisp routine. The only problem is that every time I open a new drawing file I have to run the ALON command before it will work. Is there a way to have this work without having to run the ALON every time?

    Thanks
    Craig

  2. #2
    Administrator rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,804
    Login to Give a bone
    0

    Default Re: VLR_COMMAND.lsp

    Quote Originally Posted by cmonnier View Post
    I have been using the VLR_COMMAND.lsp by Peter Jamtgaard and really like this lisp routine. The only problem is that every time I open a new drawing file I have to run the ALON command before it will work. Is there a way to have this work without having to run the ALON every time?

    Thanks
    Craig
    I'll take a stab without knowing anything about what this is or what it does.

    Simply put - if you want lisp code to execute when a drawing is loaded, first the code needs to be loaded. You can accomplish this be putting the code in one of the startup files that is itself auto loaded.
    This could be "acaddoc.lsp", or maybe "<menu>.mnl" (where <menu> is a menu that is being loaded).

    So let's say you want to use "acaddoc.lsp". Sometime *after* ALON is loaded, you just need to execute it like this:

    Code:
    ;;; sample
    
    ;;; load the ALON function into memory
    (defun C:ALON ()
     (do_some_stuff_for_function_ALON)
     (princ)
    )
    
    ;; now execute this command
    (C:ALON)
    ~~~~~~~~~~~~~

    Code:
    ;;; alternative method
    ;;; do not define ALON as a function, just let the code execute
    ;;; useful if you do not need to run ALON at some future 
    ;;; point in the drawing session
    
    ;;(defun C:ALON ()
     (do_some_stuff_for_function_ALON)
    ;; (princ)
    ;;)
    R.K. McSwain | CAD Panacea |

  3. #3
    Member
    Join Date
    2008-11
    Posts
    2
    Login to Give a bone
    0

    Default Re: VLR_COMMAND.lsp

    I tried the code above with no luck. Here is the lisp file I'm using.

    Code:
    ; Sets the correct layer for certain commands.
    ; VLR_COMMAND.lsp courtesy Peter Jamtgaard 2003
    
    ; Vlr Command is a function that will switch the active layer in a drawing.
    ; The reactor checks the command that is starting and if it recognizes it
    ; it will switch to a specified layer. If the layer doesn't exist it will
    ; create it with the color, linetype, and plottable setting provided.
    ; To load and run this program add the lines (load "vlr_command")(c:vlr_command)
    ; to your acaddoc.lsp or another autoloading lisp routine.
    
    ; CAB added error trap for layer creator
    ; added layer restore at command exit
    ;; added code to test loaded status
    ;; added code to turn reactors Off & back On again
    ;; added code for different layers per user or task
    ;; NOTE: set var *user* to use different layers per user
    ;; Fixed bug in end & cancel command layer reset
    
    (defun C:ALON ()
    (vl-load-com)
    ;; Load only once, if already loaded reactivate it if inactive
    (and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
    (and *vlr-CE (not (vlr-added-p *vlr-CE)) (vlr-add *vlr-CE))
    (and *vlr-CC (not (vlr-added-p *vlr-CC)) (vlr-add *vlr-CC))
    (or *vlr-CWS 
    (setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . StartCommand)))))
    (or *vlr-CE
    (setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))))
    (or *vlr-CC
    (setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))))
    (princ "\nLayer Reactor ON")
    (princ)
    )
    
    ;; Turn the reactors off
    (defun C:ALOFF ()
    (and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
    (and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
    (and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
    (princ "\nLayer Reactor OFF")
    (princ)
    )
    
    
    (defun StartCommand (CALL CALLBACK / COMLAYLST)
    
    ;; Examples of Command vs Layer 
    ;; List of corresponding command layerName color linetype plottable
    ;; NOTE command names must be in Upper Case
    ;; NOTE: set var *user* to use different layers per user
    
    (setq COMLAYLST (list
    (list "DIMANGULAR" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMALIGNED" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMBASELINE" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMCENTER" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMCONTINUE"	"S-DIM" 243 "continuous" :vlax-true)
    (list "DIMDIAMETER"	"S-DIM" 243 "continuous" :vlax-true)
    (list "DIMLINEAR" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMRADIUS" "S-DIM" 243 "continuous" :vlax-true)
    (list "QDIM" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIM" "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMARC"	 "S-DIM" 243 "continuous" :vlax-true)
    (list "DIMORDINATE" "S-DIM" 243 "continuous" :vlax-true)
    (list "BREAKLINE" "S-BREAKLINE" 1 "continuous" :vlax-true)
    (list "MLEADER" "S-TEXT" 2 "continuous" :vlax-true)
    (list "LEADER" "S-TEXT" 2 "continuous" :vlax-true)
    (list "QLEADER" "S-TEXT" 2 "continuous" :vlax-true)
    (list "DTEXT" "S-TEXT" 2 "continuous" :vlax-true)
    (list "MTEXT" "S-TEXT" 2 "continuous" :vlax-true)
    (list "TEXT" "S-TEXT" 2 "continuous" :vlax-true)
    (list "ARCTEXT" "S-TEXT" 2 "continuous" :vlax-true)
    (list "BHATCH" "S-HATCHING" 153 "continuous" :vlax-true)
    (list "HATCH" "S-HATCHING" 153 "continuous" :vlax-true)
    (list "-HATCH" "S-HATCHING" 153 "continuous" :vlax-true)
    ;(list "INSERT" "0" 7 "continuous" :vlax-true)
    ;(list "-INSERT" "0" 7 "continuous" :vlax-true)
    (list "REVCLOUD"	"S-REVISION" 3 "continuous" :vlax-true)
    ;(list "TABLE" "S-TABLE" 7 "continuous" :vlax-true)
    ;(list "LATERAL"	 "Lateral"	92 "Dashed2"	:vlax-true)
    ;(list "DIAGONAL"	"Diagonal"	 1 "continuous" :vlax-true)
    (list "MVIEW" "VPORT" 250 "continuous" :vlax-false)
    ;(list "_IMAGEATTACH" "0" 7 "continuous" :vlax-true)
    ;(list "IMAGEATTACH" "0" 7 "continuous" :vlax-true)
    (list "WIPEOUT" "DEFPOINTS" 7 "continuous" :vlax-false)
    (list "vports" "VPORT" 250 "continuous" :vlax-false)
    (list "-vports" "VPORT" 250 "continuous" :vlax-false)
    ; Add your own command layer lists here....
    )
    )
    
    ;; Find the Command
    (if (setq N (assoc (strcase (car CALLBACK)) COMLAYLST))
    (progn
    ;; save current layer, restore on exit of command
    (setq *Currentlayers* (cons (getvar "CLAYER") *Currentlayers*))
    ;; make or update layer, then make current
    (if (make_layers (cadr N) (caddr N) (cadddr N) (car (cddddr N)))
    (vla-put-activelayer
    (vla-get-activedocument (vlax-get-acad-object))
    (vlax-ename->vla-object (tblobjname "LAYER" (cadr N)))
    )
    )
    )
    ;; flag current layer so it is NOT restored on exit of command
    (setq *Currentlayers* (cons nil *Currentlayers*))
    )
    (princ)
    )
    
    
    ;; Make layers using activeX
    ;; return t if sucessful else nil
    (defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ fn result LtFname NewLay) 
    (or *DOC* (setq *DOC* (vla-get-activedocument (vlax-get-acad-object))))
    (setq LAYSOBJ (vla-get-layers *DOC*))
    (if (tblobjname "layer" LAY_NAM) ; layer exist
    (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
    (setq LAYOBJ (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    NewLay t)
    )
    ;;(setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
    (if (vl-catch-all-error-p LAYOBJ)
    (not (print (vl-catch-all-error-message LAYOBJ)))
    (progn
    (if (= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (progn ; can not change current layer so make something else current
    ;; what if "0" is frozen?
    ;; need to thaw it then restore old layer, and freeze if thawed.
    (setvar "clayer" "0")
    )
    )
    (vla-put-lock LAYOBJ :vlax-false)
    (vla-put-layeron LAYOBJ :vlax-true)
    (vla-put-freeze LAYOBJ :vlax-false)
    
    (if (or NewLay *LayUpdt*) ; ok to update layer color, plot, LineType
    ;; ****************************************************************
    (progn 
    (if (tblobjname "ltype" LTYPE)
    (vla-put-linetype LAYOBJ LTYPE)
    (progn
    (setq LTYPESOBJ (vla-get-linetypes *DOC*))
    (if (and LtFname (/= LtFname "")
    (setq fn (findfile LtFname)))
    (vl-catch-all-apply '(lambda ( ) (vla-load LTYPESOBJ LTYPE fn)
    (setq result t) ; true only if load susceded
    ))
    )
    (if (and (not result) 
    (setq fn (findfile (if (zerop (getvar "measurement")) "acad.lin" "acadiso.lin"))))
    (vl-catch-all-apply '(lambda ( ) (vla-load LTYPESOBJ LTYPE fn)
    (setq result t) ; true only if load susceded
    ))
    )
    (vlax-release-object LTYPESOBJ)
    (and result (vla-put-linetype LAYOBJ LTYPE))
    )
    )
    ;; ****************************************************************
    (vla-put-color LAYOBJ COLOR)
    (vla-put-plottable LAYOBJ PLOTL)
    )
    ) ; end if (or NewLay *LayUpdt*) 
    t
    )
    )
    )
    
    ;; Restore curent layer
    (defun endCommand (CALL CALLBACK)
    (if *Currentlayers*
    (if (car *Currentlayers*)
    (progn
    (vla-put-lock
    (vla-item
    (vla-get-layers
    (vla-get-activedocument (vlax-get-acad-object)))
    (car *Currentlayers*)
    )
    :vlax-false
    )
    (setvar "CLAYER" (car *Currentlayers*))
    )
    )
    )
    (setq *Currentlayers* (cdr *Currentlayers*))
    )
    
    
    ;; Restore curent layer
    (defun cancelCommand (CALL CALLBACK)
    (if *Currentlayers*
    (if (car *Currentlayers*)
    (progn
    (vla-put-lock
    (vla-item
    (vla-get-layers
    (vla-get-activedocument (vlax-get-acad-object)))
    (car *Currentlayers*)
    )
    :vlax-false
    )
    (setvar "CLAYER" (car *Currentlayers*))
    )
    )
    )
    (setq *Currentlayers* (cdr *Currentlayers*))
    )
    (princ)
    
    ;------------------<The End>--------------------------
    Last edited by Ed Jobe; 2015-02-27 at 11:11 PM. Reason: Added Code Tags

  4. #4
    Member
    Join Date
    2015-10
    Location
    Alhambra
    Posts
    27
    Login to Give a bone
    0

    Default Re: VLR_COMMAND.lsp

    Follow rkmcswain reply but using the file name VLR_COMMAND.lsp
    Include the following code in "acaddoc.lsp":
    (load"VLR_COMMAND"); assuming this lisp file is in AutoCAD's search path
    Then at the end of "acaddoc.lsp" file include this code:
    (c:alon)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •