This was originally written before the 'Garden Path' tutorial was made available to me. I am sure there is a much more elegant way to go about this.
The layer control calls will need to be commented out prior to anyone trying to use this.I already have some ideas for refining a few things but I wanted to submit it for speculation by you wizards before proceeding with any more changes.
I seem to be missing the finer points on a few things with LISP so here is a list of what I am lacking the skill to handle -
- passing variables between subroutines
- handling and escape form the command
- ghosting of the viewport outline for placement in paper space
- some other functionality of LISP I could use to accomplish this?
Once complete, I already have a menu, tool bar & pallette that go with the code that I can post in our collection.
; originally written by Jim Yadon in 1996
; hastily rewritten by Jim Yadon in 2004
; use at your own risk
(defun viewport_root_tool()
(setq cl (getvar "clayer"))
(setvar "tilemode" 1)
(setq pnt1 (getpoint "\nWindow around objects for viewport: "))
(setq pnt2 (getcorner pnt1 "\nSelect other corner: "))
(setq vportsize
(list
(* (+ (- (car pnt2) (car pnt1)) buffer2) scale1)
(* (+ (- (cadr pnt2) (cadr pnt1)) buffer2) scale1)
)
)
(setvar "tilemode" 0)
;(viewport_layer)
(setq pnt3 (getpoint "\nSelect insertion point for viewport: "))
(setq pnt4 (list (+ (car pnt3) (car vportsize))
(+ (cadr pnt3) (cadr vportsize))
)
)
(command "mview" pnt3 pnt4)
(command "mspace")
(command "view" "ortho" "top")
(command "shademode" "2d")
;(command "vplayer" "freeze" layoutlayer "current" "")
(command "zoom" pnt1 pnt2)
(command "zoom" "s" scale2)
(command "layer" "s" cl "")
(cvplockall)
;(viewport_layer_off)
(command "pspace")
)
;;;===================================================================================
(defun c:vpa ();vport that zooms all
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "tilemode" 0)
;(viewport_layer)
(setq pnt1 (getpoint "\nSelect starting point: "))
(setq pnt2 (getcorner pnt1 "\nSelect finishing point: "))
(command "mview" pnt1 pnt2)
(command "mview" "lock" "on" "last" "")
(command "layer" "s" cl "")
;(viewport_layer_off)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp1 ();vport that zooms to full scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 1)
(setq scale2 "1xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp2 ();vport that zooms to 6" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.5)
(setq scale2 "0.5xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp3 ();vport that zooms to 3" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.25)
(setq scale2 "0.25xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp4 ();vport that zooms to 1 1/2" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.125)
(setq scale2 "0.125xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp5 ();vport that zooms to 1" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.08333333333)
(setq scale2 "0.08333333333xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp6 ();vport that zooms to 3/4" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.0625)
(setq scale2 "0.0625xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp7 ();vport that zooms to 1/2" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.041666666667)
(setq scale2 "0.041666666667xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp8 ();vport that zooms to 3/8" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.03125)
(setq scale2 "0.03125xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp9 ();vport that zooms to 1/4" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.020833333333)
(setq scale2 "0.020833333333xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp10 ();vport that zooms to 3/16" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.015625)
(setq scale2 "0.015625xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp11 ();vport that zooms to 1/8" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.010416666667)
(setq scale2 "0.010416666667xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp12 ();vport that zooms to 1/16" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.005208333333)
(setq scale2 "0.005208333333xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp13 ();vport that zooms to 1/32" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.002604166667)
(setq scale2 "0.002604166667xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
(defun c:vp14 ();vport that zooms 1/64" scale
(setq ccmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq scale1 0.001302083333)
(setq scale2 "0.001302083333xp")
(setq buffer1 12.7)
(setq buffer2 (/ buffer1 scale1))
(viewport_root_tool)
(setvar "cmdecho" ccmde)
(princ)
)
;This section was refined from some tools found at the www.theswamp.org
; unlock all vp & set color to green 06/07/04
(defun c:vpunlockall ()
;(viewport_layer_on)
(cvpunlockall)
)
(defun cvpunlockall()
(vl-load-com)
(vlax-for lay
(vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (eq :vlax-false (vla-get-modeltype lay))
(vlax-for ent (vla-get-block lay) ; for each ent in layout
(if (= (vla-get-objectname ent) "AcDbViewport")
(progn
(vla-put-displaylocked ent :vlax-false)
(vla-put-color ent 3); 3 green
)
)
)
)
)
(prompt "\n*** All viewports are UnLocked ***")
(princ)
)
;; lock all vp and set color to red 06/07/04
(defun c:vplockall ()
;(viewport_layer_on)
(cvplockall)
)
(defun cvplockall()
(vl-load-com)
(vlax-for lay
(vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (eq :vlax-false (vla-get-modeltype lay))
(vlax-for ent (vla-get-block lay) ; for each ent in layout
(if (= (vla-get-objectname ent) "AcDbViewport")
(progn
(vla-put-displaylocked ent :vlax-true)
(vla-put-color ent 1);1 red
)
)
)
)
)
(prompt "\n*** All viewports are Locked ***")
(princ)
)
;end of view port tools from the Swamp
(defun c:vplon ()
;(viewport_layer_on)
(cvplockall)
)
(defun c:vploff ()
;(viewport_layer_on)
(cvplockall)
;(viewport_layer_off)
)
(defun c:vpulon ()
;(viewport_layer_on)
(cvpunlockall)
)
(defun c:vpuloff ()
;(viewport_layer_on)
(cvpunlockall)
;(viewport_layer_off)
)
;;;===================================================================================
(princ "\nViewport tools have been loaded.")
;;;===================================================================================
edit by JAY - commented out the layer control code that could cause a burp