Author Topic: Dimension reactor  (Read 12198 times)

0 Members and 1 Guest are viewing this topic.

ELOQUINTET

  • Guest
Dimension reactor
« on: January 23, 2008, 10:01:27 AM »
Hey guys,

I had this reactor at a previous job where it would create a layer which matched the current dimstyle name and set it current when dimensioning. I have a similar situation but all I don't need to match the dimstyle now. All I need to do is set the layer to dimensions when dimensioning and notes when doing leaders. Is this reactor easy to edit or would it be easier to rewrite something? I need help baaaaaad.

Code: [Select]
(vl-load-com)
(vl-load-reactors)
(defun ax:MakeLayer (lName / oLayer)
  (if
    (vl-catch-all-error-p
      (setq oLayer
          (vl-catch-all-apply
            'vla-add
              (list
                (vla-get-layers
                  (vla-get-activedocument
                    (vlax-get-acad-object)
                    )
                  )
                lName
                )
             )
          )
        )
    nil
    oLayer
    )
  )
; set a variable to the reactor object so that you can release it later if you want to
(setq $$LayerReactor$$
  (vlr-command-reactor nil
   '(
      (:vlr-CommandWillStart . StartCommand)
      (:vlr-commandEnded . EndCommand)
      (:vlr-commandCancelled . EndCommand)
      (:vlr-commandFailed . EndCommand)
    )
  )
)

(defun StartCommand (calling-reactor startcommandinfo / thecommandstart)
  (setq thecommandstart (nth 0 startcommandInfo))
  (if
    (not
      (member
        (car thecommandstart)
        ;; a list of commands that are known to cause problems
        ;; if a reactor process is tied to them...
         (list "U" "UNDO" "EXIT" "END" "CLOSE" "OPEN" "REDO" "QSAVE"  "SAVEAS")
      )
    )
    (cond
      ( (wcmatch thecommandstart "*DIM*") ;; any DIM command
        (match:layer)
        ; go do the Match:layer function
      )
      ( (wcmatch thecommandstart "*LEADER*") ;; any LEADER command
        (match:layer)
      )
    );cond
  );if
);defun

;; you don't need to look to see what command ended just go ahead
;; reset the layer if it the name exists in the variable you set
;; up earlier.
(defun EndCommand (calling-reactor endcommandInfo / thecommandend)
  (if
    (not
      (member
        (car callback)
        (list "U" "UNDO" "EXIT" "END" "CLOSE" "OPEN" "REDO" "QSAVE" "SAVEAS")
      )
    )
    (if ex:layer (EC:MatchLayer))
  )
)

