Jump to content

Dimensions with text overrides


SuperCAD

Recommended Posts

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.

Link to comment
Share on other sites

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 by SLW210
Add Code Tags!!!
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by pBe
Link to comment
Share on other sites

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.

:)

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...