;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Command Reactors to set entities on the appropiate layer
; without user intervention.
;
; Programmed by: Kevin Petursson
; Date: October 6, 2006
; Revisions: 1 - October 16, 2006. Added 'defun setLayerCurrent' to
; check for layer prior to setting layer. If the layer
; does not exist, it will be created.
; Added Printer Checking routines
; 2 - March 20, 2007. Added REVCLOUD to the automatic Text Layer
;
; Big thanks to Lee Ambrosius and his article in July 2006
; AUGIWorld magazine on Command Reactors
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Load the Visual LISP library
(vl-load-com)
; Check to see if our custom command reactors
; have been loaded into the current drawing
(if (= hyp-rctCmds nil)
; Add the command reactors and the custom callbacks
(setq hyp-rctCmds (vlr-command-reactor nil '((:vlr-commandCancelled . hyp-cmdAbort)
(:vlr-commandEnded . hyp-cmdAbort)
(:vlr-commandCancelled . hyp-cmdAbort)
(:vlr-commandWillStart . hyp-cmdStart)
)
)
)
)
; Callback used when the user presses ECSape
; or when the command ends by itself or due to
; a problem
(defun hyp-cmdAbort (param1 param2)
; Check to see if our global variable has a value
; if it does the set the current layer
(if (and (/= hyp-gClayer nil)(/= (strcase (getvar "clayer")) (strcase hyp-gClayer)))
(setvar "clayer" hyp-gClayer)
)
; Clear the global variable
(setq hyp-gClayer nil)
)
; Callbackused when a command is started
(defun hyp-cmdStart (param1 param2 / currentlayer)
; Store the current layer in a global variable
(setq hyp-gClayer (getvar "clayer"))
;check to see what command has been started, the
; command name is stored in the param2 variable
(cond
; If either the QDIM command
; is active the set the current layer to Dimensions
( (or
(= (car param2) "DIMALIGNED")
(= (car param2) "DIMANGULAR")
(= (car param2) "DIMBASELINE")
(= (car param2) "DIMCONTINUE")
(= (car param2) "DIMDIAMETER")
(= (car param2) "DIMLINEAR")
(= (car param2) "DIMORDINATE")
(= (car param2) "DIMRADIUS")
(= (car param2) "QDIM")
)
(setLayerCurrent "Dimensions")
)
; If either the HATCH, BHATCH or GRADIENT command
; is active the set the current layer to Hatching
( (or
(= (car param2) "HATCH")
(= (car param2) "BHATCH")
(= (car param2) "GRADIENT")
)
(setLayerCurrent "Hatching")
)
; If either the Viewport command
; is active the set the current layer to Viewport
( (or
(= (car param2) "VPORTS")
(= (car param2) "-VPORTS")
)
(setLayerCurrent "Viewport")
); If either the MTEXT, DTEXT, QLEADER, LEADER, Revision Cloud command
; is active the set the current layer to Text
( (or
(= (car param2) "TTEXT")
(= (car param2) "DTEXT")
(= (car param2) "MTEXT")
(= (car param2) "LEADER")
(= (car param2) "QLEADER")
(= (car param2) "REVCLOUD")
)
(setLayerCurrent "Text")
)
; If either the LAYER command
; is active the clear global variable for the current layer
( (or
(= (car param2) "LAYER")
(= (car param2) "-LAYER")
)
(setq hyp-gClayer nil);Clear the global variable to allow the layer command to change the current layer
)
; If either the Plot command
; is active the clear global variable for the current layer
( (or
(= (car param2) "PLOT")
(= (car param2) "-PLOT")
)
(progn
(setq hyp-gClayer nil);Clear the global variable to allow the layer command to change the current layer
(SwitchDefaultPrinter);confim the printer being asked for is a current device
)
)
)
)
;Set the current layer. If the layer specified does not exist, it will be created.
;Thank to Lee Ambrosius for his help with this code.
(defun setLayerCurrent (layname / acadObj docObj layColl layObj colour)
(if (= (tblobjname "layer" layname) nil)
(progn
(setq acadObj (vlax-get-acad-object))
(setq docObj (vla-get-activedocument acadObj))
(setq layColl (vla-get-layers docObj))
(setq layObj (vla-add layColl layname))
(setq colour 0)
(if (= layname "Dimensions")(setq colour 4))
(if (= layname "Hatching")(setq colour 8))
(if (= layname "Viewport")(setq colour 9))
(if (= layname "Text")(setq colour 4))
(vla-put-color layObj colour)
(setvar "clayer" layname)
)
(setvar "clayer" layname)
)
)
;;;
; Check if the plotter last saved with the file is in a list of
; current devices. If it is not, change the plot device to a current
; device, If it is, leave things alone.
;;;
(defun SwitchDefaultPrinter (/ Default ad OldPlotDevicee PlotDevices NonCurrentDevice)
(setq Default "\\\\bdn01ps001\\drafting_lj8000");Set default printer
;create list of current plot devices
(setq PlotDevices (list "Bluebeam PDF Printer"
"\\\\bdn01ps001\\black_laser"
"\\\\bdn01ps001\\ccc_colorlaser"
"\\\\bdn01ps001\\ccc_lj8150"
"\\\\bdn01ps001\\color_laser"
"\\\\bdn01ps001\\drafting_lj8000"
"\\\\bdn01ps001\\drafting_plotter"
"Black_Laser_D_to_B_Batch.pc3"
"Color_Laser_A_to_A.pc3"
"Color_Laser_A_to_B.pc3"
"Color_Laser_B_to_B.pc3"
"Color_Laser_C_to_B.pc3"
"Color_Laser_D_to_B.pc3"
"Color_Laser_D_to_B_PID_Batch.pc3"
"Color_Laser_D_to_D_PID_Batch.pc3"
"Drafting_Plotter.pc3"
"Drafting_Plotter_Batch.pc3"
"Drafting_Plotter_BW.pc3"
"Drafting_Plotter_D_to_D_BW_Batch.pc3"
))
(setq ad (vla-get-activedocument (vlax-get-acad-object)));Set variable to hold reference to the active document
(setq OldPlotDevice (GetActivePlotDevice ad));Set variable to hold reference to current plot device
;comapre the old plot device to a list of current devices
(if (= nil (vl-position OldPlotDevice PlotDevices))
(setq NonCurrentDevice 0);Device not found in list
(setq NonCurrentDevice 1);Device found in list
)
(if (= 0 NonCurrentDevice);if the current device is not in the current list of active devices.
(progn
(vla-put-ConfigName (vla-get-ActiveLayout ad) Default);Change the plotter name to be used by the active layout
(setq PrinterSwitched 1)
)
;other wise leave it alone.
)
(if (= nil (vl-position (vlax-get-property (vla-get-ActiveLayout ad) "StyleSheet") (GetPlotStyleTableNames ad)));check the list of CTB files for the current requested CTB
(vlax-put-property (vla-get-ActiveLayout ad) "StyleSheet" "Black_Laser.ctb");Current CTB Not found, set CTB file to "Black_Laser.ctb"
;Curerent CTB found, don't worry about it
)
(if (= 1 PrinterSwitched)
(progn
(if (/= nil (vl-position "11x17" (GetCanonicalMediaNames ad)));check list of paper sizes for 11X17
(vlax-put-property (vla-get-ActiveLayout ad) "CanonicalMediaName" "11x17");11X17 found in the list of paper sizes, set paper size to 11x17
;11x17 is not in the list, don't worry about it
)
(vlax-put-property (vla-get-ActiveLayout ad) "CenterPlot" -1);Set to center the plot on the paper
(vlax-put-property (vla-get-ActiveLayout ad) "StandardScale" 0);Set to "Scale to Fit
(vlax-put-property (vla-get-ActiveLayout ad) "PlotType" 1);Set to plot extents
(vlax-put-property (vla-get-ActiveLayout ad) "PlotRotation" 1);Set to print Landscape
)
)
(princ)
)
(defun GetActivePlotDevice (ad)
(vla-get-ConfigName
(vla-get-ActiveLayout ad))
)
(defun GetCanonicalMediaNames (ad)
(vla-RefreshPlotDeviceInfo
(vla-get-activelayout ad))
(vlax-safearray->list
(vlax-variant-value
(vla-GetCanonicalMediaNames
(vla-item (vla-get-layouts ad) "Model"))))
)
(defun GetPlotStyleTableNames (ad)
(vla-RefreshPlotDeviceInfo
(vla-get-activelayout ad))
(vlax-safearray->list
(vlax-variant-value
(vla-getplotstyletablenames
(vla-item (vla-get-layouts ad) "Model"))))