(defun match:layer (/ LayerName ex:dimstyle)
  (setq ex:layer (getvar 'clayer))
  (setq ex:dimstyle (getvar 'dimstyle))
  (if (/= ex:layer ex:dimstyle)
    (progn
      (setq LayerName (ax:MakeLayer ex:dimstyle))
      (vla-put-ActiveLayer
        (vla-get-activedocument
          (vlax-get-acad-object)
          )
        LayerName
        )
      (if (not (vlax-object-released-p LayerName))
        (vlax-release-object LayerName)
        )
      (princ)
      )
    )
  )

(defun EC:MatchLayer (/ LayerName)
  (progn
    (setq LayerName (ax:MakeLayer ex:layer))
    (vla-put-ActiveLayer
      (vla-get-activedocument
        (vlax-get-acad-object)
        )
      LayerName
      )
    (if
      (not
        (vlax-object-released-p LayerName)
        )
      (vlax-release-object LayerName)
      )
    (setq ex:layer nil)
    (princ)
    )
  )

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #1 on: January 23, 2008, 10:26:12 AM »
Maybe this one
http://forums.augi.com/showpost.php?p=215298&postcount=6

Also I think Luis has one in the ShowYouStuf Forum.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #2 on: January 23, 2008, 10:38:54 AM »
Here is another version of Peters.
http://discussion.autodesk.com/thread.jspa?threadID=406050

Could not find the source for the copy I have but here is a code fragment:
Code: [Select]
; Examples of Command vs Layer
; List of corrusponding      command layerName color linetype plottable
; NOTE command names must be in Upper Case
 (setq COMLAYLST (list
                (list "DIMANGULAR" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMBASELINE" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMCENTER" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMCONTINUE" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMDIAMETER" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMLINEAR" "S-DIM" 5 "continuous" :vlax-true)
                (list "DIMRADIUS" "S-DIM" 5 "continuous" :vlax-true)
                (list "QDIM" "S-DIM" 5 "continuous" :vlax-true)
                (list "LEADER" "A-DIM" 5 "continuous" :vlax-true)
                (list "QLEADER" "A-DIM" 5 "continuous" :vlax-true)
                (list "DTEXT" "A-TEXT" 2 "continuous" :vlax-true)
                (list "MTEXT" "A-TEXT" 2 "continuous" :vlax-true)
                (list "TEXT" "A-TEXT" 2 "continuous" :vlax-true)
                (list "BHATCH" "A-HATCH" 8 "continuous" :vlax-true)
                (list "HATCH" "A-HATCH" 8 "continuous" :vlax-true)
                (list "POINT" "A-POINTS" 7 "continuous" :vlax-true)
                (list "XLINE" "A-CONST-LINES" 9 "continuous" :vlax-true)
                (list "MVIEW" "A-VIEWPORT" 7 "continuous" :vlax-false)
                (list "TABLE" "A-TABLE" 2 "continuous" :vlax-true)
                (list "REVCLOUD" "A-REVCLOUD" 7 "continuous" :vlax-true)
; Add your own command layer lists here....
                 )
 )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #3 on: January 23, 2008, 11:06:58 AM »
thanks a bunch cab i will test this out today and let you know. i will have alot of need as i just started a new job which a different trade, using an older version and are working very differently.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #4 on: January 23, 2008, 11:09:54 AM »
Good Luck with your new job Dan. :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #5 on: January 23, 2008, 01:14:33 PM »
cab or anyone else who might know,

I got the example you provided to work and was testing it against another one i already had for viewports. the part i like about the viewports is that after the viewport is created it switches the layer back to the prvious. Is there a way I can combine these to offer that functionality?

Code: [Select]
(defun subCommandLayer (objReactor lstCommand)
; Examples of Command vs Layer
; List of corrusponding      commands layers  color linetype     plottable
 (if (not lstCommandLayersX)
  (setq lstCommandLayersX (list (list "DIMLINEAR"    "I_ANNO-DIMS"   14     "continuous" :vlax-true)
                          (list "QLEADER" "I_ANNO-NOTE"  11     "continuous" :vlax-true)
 ; Add your own command layer lists here....
                  )
  )
 )
 (foreach lstLayerProperties lstCommandLayersX
  (if (= (strcase (car lstCommand)) (strcase (car lstLayerProperties)))
   (progn
    (subMakeLayer (nth 1 lstLayerProperties)
                  (nth 2 lstLayerProperties)
                  (nth 3 lstLayerProperties)
                  (nth 4 lstLayerProperties))
    (vla-put-activelayer
     (vla-get-activedocument
      (vlax-get-acad-object))
     (vlax-ename->vla-object
      (tblobjname "LAYER" (cadr lstLayerProperties)))))))
 (princ)
)

; Make layers using activeX

(defun subMakeLayer (strLayerName      ; String Layer name
                     intColor          ; Integer Layer Color
                     strLineType       ; String Linetype Name
                     blnPlottable      ; VL boolean plottable layer
                     /
                     colLayers         ; Layers Collection
                     colLineTypes      ; Linetype Collection
                     objActiveDocument ; ActiveDocument Object
                     objLayer          ; New Layer Object
                    )
 (vl-load-com)
 (setq objActiveDocument (vla-get-activedocument
                          (vlax-get-acad-object))               
       colLayers         (vla-get-layers objActiveDocument)
 )
 (vl-catch-all-error-p
  (vl-catch-all-apply 'vla-add (list colLayers strLayerName))
 )
 (setq objLayer (vla-item colLayers strLayerName))
 (if (not (tblobjname "ltype" strLineType))
  (progn 
   (setq colLineTypes     (vla-get-linetypes objActiveDocument)) 
   (vla-load colLineTypes strLineType (findfile "acad.lin")) 
   (vlax-release-object   colLineTypes) 
  )
 )
 (vla-put-color     objLayer intColor)
 (vla-put-linetype  objLayer strLineType)
 (vla-put-plottable objLayer blnPlottable)
)
(if (not rxnCommandLayer)
 (setq rxnCommandLayer (vlr-editor-reactor nil '((:vlr-commandwillstart . subCommandLayer)))))
(princ)



;;;Used for viewports


;; by default turn the ability ON
(if (or (eq (getenv "RunPlaceViewLayer") nil)
(eq (getenv "RunPlaceViewLayer") ""))
  (setenv "RunPlaceViewLayer" "1"))

(defun reactor-editor  (reactor params)
  (if (eq (getenv "RunPlaceViewLayer") "1")
    (progn
      (if (not
    (wcmatch
      (getvar "cmdnames")
      "UNDO,U,REDO,OOPS,STYLE,COPYCLIP,COPYBASE,CUTCLIP"))
(progn
  (if (and
(wcmatch (strcase (car params)) "MVIEW")
posible_viewport_ename
posible_viewport_enames)
    (progn

;; the Z-VIEWPORT layer must exist
(vla-put-layer (vlax-ename->vla-object posible_viewport_ename) "Z-VIEWPORT")

      ;; convert the variable "posible_viewport_ename"
      ;; into vla-object and set it to an existing standard layer
      ;; after that turn the vla-object to nil

      (setq posible_viewport_ename nil)
      (setq posible_viewport_enames nil)))))

      (setq posible_viewport_ename nil)
      (setq posible_viewport_enames nil))))

(defun acdb-objectappended  (reactor params)
  (if
    (and
      (eq (getenv "RunPlaceViewLayer") "1")
      (not
(wcmatch
  (getvar "cmdnames")
  "UNDO,U,REDO,OOPS,STYLE,COPYCLIP,COPYBASE,CUTCLIP,NEW,QNEW,OPEN,*LAYOUT*,MOVE,COPY,*STRETCH*")))
     (cond
       ((and
  (wcmatch (getvar "cmdnames") "MVIEW")
  params
  (entget (cadr params))
  (eq (cdadr (entget (cadr params))) "VIEWPORT")
  (not
    (vl-position (cadr params) posible_viewport_enames)))
(setq posible_viewport_ename (cadr params))
(setq posible_viewport_enames
       (cons (cadr params) posible_viewport_enames))))))

(if (not dwiz_editor_reactor)
  (setq dwiz_editor_reactor
(vlr-set-notification
   (vlr-editor-reactor
     "editor"
     '((:vlr-commandended . reactor-editor)
       (:vlr-commandcancelled . reactor-editor)))
   'active-document-only)))

(if (not dwiz_acdb_reactor)
  (setq dwiz_acdb_reactor
(vlr-set-notification
   (vlr-acdb-reactor
     "acdb"
     '((:vlr-objectappended . acdb-objectappended)))
   'active-document-only)))

(princ)

GDF

  • Water Moccasin
  • Posts: 2081
Re: Dimension reactor
« Reply #6 on: January 23, 2008, 02:04:16 PM »
Dan

See if this will help this will help...
http://www.theswamp.org/index.php?action=search2

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #7 on: January 23, 2008, 02:13:01 PM »
ha funny gary. i actually did a few searches before posting but with this being a new job i don't want to be in the swamp for long periods of time . you never know when you are being watched so i'm playing it safe with the surfing.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Dimension reactor
« Reply #8 on: January 23, 2008, 04:19:53 PM »
ha funny gary. i actually did a few searches before posting but with this being a new job i don't want to be in the swamp for long periods of time . you never know when you are being watched so i'm playing it safe with the surfing.

Oops, my bad, forget the search, here is the file I was refurring to.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.

(defun VLR_COMMAND-IT () 
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1))) 
)
(princ "\n*** ------ Layer Reactor Activated. ------ ***")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:COM1 (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding      commands layers  color linetype     plottable
  (setq COMLAYLST
         (list (list "DIMANGULAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMBASELINE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCENTER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCONTINUE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMDIAMETER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMLINEAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMORDINATE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMRADIUS" "A-DIMS" 30 "continuous" :vlax-true)
               (list "QDIM" "A-DIMS" 30 "continuous" :vlax-true)

               (list "LEADER" "A-NOTE" 2 "continuous" :vlax-true)
               (list "QLEADER" "A-NOTE" 2 "continuous" :vlax-true)

               (list "DTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               (list "MTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               ;;(list "TEXT" "A-NOTE" 2 "continuous" :vlax-true)

               ;;(list "BHATCH" "A-PATT" 9 "continuous" :vlax-true)
               ;;(list "HATCH" "A-PATT" 9 "continuous" :vlax-true)

               (list "POINT" "X-PNTS" 4 "continuous" :vlax-true)

               (list "XLINE" "X-LINE" 8 "continuous" :vlax-true)
               (list "XREF" "0-XREF" 7 "continuous" :vlax-true)
               ;;(list "INSERT" "0-INSERT" 7 "continuous" :vlax-true)
         )
  )
  (foreach
         N COMLAYLST
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
      (progn
        (make_layers
          (cadr N)
          (caddr N)
          (cadddr N)
          (car (cddddr N))
        )
        (setq n1 n)
        (vla-put-activelayer
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
          (vlax-ename->vla-object
            (tblobjname "LAYER" (cadr N))
          )
        )
      )
    )
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Make layers using activeX
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument
                  (vlax-get-acad-object)
                )
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (not (tblobjname "layer" LAY_NAM))
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    )
  )
  (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (not (tblobjname "ltype" LTYPE))
    (progn
      (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
      (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
      (vlax-release-object LTYPESOBJ)
    )
  )
  (vla-put-layeron LAYOBJ :vlax-true)
  (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (vla-put-freeze LAYOBJ :vlax-false)
  )
  (vla-put-lock LAYOBJ :vlax-false)
  (vla-put-color LAYOBJ COLOR)
  (vla-put-linetype LAYOBJ LTYPE)
  (vla-put-plottable LAYOBJ PLOTL) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Kenny Ramage @ afralisp.com
(defun startCommand (calling-reactor
                     startcommandInfo
                     /
                     thecommandstart
                    )       
  (setq OldLayer (getvar "CLAYER")) 
  (setq OldLayern OldLayer)

  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun endCommand (calling-reactor
                   endcommandInfo
                   /
                   thecommandend
                  )
  (setq thecommandend (nth 0 endcommandInfo))
  (cond
    ((= thecommandend "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandend "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandend "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandend "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandend "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandend "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandend "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandend "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandend "QDIM") (ARCH:OldLayer))

    ((= thecommandend "LEADER") (ARCH:OldLayer))
    ((= thecommandend "QLEADER") (ARCH:OldLayer))

    ((= thecommandend "DTEXT") (ARCH:OldLayer))
    ((= thecommandend "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandend "TEXT") (ARCH:OldLayer))

    ;;((= thecommandend "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandend "HATCH") (ARCH:OldLayer))

    ((= thecommandend "POINT") (ARCH:OldLayer))

    ((= thecommandend "XLINE") (ARCH:OldLayer))
    ((= thecommandend "XREF") (ARCH:OldLayer))
    ;;((= thecommandend "INSERT") (ARCH:OldLayer))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cancelCommand (calling-reactor
                      cancelcommandInfo
                      /
                      thecommandcancel
                     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))
  (cond
    ((= thecommandcancel "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandcancel "QDIM") (ARCH:OldLayer))

    ((= thecommandcancel "LEADER") (ARCH:OldLayer))
    ((= thecommandcancel "QLEADER") (ARCH:OldLayer))

    ((= thecommandcancel "DTEXT") (ARCH:OldLayer))
    ((= thecommandcancel "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandcancel "TEXT") (ARCH:OldLayer))

    ;;((= thecommandcancel "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandcancel "HATCH") (ARCH:OldLayer))

    ((= thecommandcancel "POINT") (ARCH:OldLayer))

    ((= thecommandcancel "XLINE") (ARCH:OldLayer))
    ((= thecommandcancel "XREF") (ARCH:OldLayer))
  )   
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(VLR_COMMAND-IT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #9 on: January 23, 2008, 04:39:29 PM »
Gary, I think your fingers have been in that lisp. :evil:
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #10 on: January 24, 2008, 12:53:57 AM »
Here is my mod of Peters Code.

<Old code removed, see below for new code.>
« Last Edit: April 25, 2008, 04:44:34 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #11 on: January 24, 2008, 09:34:33 AM »
cool guys thanks. i will try these out today and see how it goes. thanks for your help

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #12 on: January 24, 2008, 12:30:58 PM »
cab i was trying yours out and when i select dimlinear button I can see the layer dialogue ghosting but it does not switch to the layer it is supposed to. I see at the beginning that it says you have to put
(load "vlr_command")(c:vlr_command) in an autoloading file. I put it first in acad.lsp before this code and nothing then i added the line to acaddoc.lsp and still nothing. Am I missing something. Gary yours had too many damn Arch: s in it hahahaha to bother with. I'm kidding of course.

Code: [Select]
;  Modified by CAB 01.23.2008
; 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


(defun C:VLR_COMMAND ()
 (vl-load-com)
 (vlr-editor-reactor nil '((:vlr-commandwillstart . StartCommand)))
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
)
(defun StartCommand (CALL CALLBACK / COMLAYLST)
  ;;  current layer restored on exit of command
  (setq *Currentlayers* (cons (getvar "CLAYER") *Currentlayers*))
       
; Examples of Command vs Layer
; List of corresponding      command layerName color linetype plottable
; NOTE command names must be in Upper Case
 (setq COMLAYLST (list
                (list "DIMANGULAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMBASELINE" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMCENTER" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMCONTINUE" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMDIAMETER" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMLINEAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "DIMRADIUS" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "QDIM" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
                (list "LEADER" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
                (list "QLEADER" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
                (list "DTEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
                (list "MTEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
                (list "TEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
                (list "BHATCH" "I-FIXT-7" 8 "continuous" :vlax-true)
                (list "HATCH" "I-FIXT-7" 8 "continuous" :vlax-true)
                (list "MVIEW" "Z-VIEWPORT" 7 "continuous" :vlax-false)
; Add your own command layer lists here....
                 )
 )
  (if (setq N (assoc (strcase (car CALLBACK)) COMLAYLST))
   (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)))
     )
   )
 )
 (prin1)
)

; Make layers using activeX
; return t if sucessful else nil
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument (vlax-get-acad-object))
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (tblobjname "layer" LAY_NAM)
    (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
    (setq LAYOBJ (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM)))
  )
  ;;(setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (vl-catch-all-error-p LAYOBJ)
    (not (print (vl-catch-all-error-message LAYOBJ)))
    (progn          ; update layer properties
      (if (not (tblobjname "ltype" LTYPE))
        (progn
          (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
          (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
          (vlax-release-object LTYPESOBJ)
        )
      )
      (vla-put-layeron LAYOBJ :vlax-true)
      (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
        (vla-put-freeze LAYOBJ :vlax-false)
      )
      (vla-put-lock LAYOBJ :vlax-false)
      (vla-put-color LAYOBJ COLOR)
      (vla-put-linetype LAYOBJ LTYPE)
      (vla-put-plottable LAYOBJ PLOTL)
      t
    )
  )
)

(defun endCommand (CALL CALLBACK)
  (if *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*))
    )
  )
)

(defun cancelCommand (CALL CALLBACK)
  (if *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*))
    )
  )
)


(prin1)

;------------------<The End>--------------------------

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #13 on: January 24, 2008, 12:49:52 PM »
Put in your ACADdoc.lsp (load "vlr_command")(c:vlr_command)
At the command prompt type .dimlinear be sure to include the dot

Does it work?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #14 on: January 24, 2008, 02:55:36 PM »
cab no it's not working. i'm having a little difficulty troubleshooting because everytime i close my autocad the company profile is getting loaded and everytime i restart my computer all of my acad.lsp acaddoc.lsp acad.pgp are being overriden by a script i believe. arrrrrgh this is going to be a pain in the ass to deal with!!!

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #15 on: January 24, 2008, 03:19:45 PM »
Remove this (load "vlr_command")(c:vlr_command)  from your ACADdoc.lsp

When the drawing is open, Load the lisp.
Enter vlr_command at the command line
the enter .dimlinear

Does that work?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #16 on: January 24, 2008, 04:37:07 PM »
cab I did exactly as you said but it is not changing to the specified layer? Here's my text window

AutoCAD menu utilities loaded.
Command: AP
APPLOAD acad.lsp successfully loaded.


Command:
Command:
Command: vlr_command
#<VLR-Command-Reactor>

Command:
Command: .DIMLINEAR



and here's what's in my acad.lsp???

<Old code removed, see below for updated code>
http://www.theswamp.org/index.php?topic=21056.msg255892#msg255892
« Last Edit: April 25, 2008, 04:48:35 PM by CAB »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #17 on: January 24, 2008, 04:46:51 PM »
In the lisp remove the dot. As the dot is only needed at the Command Line to prevent the command from being redirected.

Change this
(list ".DIMLINEAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
to this
(list "DIMLINEAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #18 on: January 24, 2008, 04:53:58 PM »
In fact just use this:

<Old code removed, see below for updated code>
http://www.theswamp.org/index.php?topic=21056.msg255892#msg255892

« Last Edit: April 25, 2008, 04:47:50 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #19 on: January 24, 2008, 04:54:16 PM »
ok cab got it working now but have a few more questions. will i have to type in vlr_command everytime and the dot too? I don't want to have to do this to get it to work. How can I automate that process?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #20 on: January 24, 2008, 05:08:14 PM »
Now that is working try to put the (load "vlr_command")(c:vlr_command)  back into the ACADdoc.lsp.
This way it will be already running.

Verify you have the correct ACADdoc.lsp by typing (findfile "acaddoc.lsp") at the command line.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #21 on: January 24, 2008, 05:20:10 PM »
when i put it into acaddoc.lsp and open a drawing i get this:

; error: LOAD failed: "vlr_command"


keep in mnd that i am now using architectural desktop 3.3

I need to downgrade my version in my sig  :cry:

rumor is we are getting 2007 in a couple of weeks
i sure as hell hope so i'm dyin over here

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #22 on: January 24, 2008, 05:28:22 PM »
Copy the lisp one more time, make sure you save it to the acad path.
Verifying the location of the file with (findfile "vlr_command.lsp")

Add this to the ACADdoc.lsp  (load "vlr_command")(c:vlr_command)(setq *user* "DAN")

The *user* gives the option for varying layer specs. You may not need that but put it in.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #23 on: January 25, 2008, 09:41:12 AM »
cab i did like you said but when i open autocad i get this message:

; error: LOAD failed: "vlr_command"

then when i type findfile i get this message:

Command: (findfile "vlr_command.lsp")
nil

if i type vlr_command next and dimension it works, what's going on?

Command: vlr_command
T

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #24 on: January 25, 2008, 10:07:39 AM »
Beats me. :-(

can you use (findfile to loacte another file in that folder? If not maybe it's not an active path.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #25 on: January 25, 2008, 10:37:18 AM »
i did a search on my computer for vlr_command.lsp and it found nothing. also i did a search for acaddoc.lsp which resides in the same folder as acad.lsp and it finds it?

Command: (findfile "acaddoc.lsp")
"C:\\ADT Support\\Support Files\\acaddoc.lsp"

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #26 on: January 25, 2008, 10:44:54 AM »
You need to save the lisp code I posted as "vlr_command.lsp" in the support folder or in a folder in the ACAD path.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #27 on: January 25, 2008, 01:27:34 PM »
OK, Dan I modified the code again.
I added an Off feature, entering VLR_COMMAND_OFF  will turn the reactor off.
Entering VLR_COMMAND will activate or turn the reactor On.

setting *user* to DAN will produce the layers you want.
You may add additional layer choices, say for other vendors or other disciplines.
There is also a default Layer group in case *user* is nil or unrecognised.

I haven't done any reactor code to speak of so if anyone see a problem please let me know.
Code: [Select]
;  Modified by CAB 01.25.2008
;  Modified by CAB 04.25.2008 ; bug fix
; 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:VLR_COMMAND ()
  (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:VLR_COMMAND_OFF ()
  (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
  (cond
    ((and *user*(= (type *user*) 'STR)(= (strcase *user*) "DAN"))
     (setq *LayUpdt* t
      LtFname nil)
     (setq COMLAYLST
            (list
              (list "DIMANGULAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMBASELINE" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMCENTER" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMCONTINUE" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMDIAMETER" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMLINEAR" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "DIMRADIUS" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "QDIM" "I_ANNO-DIMS" 14 "continuous" :vlax-true)
              (list "LEADER" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
              (list "QLEADER" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
              (list "DTEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
              (list "MTEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
              (list "TEXT" "I_ANNO-NOTE" 11 "continuous" :vlax-true)
              (list "BHATCH" "I-FIXT-7" 8 "continuous" :vlax-true)
              (list "HATCH" "I-FIXT-7" 8 "continuous" :vlax-true)
              (list "MVIEW" "Z-VIEWPORT" 7 "continuous" :vlax-false)
                    ; Add your own command layer lists here....
            )
     )
    )
    ((and *user*(= (type *user*) 'STR)(= (strcase *user*) "Future Use"))
     (setq COMLAYLST '())
    )
    ((and *usermode*(= (type *usermode*) 'STR)(= (strcase *usermode*) "CAB"))
     (setq *LayUpdt* nil
      LtFname "CAB2.lin")
     (setq COMLAYLST
            (list
              (list "DIMANGULAR"  "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMBASELINE" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMCENTER"   "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMCONTINUE" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMDIAMETER" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMLINEAR"   "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMRADIUS"   "S-DIM" 5 "continuous" :vlax-true)
              (list "QDIM"        "S-DIM" 5 "continuous" :vlax-true)
              (list "LEADER"      "A-DIM" 5 "continuous" :vlax-true)
              (list "QLEADER"     "A-DIM" 5 "continuous" :vlax-true)
              (list "DTEXT"       "A-TEXT" 2 "continuous" :vlax-true)
              (list "MTEXT"       "A-TEXT" 2 "continuous" :vlax-true)
              (list "TEXT"        "A-TEXT" 2 "continuous" :vlax-true)
              (list "BHATCH"      "A-HATCH" 8 "continuous" :vlax-true)
              (list "HATCH"       "A-HATCH" 8 "continuous" :vlax-true)
              (list "POINT"       "A-POINTS" 7 "continuous" :vlax-true)
              (list "XLINE"       "A-CONST-LINES" 9 "continuous" :vlax-true)
              (list "MVIEW"       "A-VIEWPORT" 7 "continuous" :vlax-false)
              (list "TABLE"       "A-TABLE" 2 "continuous" :vlax-true)
              (list "REVCLOUD"    "A-REVCLOUD" 7 "continuous" :vlax-true)
                    ; Add your own command layer lists here....
            )
     )
    )
    (t  ; default Layer Group
     (setq *LayUpdt* nil
      LtFname "CAB2.lin")
     (setq COMLAYLST
            (list
              (list "DIMANGULAR" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMBASELINE" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMCENTER" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMCONTINUE" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMDIAMETER" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMLINEAR" "S-DIM" 5 "continuous" :vlax-true)
              (list "DIMRADIUS" "S-DIM" 5 "continuous" :vlax-true)
              (list "QDIM" "S-DIM" 5 "continuous" :vlax-true)
              (list "LEADER" "A-DIM" 5 "continuous" :vlax-true)
              (list "QLEADER" "A-DIM" 5 "continuous" :vlax-true)
              (list "DTEXT" "A-TEXT" 2 "continuous" :vlax-true)
              (list "MTEXT" "A-TEXT" 2 "continuous" :vlax-true)
              (list "TEXT" "A-TEXT" 2 "continuous" :vlax-true)
              (list "BHATCH" "A-HATCH" 8 "continuous" :vlax-true)
              (list "HATCH" "A-HATCH" 8 "continuous" :vlax-true)
              (list "POINT" "A-POINTS" 7 "continuous" :vlax-true)
              (list "XLINE" "A-CONST-LINES" 9 "continuous" :vlax-true)
              (list "MVIEW" "A-VIEWPORT" 7 "continuous" :vlax-false)
              (list "TABLE" "A-TABLE" 2 "continuous" :vlax-true)
              (list "REVCLOUD" "A-REVCLOUD" 7 "continuous" :vlax-true)
                    ; 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 Edit: April 25, 2008, 04:46:23 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
Re: Dimension reactor
« Reply #28 on: January 28, 2008, 05:14:56 PM »
thanks cab maybe the additional functionality you added will be useful later but for now only i will be using this. i am not that accustomed to using layers and the documensts i am creating need to stick to standard layers. i just started here and don't want to ruffle too many feathers with automating things. Then I'd have to explain alot of things I'm not ready to at this time but thanks for all of your help with this it saves me alot of time.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #29 on: January 28, 2008, 06:36:11 PM »
You're welcome.
I noticed there were some commands missing so here is my updated list with my layers.
Code: [Select]
     (setq CmdLayerList
            (list
              ;(list "3DFACE"
              ;(list "ARC"        "Arc" 5 "" :vlax-true)
              (list "BHATCH"      "A-HATCH" 8 "" :vlax-true)
              ;(list "BOX"
              (list "CIRCLE"      "Circle" 5 "" :vlax-true)
              ;(list "CONE"
              ;(list "CYLINDER"
              (list "DIMALIGNED"  "S-DIM"  5 "" :vlax-true)
              (list "DIMANGULAR"  "S-DIM"  5 "" :vlax-true)
              (list "DIMBASELINE" "S-DIM"  5 "" :vlax-true)
              (list "DIMCENTER"   "S-DIM"  5 "" :vlax-true)
              (list "DIMCONTINUE" "S-DIM"  5 "" :vlax-true)
              (list "DIMDIAMETER" "S-DIM"  5 "" :vlax-true)
              (list "DIMLINEAR"   "S-DIM"  5 "" :vlax-true)
              (list "DIMORDINATE" "S-DIM"  5 "" :vlax-true)
              (list "DIMRADIUS"   "S-DIM"  5 "" :vlax-true)
              (list "DONUT"       "Pline"  5 "" :vlax-true)
              (list "DTEXT"       "A-TEXT" 2 "" :vlax-true)
              (list "ELLIPSE"     "Ellipse" 5 "" :vlax-true)
              (list "HATCH"       "A-HATCH" 8 "" :vlax-true)
              (list "LEADER"      "A-DIM" 5 "" :vlax-true)
              (list "LINE"        "Line" 5 "" :vlax-true)
              (list "MTEXT"       "A-TEXT" 2 "" :vlax-true)
              (list "MVIEW"       "A-VIEWPORT" 7 "" :vlax-false)
              ;(list "OBLIQUE"
              (list "PLINE"       "Pline" 5 "" :vlax-true)
              (list "POINT"       "A-POINTS" 7 "" :vlax-true)
              (list "POLYGON"     "Pline"  5 "" :vlax-true)
              (list "QDIM"        "S-DIM"  5 "" :vlax-true)
              (list "QLEADER"     "A-DIM"  5 "" :vlax-true)
              (list "RAY"         "Ray"    5 "" :vlax-true)
              (list "RECTANG"     "Pline"  5 "" :vlax-true)
              ;(list "REGION"
              (list "REVCLOUD"    "A-REVCLOUD" 7 "" :vlax-true)
              ;(list "SOLID"
              ;(list "SPHERE"
              (list "SPLINE"      "Spline"  7 "" :vlax-true)
              (list "TABLE"       "A-TABLE" 2 "" :vlax-true)
              (list "TEXT"        "A-TEXT"  2 "" :vlax-true)
              ;(list "TOLERANCE"
              ;(list "TORUS"
              ;(list "WEDGE"
              (list "XLINE"       "A-CONST-LINES" 9 "" :vlax-true)                   
              ;; Add your own command layer lists here....
            )
     )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Dimension reactor
« Reply #30 on: April 25, 2008, 04:49:20 PM »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.