Lance. Here you go...
Code:
; List of Defined Functions
; C:GD C:VPSC DXF ENDERR GETMODE INITERR MVGUIDE
; SCLTXT SETMODE VPDTA VPSC
; MVGUIDE - main routine
(defun mvguide (/ ctr dx dy fl p1 p2 p3 p4 scl vno vpinf xc xsz yc ysz)
(setq
vpinf (vpdta "which requires guideline")
fl (nth 0 vpinf)
vno (nth 1 vpinf)
ctr (nth 2 vpinf)
scl (nth 4 vpinf)
xsz (nth 5 vpinf)
ysz (nth 6 vpinf)
xc (car ctr)
yc (cadr ctr)
dx (* xsz scl 0.5)
dy (* ysz scl 0.5)
p1 (list (- xc dx) (- yc dy))
p2 (list (+ xc dx) (- yc dy))
p3 (list (+ xc dx) (+ yc dy))
p4 (list (- xc dx) (+ yc dy))
)
(command
"MSPACE"
"LAYER" "M" "VPORT" ""
"PLINE" p1 "W" 0 0 p2 p3 p4 "C"
"CHANGE" (entlast) "" "P" "LA" "VPORT" ""
)
(if fl (command "PSPACE"))
(if (= "11" (substr (getvar "ACADVER") 1 2))
(princ (strcat "\nScale of Viewport #" (itoa vno) " is " (scltxt scl)))
(alert
(strcat
"Scale of Viewport #" (itoa vno) " is 1:"
(if (= scl (fix scl)) (itoa (fix scl)) (rtos scl 2 3))
)))
)
; C:GD - command line access to function
(defun C:viewgd ()
(initerr)
(setq prgmod (getmode '("TILEMODE" "CLAYER" "OSMODE")))
(setvar "OSMODE" 0)
(mvguide)
(setmode prgmod)
(enderr)
(princ)
)
; VPSC - find scale of Viewport
(defun vpsc (/ fl scl str vno vpinf)
(setq
vpinf (vpdta "for which scale required")
fl (nth 0 vpinf)
vno (nth 1 vpinf)
scl (nth 4 vpinf)
str (strcat "Scale of Viewport #" (itoa vno) " is " (scltxt scl))
)
(if (= "11" (substr (getvar "ACADVER") 1 2))
(princ (strcat "\n" str))
(alert str)
)
(command (if fl "PSPACE" "MSPACE"))
)
; C:VPSC - command line access to function
(defun C:VPSC ()
(initerr)
(setq prgmod (getmode '("TILEMODE" "CLAYER")))
(setvar "OSMODE" 0)
(vpsc)
(setmode prgmod)
(enderr)
(princ)
)
; VPDTA - select viewport and return data
(defun vpdta (prom / cnt ctr cvp en flag scl ss vno vsz xsz ysz)
(if (= (getvar "TILEMODE") 1)
(progn
(setvar "TILEMODE" 0)
(command "PSPACE")
))
(if (/= (getvar "CVPORT") 1)
(setq flag nil)
(progn
(setq flag T)
(command "MSPACE")
(getpoint (strcat "\nPick twice in Viewport " prom "\n"))
))
(setq
ctr (getvar "VIEWCTR") ;centrepoint of viewport
vsz (getvar "VIEWSIZE") ;height of viewport
vno (getvar "CVPORT") ;no. of current viewport
)
(command "PSPACE")
(setq
ss (ssget "X" '((0 . "VIEWPORT")))
cnt -1
)
(while (and cnt (< (setq cnt (1+ cnt)) (sslength ss)))
(setq en (entget (ssname ss cnt)))
(if (= (dxf 69 en) vno) (setq cnt nil))
)
(setq
xsz (dxf 40 en)
ysz (dxf 41 en)
scl (/ vsz ysz)
)
(if (not flag) (command "MSPACE"))
(if (/= (dxf 8 en) "VP") (entmod (subst (cons 8 "VP") (assoc 8 en) en)))
(list flag vno ctr vsz scl xsz ysz)
)
; SCLTXT - convert scale factor to common text forms
(defun scltxt (scl / dimz lup txtscl)
(setq dimz (getvar "DIMZIN") lup (getvar "LUPREC"))
(if (not scl) (setq scl (getvar "DIMSCALE")))
(if (< (abs (- scl (fix (+ scl 0.002)))) 0.001)
(setq scl (fix (+ scl 0.002)))
)
(if (= (getvar "LUNITS") 4)
(setvar "LUPREC" (cond ((> scl 192) 5) ((> scl 96) 4) (T 3)))
)
(if scl
(if (member scl (list 4 8 12 16 24 32 48 64 96 192 384)) ;Architectural scales
(setq txtscl (strcat (rtos (/ 12.0 scl)) "=1'-0\""))
(if (member scl (list 120 240 360 480 600 720 900 1200 1800 2400 3000 6000))
(progn ;Engineering scales
(setvar "DIMZIN" 0)
(setq txtscl (strcat "1\"=" (rtos scl)))
(setvar "DIMZIN" dimz)
)
(setq txtscl ;all others including metric, full & half scale
(cond
((= scl 1) "FULL")
((= scl 2) "HALF")
(T (strcat "1:" (rtos scl 2 2)));if more precision needed, change last 2
))))
(setq txtscl "not defined")
)
(setvar "LUPREC" lup)
txtscl
)
; GETMODE - establish changeable variables which are to be reset
; at end of program and initialize error program
(defun getmode (mod1 / mod)
(repeat (length mod1)
(setq
mod (append mod (list (list (car mod1) (getvar (car mod1)))))
mod1 (cdr mod1)
))
mod
)
; SETMODE - reset variables and error system
(defun setmode (mod1)
(repeat (length mod1)
(setvar (caar mod1) (cadar mod1))
(setq mod1 (cdr mod1))
)
)
; DXF - extract DXF code from list
(defun dxf (code elist) (cdr (assoc code elist)))
; INITERR - set up error at start of program
(defun initerr ()
(setq
olderr *error*
*error* gderr
errmod (getmode '("BLIPMODE""CMDECHO""MENUECHO""ORTHOMODE""OSMODE""SNAPMODE"))
)
(setvar "CMDECHO" 0)
(command "_.UNDO" "G")
)
; ENDERR - clean up error at end of program
(defun enderr ()
(command "CMDECHO" 0)
(if errmod (setmode errmod))
(setq
errmod nil
prgmod nil
libmod nil
)
(command "_.UNDO" "E")
(setq *error* olderr)
)
; *ERROR* - main error routine
(defun gderr (msg)
(command nil nil nil)
(setvar "CMDECHO" 0)
(reset msg)
(grtext)
(if (and (/= msg"console break")(/= msg "Function cancelled"))
(grtext -1 "Program ERROR")
)
(princ)
)
; RESET - clean up after error
(defun reset (msg / x)
(if msg
(if (and (/= msg "console break")(/= msg "Function cancelled"))
(prompt (strcat "Error: " msg "\n"))
(prompt (strcat msg "\n"))
)
(prompt"\nResetting environment...")
)
(command "UNDO" "E")
(command "U")
(if errmod (setmode errmod))
(if prgmod (setmode prgmod))
(if libmod (setmode libmod))
(if blkmod (setmode blkmod))
(setq
errmod nil
prgmod nil
libmod nil
blkmod nil
)
(princ)
)
(princ "\nVIEWGD loaded. Type VIEWGD to make guide. Type VPSC to display scale.")
(princ)