;;;;;;;;;;;;;;;;;;;;;;;;;;DIMTAG.LSP;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     
;;;     Purpose:  Replaces DIMENSION text with the string contained in 
;;;               dimension block and color-codes the dimension line.
;;;               Dimensions may then be stretched without altering the
;;;               displayed text. May be useful for those who need to 
;;;               draw at a distorted scale.

;;;     Author:   Herman Mayfarth
;;;               h_mayfarth@tktn.com
;;;     Version:  0.9 Beta test version
;;;     Date:     20 July 99
;;;
;;;               Written for and tested with AutoCAD R14.01
;;;
;;;    Usage:     AutoCAD Release 13 & later, any platform
;;;
;;;               Copyright (c) 1999 by Herman Mayfarth
;;;               Provided "as is." No warranty, express or implied.
;;;
;;;     ***NO REDISTRIBUTION WITHOUT AUTHOR"S EXPRESS WRITTEN PERMISSION***
;;;
;;;  Known bugs and limitations:
;;;
;;;  1. If a dimension contains prefixes/suffixes and the suffix includes a
;;;     \X <string> (text under dimension line), the program returns the text below the line,
;;;     i.e., the dimension value gets lost.
;;;  2. Program does no checking for current value of the displayed string, and does
;;;     not strip the \A1; from MTEXT, so multiple applications of this program to a 
;;;     single entity (not multiple selection on a single pass) will result in multiple
;;;     \A1;\A1; etc. in the actual string. This appears to be harmless.
;;;  3. If a dimension entity which is on a locked layer is included in the
;;;     original entity selection, (ssget) filters it properly, but issuing 
;;;     UNDO after DIMTAG is run will only undo one step, not the entire command.
;;;  4. Color coding has no visible effect with ordinate dimensions, due
;;;     to the fact that the datum line is defined as an "extension" line,
;;;     not a "dimension" line.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:DIMTAG ( /
;;local symbols
                    dimlinecolor    ;dimension line color to assign to changed entities
                    olderr          ;saved error handler
                    ss1             ;filtered selection set of dimensions
;;local functions                   
                    dimtext         
                    *lerror*        
                   )
                   
;;;--------------- Local Functions ---------------------------------
;;;--------------------- lerror ------------------------------------
;; Purpose: local error handler
(defun *lerror* (msg)
  (if 
    (or (= msg "Function cancelled")
        (= msg "quit / exit abort")
    )
    (princ)
    (princ (strcat "\nError: " msg))
  )
  (setq *error* olderr)
  (command "_.UNDO" "END")
  (command "_.UNDO" "")
  (setvar "CMDECHO" 1)
  (princ)
);*lerror*
;;;------------------dimtext---------------------------------------
;; Purpose : Extracts string for displayed mtext from a dimension block.
;; Argument:      blkname; block name for dimension
;; Returns :       txtval; string
;; ----------------------------------------------------------------
  (defun dimtext (blkname / 
                            elist  ;association list
                            ent    ;entity name for dim block entities
                            etype  ;entity type
                            txtval ;text string in MTEXT
                            cdra   ;local function =(cdr(assoc))
                            )
    (defun cdra (# alist)
      (cdr (assoc # alist))
    ) ;cdra
    (setq
      ent (cdra -2 (tblsearch "block" blkname))
      txtval ""
    )
    (while (setq ent (entnext ent))
      (setq
        elist (entget ent)
        etype (cdra 0 elist)
      )
      (if (= etype "MTEXT")
        (setq txtval (cdra 1 elist))
      )
   )
   txtval
  ) ;dimtext
;-----------------------------------------------------------------
(command "_.UNDO" "BEGIN")
(setvar "CMDECHO" 0)
(setq olderr *error*
      *error* *lerror*)  
(setq dimlinecolor 51);change to suit your needs

;;main processing loop
(princ "\nSelect Dimensions to Tag:")
(setq ss1 (ssget '((0 . "DIMENSION"))))
(setq i 0)
(while (<= (1+ i) (sslength ss1))
  (setq dimelist (entget (ssname ss1 i))
        dimtxtval (dimtext (cdr (assoc 2 dimelist))))
  (entmod (subst (cons 1 dimtxtval) (assoc 1 dimelist) dimelist))
  (command "_.DIMOVERRIDE" "DIMCLRD" dimlinecolor "" (ssname ss1 i) "")
  (setq i(1+ i))
)
(princ (strcat "\n"  (itoa i) " Dimensions Tagged."))
(setq *error* olderr)
(command "_.UNDO" "END") 
(setvar "CMDECHO" 1)
(princ)
);C:DIMTAG
(princ "\nDIMTAG loaded.")
(princ)