Zoom Dynamic

#1
This is a repost of a very nice routine which was improved by David Trotz. Unfortunately, his post contains minor errors which prevent it from loading properly. This should be fixed below. Paste it to Icad.lsp, restart, type ZD and see what happens.


;; Zoom Dynamic
;; By "CCEAB"
;; E-mail: cceab@telsur.cl
;; Description of changes by David Trotz Jr.
;; All Changes noted below.
;; Added done variable to check to see if user is done. This check
;; bypasses the call to the exit function which should
;; only be called in an unrecoverable error detected by the program.
;; becuase this is true, using exit also causes IntellicAD to dump
;; the rest of the lisp routine to the screen for debugging.
(defun c:zd (/ fzoom0 ssiz vctr vsiz vasp ssizh ssizv
fvsvh fvshd x010 y010 x030 y030 ip0 it0
it1 fla0 fla1 pto0 done
)
(setq pi2 (/ pi 2))
(setq pi4 (/ pi 4))
(setq pi32 (* pi 1.5))
(setq an1 pi4)
(setq an2 (+ pi2 pi4))
(setq an3 (+ pi pi4))
(setq an4 (+ pi pi2 pi4))
(setq factzoom 6) ; factor amplicacion zoom
(setq sblip (getvar "blipmode"))
(setq scmde (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq fzoom0 factzoom)
(setq ssiz (getvar "screensize"))
(setq vctr (getvar "viewctr"))
(setq vsiz (getvar "viewsize"))
(setq vasp (getvar "viewaspect"))
(setq xc0 (car vctr))
(setq yc0 (car (cdr vctr)))
(setq ssizh (car ssiz))
(setq ssizv (car (cdr ssiz)))
(setq fvsvh (/ ssizv ssizh))
(setq van1 (atan fvsvh))
(setq van2 (- pi van1))
(setq van3 (+ pi van1))
(setq van4 (- (* 2 pi) van1))
(setq fvshd (/ 1 (cos van1)))
(setq dx0 (/ (/ vsiz fvsvh) 2))
(setq dishd (* dx0 fvshd))
(setq dishd0 (* (* dx0 1.01) fvshd))
(setq vvctr (trans vctr 3 2))
(setq p001 (polar vvctr van1 dishd))
(setq p002 (polar vvctr van2 dishd))
(setq p003 (polar vvctr van3 dishd))
(setq p004 (polar vvctr van4 dishd))
(setq p005 (polar vvctr van1 dishd0))
(setq p006 (polar vvctr van2 dishd0))
(setq p007 (polar vvctr van3 dishd0))
(setq p008 (polar vvctr van4 dishd0))
(setq dd01 (* dx0 0.15))
(setq dd02 dd01)
(setq dd03 (* dd01 1.5))
(setq dx01 dx0)
(setq dishd01 (* dx01 fvshd))
(command "zoom" "_c" vctr (* vsiz fzoom0))
(zdmarco)
(setq vsiz0 (getvar "viewsize"))
(setq p010 vctr)
(setq ip0 1)
(while (and (< 0 ip0) (not done)) ;;; Modified by David Trotz Jr.
(setq ip00 1)
(while (and (< 0 ip00) (not done)) ;;; Modified by David Trotz Jr.
(zdventana 0)
(setq pto0 (grread 1 5 2))
(setq fla0 (car pto0))
(cond
((= fla0 5) ; Coordenada
(zdventana 0)
(setq p010 (car (cdr pto0)))
)
((= fla0 11) ; mouse derecho
(zdaceptar)
)
((= fla0 2) ; teclado
(zdventana 0)
(car (cdr pto0))
(zdcancelar (car (cdr pto0)))
)
((= fla0 3) ; mouse izquierdo
(zdventana 0)
(setq p010 (car (cdr pto0)))
(setq ip00 -1)
)
)
)
(setq pp010 (trans p010 3 2))
(setq p012 (polar pp010 van2 dishd01))
(setq x012 (car p012))
(setq fla1 1)
(setq it00 1)
(while (and (< 0 it00) (not done)) ;;; Modified by David Trotz Jr.
(zdventana fla1)
(setq pto0 (grread 1 5 2))
(setq fla0 (car pto0))
(cond
((= fla0 5) ; Coordenada
(zdventana fla1)
(setq p010 (car (cdr pto0)))
(setq pp010 (trans p010 3 2))
(setq x010 (car pp010))
(if (> x010 x012)
(progn
(setq fla1 1)
(setq dx01 (- x010 x012))
(setq dishd01 (* dx01 fvshd))
)
(progn
(setq fla1 -1)
(setq dx01 (- x012 x010))
(setq dishd01 (* dx01 fvshd))
)
)
)
((= fla0 11) ; mouse derecho
(zdaceptar)
)
((= fla0 2) ; teclado
(zdventana fla1)
(car (cdr pto0))
(zdcancelar (car (cdr pto0)))
)
((= fla0 3) ; mouse izquierdo
(zdventana fla1)
(setq p010 (car (cdr pto0)))
(setq it00 -1)
)
)
)
)
(setvar "blipmode" sblip)
(setvar "cmdecho" scmde)
(princ) ;;; Added by David Trotz Jr. Exits Quietly
)
(defun zdaceptar (/ pp010 pp001 pp002 wp01 wp02)
(setq pp010 (trans p010 3 2))
(setq pp001 (polar pp010 van1 dishd01))
(setq pp002 (polar pp010 van3 dishd01))
(setq wp01 (trans pp001 2 3))
(setq wp02 (trans pp002 2 3))
(command "zoom" "_w" wp01 wp02)
(setq done T) ;;; Modified by David Trotz Jr.
)
(defun zdcancelar (a0)
(if (or (= a0 67) (= a0 99))
(progn
(command "zoom" "_p")
(setq done T) ;;; Modified by David Trotz Jr.
)
)
)
(defun zdmarco (/ pp001 pp002 pp003 pp004 pp005 pp006 pp007 pp008)
(setq pp001 (trans p001 2 3))
(setq pp002 (trans p002 2 3))
(setq pp003 (trans p003 2 3))
(setq pp004 (trans p004 2 3))
(setq pp005 (trans p005 2 3))
(setq pp006 (trans p006 2 3))
(setq pp007 (trans p007 2 3))
(setq pp008 (trans p008 2 3))
(grdraw pp001 pp002 200 1)
(grdraw pp002 pp003 200 1)
(grdraw pp003 pp004 200 1)
(grdraw pp004 pp001 200 1)
(grdraw pp005 pp006 200)
(grdraw pp006 pp007 200)
(grdraw pp007 pp008 200)
(grdraw pp008 pp005 200)
)
(defun zdventana (icod / p011 p012 p013 p014
p015 p016 p017 pp018 pp010 pp011
pp012 pp013 pp014 pp015 pp016 pp017
pp018
)
(setq pp010 (trans p010 3 2))
(setq p011 (polar pp010 van1 dishd01))
(setq p012 (polar pp010 van2 dishd01))
(setq p013 (polar pp010 van3 dishd01))
(setq p014 (polar pp010 van4 dishd01))
(setq pp011 (trans p011 2 3))
(setq pp012 (trans p012 2 3))
(setq pp013 (trans p013 2 3))
(setq pp014 (trans p014 2 3))
(grdraw pp011 pp012 -1)
(grdraw pp012 pp013 -1)
(grdraw pp013 pp014 -1)
(grdraw pp014 pp011 -1)
(if (= icod 0)
(progn
(setq p015 (polar pp010 an1 dd01))
(setq p016 (polar pp010 an2 dd01))
(setq p017 (polar pp010 an3 dd01))
(setq p018 (polar pp010 an4 dd01))
(setq pp015 (trans p015 2 3))
(setq pp016 (trans p016 2 3))
(setq pp017 (trans p017 2 3))
(setq pp018 (trans p018 2 3))
(grdraw pp015 pp017 -1)
(grdraw pp016 pp018 -1)
)
(progn
(if (> icod 0)
(progn
(setq p015 (polar pp010 0 dx01))
(setq p016 (polar p015 pi dd03))
(setq p017 (polar p015 an2 dd02))
(setq p018 (polar p015 an3 dd02))
)
(progn
(setq p015 (polar pp010 pi dx01))
(setq p016 (polar p015 0 dd03))
(setq p017 (polar p015 an1 dd02))
(setq p018 (polar p015 an4 dd02))
)
)
(setq pp015 (trans p015 2 3))
(setq pp016 (trans p016 2 3))
(setq pp017 (trans p017 2 3))
(setq pp018 (trans p018 2 3))
(grdraw pp015 pp016 -1)
(grdraw pp015 pp017 -1)
(grdraw pp015 pp018 -1)
)
)
)
(princ)

#2
avaernes,

Thanks for this post. I was not to happy when I saw that there was no zoom dynamic. That is my most common zoom command and was almost lost with out it.

Thanks
cron