Code Red > AutoLISP (Vanilla / Visual)
an old dog needs a new trick
Jim Yadon:
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.
--- Code: ---; 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.")
;;;===================================================================================
--- End code ---
edit by JAY - commented out the layer control code that could cause a burp
Jim Yadon:
:? hmmm... no takers?
T.Willey:
How much are you planning on rewriting? and how much to you want to simplify calls? I can help tomorrow, or maybe tonight, but I don't have cad at home so I can't test anything.
ronjonp:
You will also need to include all of your subroutines. I do not see (viewport_layer) in your post.
Jim Yadon:
--- Quote from: ronjonp on September 05, 2006, 07:44:05 PM ---You will also need to include all of your subroutines. I do not see (viewport_layer) in your post.
--- End quote ---
I commented out the view port layer routine in the code example. That's a legacy item that is called and some of the code is not mine to post.
--- Quote from: T.Willey on September 05, 2006, 07:36:03 PM ---How much are you planning on rewriting? and how much to you want to simplify calls? I can help tomorrow, or maybe tonight, but I don't have cad at home so I can't test anything.
--- End quote ---
I am actually going to integrate a windowing feature that allows for selection of the window from any crossing points rather than the lower-left to upper-right that it's set up for. I am really looking for some ideas from you guys how to improve what's there while keeping that basic command call structure intact. I currently have somewhere in the neighborhood of 75 people using this and don't want to break other things that link to it.
Navigation
[0] Message Index
[#] Next page
Go to full version