Author Topic: Dimension reactor  (Read 12284 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!!!