This help??
;;; CHKDIM.LSP "Check Dimensions" - detects overridden dimensions
;;;
;;; tested with AutoCAD 12/13/14
;;;
;;; Copyright (c) 1997 by Christoph Candido, Vienna
;;; E-Mail: snipped-for-privacy@edv1.boku.ac.at
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;------------------------------------------------------------------
;;; Purpose:
;;;
;;; Routine to global check dimension texts.
;;; All dimension texts, which are altered by the user, will
;;; be copied to the layer CHKDIM and viewed separately.
;;;
(defun C:CHKDIM (/
*chkdim_err* oerr osys ss i en ent txt enlist)
(defun
*chkdim_err* (s) ; error routine
(command "_.UNDO" "_End")
(sysvar osys)
(setq
*error* oerr)
(princ)
)
(setq oerr
*error*
*error* *chkdim_err*
osys (sysvar '(("CMDECHO" 0)))
ss (ssget "X" '((0 . "DIMENSION")(8 . "~CHKDIM")))
i 0
)
(if ss
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
txt (cdr (assoc 1 ent))
i (1+ i)
)
(if (and (/= txt "")
(not (strstr txt ""))
)
(setq enlist (cons en enlist))
)
)
)
(if enlist
(progn
(mapcar 'princ (list "\n" (length enlist)
" altered dimension text(s) found ...please wait")
)
(if (null
*CHKDIM_LAYLIST* )
(setq
*CHKDIM_LAYLIST* (laysave))
)
(if (= 0 (getvar "UNDOCTL"))
(command "_.UNDO" "_All")
)
(command "_.UNDO" "_Control" "_All" "_.UNDO" "_End" "_.UNDO" "_Group")
(setq ss (ssget "x" '((8 . "CHKDIM"))))
(if ss (command "_.ERASE" ss ""))
(setq ss (ssadd))
(mapcar
'(lambda (en / ent)
(setq ent (entget en '("
*"))
ent (subst '(8 . "CHKDIM") (assoc 8 ent) ent)
ent (subst
(cons 1 (strcat (cdr (assoc 1 ent)) " []"))
(assoc 1 ent)
ent
)
)
(entmake ent)
(ssadd (entlast) ss)
)
enlist
)
(command "_.DIM" "_UPDATE" ss "" "Exit")
(command "_.LAYER" "_Thaw" "CHKDIM" "_Set" "CHKDIM"
"_Freeze" "~CHKDIM" ""
)
(command "_.ZOOM" "_Extents")
(command "_.UNDO" "_End")
(princ "\nType LRES to restore previous layer settings.")
)
(princ "\nNo altered dimension texts found. ")
)
(sysvar osys)
(setq * error
* oerr)
(princ)
)
;;; C:LRES
;;;
;;; (C)1997, Christoph Candido, A-1070 Vienna
;;;
;;; Restores layer settings saved in the global variable
;;; * CHKDIM_LAYLIST*.
;;;
(defun C:LRES (/
*lres_err* osys oerr ss)
(defun
*lres_err* (s)
(sysvar osys)
(setq
*error* oerr)
(princ)
)
(if
*CHKDIM_LAYLIST*
(progn
(setq osys (sysvar '(("CMDECHO" 0)("EXPERT" 1)))
oerr
*error*
*error* *lres_err*
)
(setq ss (ssget "x" '((8 . "CHKDIM"))))
(if ss (command "_.ERASE" ss ""))
(layres
*CHKDIM_LAYLIST* )
(setq
*CHKDIM_LAYLIST* nil)
(sysvar osys)
(setq
*error* oerr)
)
(princ "\nNo layer settings to restore.")
)
(princ)
)
;;; STRSTR -- Scans a string for the occurrence of a given substring.
;;;
;;; If neither argument is a string,
*ERRORNO* is set to -1
;;; and nil is returned.
;;;
;;; (C) Copyright 1990, 1991 by Autodesk, Inc.
;;;
(defun strstr (_$s1 _$s2 / _$j _$sl _$sl2)
(setq
*ERRORNO* nil)
(if (and (= (type _$s1) 'STR)
(= (type _$s2) 'STR)
)
(progn
(setq _$j 0
_$sl (strlen _$s1)
_$sl2 (strlen _$s2)
)
(while (< _$j _$sl)
(if (= (substr _$s1 (setq _$j (1+ _$j)) 1)
(substr _$s2 1 1)
)
(if (= (substr _$s1 _$j _$sl2) _$s2)
(progn
(setq _$s1 (substr _$s1 _$j))
(setq _$j _$sl)
_$s1
)
)
)
)
)
(progn
(setq
*ERRORNO* -1)
nil
)
)
)
;;; LAYSAVE
;;;
;;; (C)1997, Christoph Candido, A-1070 Vienna
;;;
;;; Save layer settings, use LAYRES to restore.
;;;
(defun laysave (/ ll lay color name flags)
(setq ll (list (getvar "CLAYER")))
(setq lay (tblnext "layer" T))
(while lay
(setq ll
(cons
(list
"_Color"
(itoa (abs (setq color (cdr (assoc 62 lay)))))
(setq name (cdr (assoc 2 lay)))
"_Ltype"
(cdr (assoc 6 lay))
name
(if (= 1 (logand 1 (setq flags (cdr (assoc 70 lay)))))
"_Freeze"
"_Thaw"
)
name
(if (= 4 (logand 4 flags)) "_Lock" "_Unlock")
name
(if (minusp color) "_OFF" "_ON")
name
)
ll
)
lay (tblnext "LAYER")
)
)
(reverse ll)
)
;;; LAYRES
;;;
;;; (C)1997, Christoph Candido, A-1070 Vienna
;;;
;;; Restore layer settings saved by LAYSAVE.
;;;
(defun layres (ll
/ clay)
(setq clay (car ll)
ll (cdr ll)
)
(command "_.LAYER" "_Thaw" clay "_Set" clay)
(foreach n ll (apply 'command n))
(command "")
(princ)
)
;;; SYSVAR
;;;
;;; Set and restore system variables.
;;;
(defun sysvar (l)
(mapcar
'(lambda (x / var val vlist)
(setq var (if (listp x) (car x) x)
val (if (listp x) (eval (cadr x)) nil)
vlist (list var (getvar var))
)
(if val (setvar var val))
vlist
)
l
)
)
(princ "\n
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ")
(princ "\n (c)1997 Christoph Candido, A-1070 Wien")
(princ "\n E-Mail: snipped-for-privacy@edv1.boku.ac.at")
(princ "\n
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ")
(princ "\nCHKDIM ...global check dimension texts. ")
(princ)
Show Quoted Text