Hi,
My 2 cents (I'm new to all this cause I just upgrade from 2007 to 2010)
2 sub routines: one to get the current scale list, the other to set a scale list (the lists returned by GetScaleList or requiered by SetScaleList are the same format as VVA's)
EDIT: added PURGESCALES command (and some sub routines too)
;;;============================================================;;;
;;;======================= SUB ROUTINES =======================;;;
;;;============================================================;;;
;; GetCurrentScaleList (gile)
;; Returns the current scales as a list of sublists
;; Each sublist type is : (ScaleName PaperUnit DrawingUnit)
(defun GetCurrentScaleList (/ elst result)
(and
(setq elst (dictsearch (namedobjdict) "ACAD_SCALELIST"))
(setq elst (vl-member-if '(lambda (x) (= 3 (car x))) elst))
(while elst
(setq result (cons
(ScaleList (cdadr elst))
result
)
elst (cddr elst)
)
)
)
(reverse result)
)
;;;============================================================;;;
;; SetScaleList (gile)
;; Sets the scale list according to the lst argument
;;
;; Argument : lst a list of sublists which type is: (ScaleName PaperUnit DrawingUnit)
(defun SetScaleList (lst / dict)
(entmod (vl-remove-if
'(lambda (x) (or (= (car x) 3) (= (car x) 350)))
(setq dict (dictsearch (namedobjdict) "ACAD_SCALELIST"))
)
)
(setq dict (cdr (assoc -1 dict))
n -1
)
(foreach s lst
(dictadd dict
(strcat "A" (itoa (setq n (1+ n))))
(entmakex
(list
'(0 . "SCALE")
'(100 . "AcDbScale")
(cons 300 (car s))
(cons 140 (cadr s))
(cons 141 (caddr s))
)
)
)
)
)
;;;============================================================;;;
;; ScaleList (gile)
;; Returns the "SCALE" object list as (ScaleName PaperUnit DrawingUnit)
;;
;; Argument scl (ENAME) a "SCALE" object
(defun ScaleList (scl / elst)
(setq elst (entget scl))
(list
(cdr (assoc 300 elst))
(cdr (assoc 140 elst))
(cdr (assoc 141 elst))
)
)
;;;============================================================;;;
;; GetAnnotativeScaleList (gile)
;; Returns the list of the currently used annotative scales as a list
;; of sublists which type is (ScaleName PaperUnit DrawingUnit)
(defun GetAnnotativeScaleList (/ n ss ent xDict dict slst result)
(setq n 0)
(if (setq ss (ssget "_X" '((-3 ("AcadAnnotative")))))
(while (setq ent (ssname ss n))
(setq n (1+ n))
(if (and
(setq xDict (GetExtDict ent))
(setq dict (dictsearch xDict "AcDbContextDataManager"))
(setq dict (dictsearch (cdr (assoc -1 dict)) "ACDB_ANNOTATIONSCALES"))
)
(foreach p dict
(if (= (car p) 350)
(setq slst (ScaleList (cdr (assoc 340 (entget (cdr p)))))
result (if (not (vl-position slst result))
(cons slst result)
result
)
)
)
)
)
)
)
result
)
;;;============================================================;;;
;; GetExtDict (gile)
;; Returns the entity extension dictionary ename (or nil)
;;
;; Argument : ent (ENAME)
(defun GetExtDict (ent)
(cdr
(assoc 360
(member '(102 . "{ACAD_XDICTIONARY") (entget ent))
)
)
)
And two three little commands:
- SAVESCALES: runs the SCALELISTEDIT native command and stores the resulted scale list in an environment variable (registry).
- RESTORESCALES: restores the scale list stored in the environment variable (or runs SAVESCALES if no previous saving)
- PURGESCALES: purges all unused annotative scales except "1:1"[color]
;;;============================================================;;;
;;;========================= COMMANDS =========================;;;
;;;============================================================;;;
;; SAVESCALES (gile)
;; Runs SCALELISTEDIT command and save the resulting list in an
;; environment variable
(defun c:SaveScales ()
(initdia)
(vl-cmdf "_.scalelistedit")
(while (/= (getvar 'cmdactive) 0)
(vl-cmdf pause)
)
(setenv "SavedScaleList"
(vl-prin1-to-string (GetCurrentScaleList))
)
(princ)
)
;;;============================================================;;;
;; RESTORESCALES (gile)
;; Restores the scale list previously saved with SAVESCALES
;; or runs SCALAESAVE if no previous saving
(defun c:RestoreScales (/ lst)
(if (and
(setq lst (getenv "SavedScaleList"))
(setq lst (read lst))
)
(SetScaleList lst)
(c:SaveScales)
)
(princ)
)
;;;============================================================;;;
;; PURGESCALES (gile)
;; Purges all unused annotative scales except "1:1"
(defun c:PurgeScales (/ alst cnt)
(setq alst (GetAnnotativeScaleList)
cnt 0
)
(foreach p (dictsearch (namedobjdict) "ACAD_SCALELIST")
(and
(= 350 (car p))
(setq slst (ScaleList (cdr p)))
(/= "1:1" (car slst))
(null (member slst alst))
(entdel (cdr p))
(setq cnt (1+ cnt))
)
)
(princ (strcat (itoa cnt) " échelle(s) purgée(s)."))
(princ)
)
