Author Topic: an old dog needs a new trick  (Read 2970 times)

0 Members and 1 Guest are viewing this topic.

Jim Yadon

  • Guest
an old dog needs a new trick
« on: September 04, 2006, 12:19:31 PM »
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: [Select]
; 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
« Last Edit: September 05, 2006, 07:39:19 PM by JAY »

Jim Yadon

  • Guest
Re: an old dog needs a new trick
« Reply #1 on: September 05, 2006, 07:18:55 PM »
 :? hmmm... no takers?

T.Willey

  • Needs a day job
  • Posts: 5251
Re: an old dog needs a new trick
« Reply #2 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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ronjonp

  • Needs a day job
  • Posts: 7531
Re: an old dog needs a new trick
« Reply #3 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.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Jim Yadon

  • Guest
Re: an old dog needs a new trick
« Reply #4 on: September 05, 2006, 09:14:20 PM »
You will also need to include all of your subroutines. I do not see (viewport_layer) in your post.
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.

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.
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.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: an old dog needs a new trick
« Reply #5 on: September 06, 2006, 03:01:43 PM »
I would change it like this. One real code change, and then the others just change how the call the one code that did change.
Code: [Select]
(defun viewport_root_tool(scale1 buffer1 / cl pnt1 pnt2 vportsize pnt3 pnt4 ccmde)
  (setq cl (getvar "clayer"))
  (setq ccmde (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (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)) (/ buffer1 scale1)) scale1)
   (* (+ (- (cadr pnt2) (cadr pnt1)) (/ buffer1 scale1)) 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" (strcat (rtos scale1 1 16) "xp"))
  (command "layer" "s" cl "")
  (cvplockall)
  ;(viewport_layer_off)
  (command "pspace")
  (setvar "cmdecho" ccmde)
)
Then the ones that call it, change like so
Code: [Select]
(defun c:vp1 ();vport that zooms to full scale
  (viewport_root_tool 1 12.7)
  (princ)
)
(defun c:vp2 ();vport that zooms to 6" scale
  (viewport_root_tool 0.5 12.7)
  (princ)
)

Is this the type of thing you were looking for?
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Jim Yadon

  • Guest
Re: an old dog needs a new trick
« Reply #6 on: September 06, 2006, 11:11:05 PM »
Cool T.W. It looks great. I'll put it through the paces while I draw this next job. That streamlines several things that were otherwise cumbersome.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: an old dog needs a new trick
« Reply #7 on: September 07, 2006, 01:03:04 AM »
Cool T.W. It looks great. I'll put it through the paces while I draw this next job. That streamlines several things that were otherwise cumbersome.
You're welcome.  Just happy to help.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.