SuperCAD Posted November 22, 2011 Share Posted November 22, 2011 Is there a way, through either a LISP or an option directly in ACAD, that would force all dimensions with overridden values to show up as a different color? One of the people we fired had a nasty habit of just changing the dimension text and not actually fixing the drawing. It would be nice to be able to hit a button and see if it finds any overridden dimensions. Quote Link to comment Share on other sites More sharing options...
cadvision Posted November 23, 2011 Share Posted November 23, 2011 (edited) I used to have a lisp that checked all assocated dims for correct value....Havent used in years....May still work. Just see if I can find it. Found it. Can't promise it still works, but you might be able to plunder the code ;;------------------------------------------------ ;; Programmer's Tool Box Feb 1996 ;; CADENCE MAGAZING: Bill Kramer ;; Dimension Edits and Checking ;; ;;------------------------------------------------ ;; LISTING 1: MAIN FUNCTION C:DIMCHK ;;------------------------------------------------ (defun C:DIMCHK ( / DIML ;dimension layer name TOL ;tolerance value SS1 ;selection set II ;index into pick set JJ ;index to distances D1 ;distances list D2 ;found flag P1 P2 ;points of dim entity TY TX ;type / text XB ;text block of dim XT ;text in text block VAL ;value of dim text EL EN) ;entity list and name (prompt "\nDIMCHK: Check associative dimension values") (while (null DIML) (setq DIML (getstring "\nLayer name for dimensions: ")) (if (or (= DIML "") (null (tblsearch "LAYER" DIML))) (setq DIML ;;nil (prompt "\nLayer does not exist!")) ) ) (setq TOL (getdist "\nEnter tolerance <0.001>: ")) (if (null TOL) (setq TOL 0.001)) (setvar "CMDECHO" 0) (if (null (tblsearch "LAYER" "DIM_BAD")) (command "_LAYER" "_N" "DIM_BAD,DIM_OUTTOL" "_C" "YELLOW" "DIM_OUTTOL" "_C" "RED" "DIM_BAD" "") ) (setq SS1 (ssget "X" (list (cons 8 DIML)))) (if SS1 (progn (setq II 0) (repeat (sslength SS1) (if (GET_DIM_DATA) (progn (setq JJ 1 D2 nil) (if (DIM_VALUES) (DIM_VALUE_CHECK)) (redraw EN) ) (prompt " unable to translate text.")) );;end REPEAT ) (prompt "\nNothing found!") ) (princ) ) ;;------------------------------------------------ ;; Listing 2: Retrieve entity information into ;; global variables used by remainder of function ;; set. ;; (defun GET_DIM_DATA () (setq EN (ssname SS1 II) II (1+ II) EL (entget EN) ) (redraw EN -3) (cond ((= (cdr (assoc 0 EL)) "DIMENSION") (setq P10 (cdr (assoc 10 EL)) P13 (cdr (assoc 13 EL)) P14 (cdr (assoc 14 EL)) P15 (cdr (assoc 15 EL)) TY (cdr (assoc 70 EL));;type TX (cdr (assoc 1 EL)) ;;text XB (cdr (assoc 2 EL)) ;;block name XT (BLOCK_TEXT XB) ;;text in block ) ;;check to see if dimension location flag ;;is set. Remove if found. (if (> TY 70) (setq TY (- TY 128))) ;; (if (or (= TX "") ;;nothing in text or (wcmatch TX "*<>*")) ;;variable (progn ;;then look in block (prompt "\nAssociative dim,") (setq VAL XT) ) (progn ;;else look in text (prompt "\nAssoc w/ text override,") (setq VAL TX) ) ) ;;Convert VAL to distance value (setq VAL (distof (Convert_Mtext_Dim VAL))) ) (t (prompt "\nNon-associative dimension object: ") (prompt (cdr (assoc 0 EL))) ) ) ) ;;------------------------------------------------ ;; Listing 3: Calculate dim distances ;; (defun DIM_VALUES ( / TYP) (setq TYP (logand TY 7)) (cond ((zerop TYP) ;;vert/hor (prompt " VER|HOR") (setq D1 (list (abs (- (car P13) (car P14))) (abs (- (cadr P13) (cadr P14))) (distance P13 P14) ) ) ) ((= 4 TYP) ;;radius (prompt " RAD") (setq D1 (list (distance P10 P15) ) ) ) ((= 3 TYP) ;;diameter (prompt " DIA") (setq D1 (list (distance P10 P15) ) ) ) ((= 1 TYP) ;;aligned (prompt " ALI") (setq D1 (list (distance P13 P14) ) ) ) ((= 2 TYP) ;;angular (prompt " ANG, not checked.") (setq D1 nil) ) (t (prompt " dim check not available.") (setq D1 nil) ;;ignored ) );;end COND ) ;;------------------------------------------------ ;; Listing 4: test dimension against tolerance ;; (defun DIM_VALUE_CHECK () (foreach DD D1 (cond ((equal DD VAL (/ TOL 10.0)) (setq D2 JJ)) ((and (null D2) (equal DD VAL TOL)) (setq D2 (* -1 JJ))) ) (setq JJ (1+ JJ)) ) (if D2 ;;found something (if (minusp D2) (progn (prompt ", YELLOW: not exact, within tol.") (entmod (subst (cons 8 "DIM_OUTTOL") (assoc 8 EL) EL)) );end PROGN (prompt ", exact or <= 10% tol. accepted.") ) (progn ;;nothing close (prompt ", RED: outside tolerance.") (entmod (subst (cons 8 "DIM_BAD") (assoc 8 EL) EL)) ) ) ) ;;------------------------------------------------ ;; Listing 5: return text value from block ;; definition entities. ;; (defun BLOCK_TEXT (NM / EL EN) (setq EL (tblsearch "BLOCK" NM)) (if EL (progn (setq EN (cdr (assoc -2 EL)) EL (entget EN) ) (while (and EN (not (or (= "MTEXT" (cdr (assoc 0 EL))) (= "TEXT" (cdr (assoc 0 EL)))))) (setq EN (entnext EN)) (if EN (setq EL (entget EN))) ) (if EN (cdr (assoc 1 EL)) ) )) ) ;;------------------------------------------------ ;; Listing 6: Convert MTEXT dimension value ;; number, seek out the real number information ;; bypassing all [url="file://xx/"]\\xx[/url]; type stuff and looking ;; inside { } brackets ;; (defun CONVERT_MTEXT_DIM (TX / RES CH Skip) (setq RES "") (while (> (strlen TX) 0) (setq CH (substr TX 1 1) TX (substr TX 2) ) (cond ((= CH "\\") ;;start of control sequence (setq CH (substr TX 1 1)) (cond ((= CH "U") ;;unicode skip over (setq TX (substr TX 7) CH "") ) ((member CH ;;control character? '("e" "n" "r" "t")) (setq TX (substr TX 2) CH "") ) ((member CH ;;octal number? '("0" "1" "2" "3" "4" "5" "6" "7")) (setq TX (substr TX 4) CH "") ) (t (setq Skip 'T) ;;other command ) ) ) ((= CH "}") ;;end of paragraph (setq Skip 'T) (if (distof RES) (setq TX "") (setq RES "") ) ) ((= CH "%") ;;control character? (if (= (substr TX 1 1) "%") (setq TX (substr TX 2) CH "") ) ) ((= CH "R") ;;radius marker? (setq CH "") ;;gamble it is ) ) ;; (if (and (null Skip) (< (ascii CH) 128)) (setq RES (strcat RES CH))) ;; (cond ((= CH ";") ;;end of control sequence (setq Skip nil) ) ((= CH "{") ;;start of paragraph (setq Skip nil) ) ) ) RES ) ;;----------------------------------------------- EOF Edited November 23, 2011 by SLW210 Add Code Tags!!! Quote Link to comment Share on other sites More sharing options...
rkent Posted November 23, 2011 Share Posted November 23, 2011 autodesk labs has one available. http://labs.autodesk.com/utilities/dimensionpatrol/ Quote Link to comment Share on other sites More sharing options...
Jack_O'neill Posted November 23, 2011 Share Posted November 23, 2011 I have one on my cad computer called "fink". I'll post it for you tomorrow when I get back home. Quote Link to comment Share on other sites More sharing options...
SuperCAD Posted November 23, 2011 Author Share Posted November 23, 2011 That's awesome rkent! That was exactly what I needed. Now to see if it will work on 2008. Quote Link to comment Share on other sites More sharing options...
DANIEL Posted November 23, 2011 Share Posted November 23, 2011 yeah, thanks I've downloaded that to and plan to put it to good use! Quote Link to comment Share on other sites More sharing options...
Patrick Hughes Posted November 24, 2011 Share Posted November 24, 2011 I've got one on my free download page called ChkDims.lsp It will place a block of a red circle with an X over overridden dimensions and a green box over non-overridden dimensions. You have an option to clean-up the markers. Quote Link to comment Share on other sites More sharing options...
DANIEL Posted November 30, 2011 Share Posted November 30, 2011 You have an option to clean-up the markers. you? or the culprit Quote Link to comment Share on other sites More sharing options...
troggarf Posted December 1, 2011 Share Posted December 1, 2011 Here is one that does what you are looking for http://autocadtips.wordpress.com/2011/10/27/autolisp-find-dodgy-dimensions/ Here is another that might be a little too much but is still usefull http://autocadtips.wordpress.com/2011/10/27/autolisp-dodgy-dimension-detector/ Quote Link to comment Share on other sites More sharing options...
pBe Posted December 1, 2011 Share Posted December 1, 2011 (edited) Non Annotative dimensions: (sssetfirst nil (ssget "_X" '((0 . "*DIMENSION") (-4 . "<OR") (1 . "*?*") (-3 ("ACAD")) (-4 . "OR>")))) (defun c:OD (/ Fdim) (setq FDim (ssget "_X" '((0 . "*DIMENSION") (-4 . "<OR") (1 . "*?*") (-3 ("ACAD")) (-4 . "OR>") ) ) ) (repeat (sslength FDim) (vla-put-TextColor (vlax-ename->vla-object (ssname Fdim 0)) 5 ) (ssdel (ssname Fdim 0) Fdim) ) ) For Both types: (defun c:OD (/ Fdim) (vl-load-com) (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)) clr 5) (if (ssget "_X" '((0 . "*DIMENSION"))) (progn (vlax-for itm (setq fdim (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) (if (not (eq (vla-get-TextOverride itm) "")) (vla-put-TextColor itm clr) ) ) (vla-delete fdim) ) ) ) Edited December 1, 2011 by pBe Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted December 1, 2011 Share Posted December 1, 2011 Just highlighting those that have overrides : (defun c:chkdims ( / ss ssn ent entA ) (vl-load-com) (setq ss (ssget "_X" '((0 . "*DIMENSION")) )) (repeat (setq ssn (sslength ss)) (setq ent (ssname ss (setq ssn (1- ssn)))) (setq entA (vlax-ename->vla-object ent)) (if (or (= "" (vla-get-textoverride entA)) (wcmatch (vla-get-textoverride entA) "*<>*")) (redraw ent 1) (redraw ent 3) ) ) (princ) ) M.R. Quote Link to comment Share on other sites More sharing options...
pBe Posted December 1, 2011 Share Posted December 1, 2011 (wcmatch (vla-get-textoverride entA) "*<>*")) Good catch MR. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted December 1, 2011 Share Posted December 1, 2011 (sssetfirst nil (ssget "_X" '((0 . "*DIMENSION") (1 . "*[~]*,*]*,*[~*,")))) Quote Link to comment Share on other sites More sharing options...
pBe Posted December 1, 2011 Share Posted December 1, 2011 (sssetfirst nil (ssget "_X" '((0 . "*DIMENSION") (1 . "*[~<>]*,*<[~>]*,*[~<]>*,<,>")))) You got it Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.