Several years ago I modified the VPSCALE.LSP routine from ExpressTools for 2002 to set the dimlfac and save the dimstyle from a viewport pick. I'm sure the whiz-bang proggers around here could really clean it up.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Modified to set current DIMLFAC and save DIMSTYLE
;;; Falcon Design Services
;;; August 19, 2001
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Adapted from
;;; VPSCALE.LSP
;;; Copyright © 1999 by Autodesk, Inc.
;;; Your use of this software is governed by the terms and conditions of the
;;; License Agreement you accepted prior to installation of this software.
;;; Please note that pursuant to the License Agreement for this software,
;;; "[c]opying of this computer program or its documentation except as
;;; permitted by this License is copyright infringement under the laws of
;;; your country. If you copy this computer program without permission of
;;; Autodesk, you are violating the law."
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;; ----------------------------------------------------------------
; find the scale of a viewport relative to paper space
; Carl Bethea 11 April 91
; Paul Vine 20 April 1999 Ported to 2000.
; rculp 19 August 2001 Modified to set current DIMLFAC and save DIMSTYLE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;--- paper -------------------------------------------------
; returns T if in paper space
(defun paper ()
(> 2 (getvar "cvport")(getvar "tilemode")) ; port=1 & tile=0
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;--- getx --------------------------------------------------
; return <nth> dotted pair of the extended entity data
; from an entity association list <data>
;
(defun getx (n data)
(nth n (cdadr (assoc -3 data)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dsclp ( / ent data cvsize cvhgt units vpna flag)
(cond
((not (equal 0 (getvar "tilemode")))
(princ "\n Command not allowed unless TILEMODE is set to 0 ")
)
((and (/= 1 (getvar "cvport"))
(setq vpna (acet-currentviewport-ename))
(equal 1 (logand 1 (cdr (assoc 90 (entget vpna)))))
)
(princ "\n Command not allowed in perspective view ")
)
(T
(acet-error-init
(list
(list "cmdecho" 0
"luprec" (getvar "luprec")
"dimzin" 8
)
T ;flag. True means use undo for error clean up.
);list
);acet-error-init
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (paper)
(progn
(while (not flag)
(princ "\nSelect edge of viewport.")
(setq ent (acet-ui-single-select '((0 . "viewport")) T )) ;setq
(if (and ent
(= 1 (logand 1 (cdr (assoc 90 (entget ent)))))
)
(progn
(princ "\nViewports with perspective view on are not allowed.")
(setq flag nil)
);progn
(setq flag T)
);if
);while
);progn
(setq ent (acet-currentviewport-ename))
)
(cond
((and
ent
(setq data (entget ent '("ACAD")))
(= "VIEWPORT" (acet-dxf 0 DATA))
);and
(setq cvhgt (acet-dxf 41 DATA) ; viewport height
cvsize (cdr (getx 6 data)) ; viewsize from extended data
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command ".dim1" "dimscale" 1.0)
(txstla)
(command "dimse1" "off")
(command "dimse2" "off")
(command "dimblk" ".")
(command "dimblk1" ".")
(command "dimblk2" ".")
(command "dimtxsty" txst)
(dmstla)
(setq dlfac (abs (getvar "dimlfac")))
(command ".dim1" "dimlfac" (- 0 (/ cvsize cvhgt)))
(setq dmfacst (strcat "DIM1-LF-" (rtos (abs (getvar "dimlfac")) 2 0)))
(command "dim1" "save" dmfacst "y")
(princ (strcat "\nCurrent PaperSpace DimScale is "(rtos (abs (/ 12 (getvar "dimlfac"))) 4 8) " = 1'-0\""))
(princ (strcat "\n Current DimStyle is "(getvar "dimstyle")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
(T (prompt " no viewport found."))
);cond
(acet-error-restore) ; Retsore values
)
);cond close
(princ)
);c:dsclp
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Set Current Layer to TEXT STYLE name
(defun txstla ()(SETVAR "CMDECHO" 0)
(setq txst (strcat "txt" (rtos (getvar "dimscale") 2 0)))
(setq txla (tblsearch "layer" "Txt"))
(if (/= txla nil)
(setq txclr (abs (cdr (assoc '62 txla))))
(setq txclr 4)
)
(setq ntxst (tblsearch "style" txst))
(if (/= ntxst nil)
(progn
(setq txst (cdr (assoc '2 ntxst)))
(command "textstyle" txst)
)
(progn
(command ".style" txst "romans" (* (getvar "dimscale") 0.1) "0.7" "" "" "" "")
)
)
(setq ntxla (tblsearch "layer" txst))
(if (= ntxla nil)
(command "_layer" "m" txst "c" txclr "txt*" "")
(command "_layer" "t" txst "s" txst "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Set Current Layer to DIMSTYLE name
(defun dmstla ()(SETVAR "CMDECHO" 0)
; (if (/= (getvar cvport) 1)
(setq dmst (strcat "dim" (rtos (getvar "dimscale") 2 0)))
; )
(setq dmla (tblsearch "layer" "Dim"))
(if (/= dmla nil)
(setq dmclr (abs (cdr (assoc '62 dmla))))
(setq dmclr 10)
)
(setq ndmla (tblsearch "layer" dmst))
(if (= ndmla nil)
(command "_layer" "m" dmst "c" dmclr "dim*" "")
(command "_layer" "t" dmst "s" dmst "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
