Pick one dimension, select the whole string...

Any help would be appreciated. I'd like to create a selection set of all
dimensions on a string (colinear dimension lines). The selection would
start by grabbing one linear dimension and would continue by passing the
start/end points to SSGET with a filter.

I'd eventually like to evaluate each dimension in the string to hilight any
"overlapping" dimensions. For those who are interested, I'll add this to
the routine below.

Craig


;*****************************­******************************­***********
; Original Program Name: multiple programs
; Authors: Dimension checking routine(s) all found on the
; the autodesk newsgroups: autodesk.autocad.customization
; -DCHECK (Dimension CHECK) by Richard Halle 73417,340
; -FDCHECK by Phil Lacy
; -(addDims) by Jason Piercey July 28, 2004
; Date: varies
;*****************************­******************************­***********
; New Program Name: C:Custom_DimCheck
; Rewrapped on 03-27-2005 by Craig Vaughn, AIA CSI
; Select dimensions and this routine will add them and
; highlight the "forced" and rounded dimensions. It will
; also add the files.
; Note: Since there's almost nothing left of the original code,
; this is donated as public domain, aka "Freeware"
; R2000+ only, tested in R2002
;
; History: 0.9 2005-03-27 nothing fancy, just testing
;
;*****************************­******************************­***********

(setq DIMVERCOLORRND 2
DIMVERCOLORRND2 30
DIMVERCOLOROVERIDE 1
DIMVERCOLORSKIP 6)
(defun
C:CUSTOM_DIMCHECK (/ NUM SS COUNT
ENT QTYOVER QTYRND QTYRND2
VALUESSTATED VALUESACTUAL
RNDTMP)
(vl-load-com)
(if (not RND)
(setq RND 0.0625
RNDTMP RND)
(setq RNDTMP RND))
(setq QTYSKIP 0
QTYOVER 0
CVDEBUG NIL
QTYRND 0
QTYRND2 0)
(if (setq SS (ssget
'((0 . "DIMENSION")
(-4 . "<OR")
(70 . 32) ;horizontal, vertical, rotated
(70 . 33) ;AcDbAlignedDimension
(70 . 35) ;diameter
(70 . 36) ;radius
(70 . 160)
(-4 . "OR>"))))
(progn
(setq RNDTMP
(progn
(initget 6)
(getreal
(strcat
"\nHighlight rounded dimensions over <"
(rtos RND)
">: "))))
(if (eq RNDTMP 0.00)
(setq RND 0.00000001)
(if RNDTMP
(setq RND RNDTMP)
(setq RNDTMP RND)))
(setq COUNT -1)
(while (< (setq COUNT (1+ COUNT)) (sslength SS))
(setq ENT (vlax-ename->vla-object (ssname SS COUNT))
DIMVALUEACTUAL
(vla-get-measurement ENT)
VALUESACTUAL
(cons DIMVALUEACTUAL VALUESACTUAL)
DIMVALUESTATED
(distof
(UNFORMAT
(DIMENT (entget (ssname SS COUNT))))
4))
(if DIMVALUESTATED
(setq VALUESSTATED (cons DIMVALUESTATED VALUESSTATED)))
(cond
((not DIMVALUESTATED)
(if CVDEBUG
(princ
(strcat "\n1 Value read: " (rtos DIMVALUESTATED))))
(vla-put-textcolor ENT DIMVERCOLORSKIP)
(setq QTYSKIP (+ 1 QTYSKIP)))
((and (not (wcmatch (vla-get-textoverride ENT) "*<>*"))
(not (= (vla-get-textoverride ENT) "")))
(if CVDEBUG
(princ
(strcat "\n2 Value read: " (rtos DIMVALUESTATED))))
(vla-put-textcolor ENT DIMVERCOLOROVERIDE)
(setq QTYOVER (+ 1 QTYOVER)))
((not (equal DIMVALUEACTUAL DIMVALUESTATED RND))
(if CVDEBUG
(princ
(strcat
"\n3 Value read: "
(rtos DIMVALUESTATED)
"/"
(rtos DIMVALUEACTUAL))))
(vla-put-textcolor ENT DIMVERCOLORRND2)
(setq QTYRND2 (+ 1 QTYRND2)))
((not (equal DIMVALUEACTUAL DIMVALUESTATED 0.002))
(if CVDEBUG
(princ
(strcat
"\n4 Value read: "
(rtos DIMVALUESTATED)
"/"
(rtos DIMVALUEACTUAL))))
(vla-put-textcolor ENT DIMVERCOLORRND)
(setq QTYRND (+ 1 QTYRND)))
(t (vla-put-textcolor ENT acbyblock))) ;end cond
) ;end while
(princ
"\n---------------------------Results----------------------------------")
(princ
(strcat "\nTotal dims selected/checked: " (itoa (sslength SS))))
(princ "\n")
(princ
(strcat
"\nQTY with override text \(red\): "
(itoa QTYOVER)))
(princ
(strcat
"\nQTY with rounded/inaccurate text strings *OVER* tolerance of "
(rtos RND)
" \(orange\): "
(itoa QTYRND2)))
(princ
(strcat
"\nQTY with rounded/inaccurate text strings *UNDER* tolerance \(yellow\):
"
(itoa QTYRND)))
(princ
(strcat
"\nQTY with text strings not readable by this routine - SKIPPED -
\(magenta\): "
(itoa QTYSKIP)))
(princ "\n")
(princ
(strcat
"\nTotal sum of actual dimension distances: "
(rtos (apply '+ VALUESACTUAL))))
(princ
(strcat
"\nTotal sum of dimension text strings: "
(rtos (apply '+ VALUESSTATED))))
(princ
"\n--------------------------------------------------------------------")
(textscr)) ;end progn
) ;end if
(princ))

;;;DCHECK (Dimension CHECK)
;;;Richard Halle 73417,340
(defun FLD (KEY DATA) (cdr (assoc KEY DATA)))
;;;Function to evaluate DIMENSION entities
(defun
DIMENT (EDATA / USER DBLOCK BLKDAT BLKENT TXT BNME)
(setq DBLOCK
(FLD 2 EDATA)
;;get name of pseudo block
BLKDAT
(tblsearch "block" DBLOCK)
;;get block header from TABLE
BNME
(FLD -2 BLKDAT)
;;get 1st entity
NEXT
t
TXT "")
(while BNME
(setq BLKENT (entget BNME))
(if (= "MTEXT" (FLD 0 BLKENT))
(setq TXT (strcat TXT (FLD 1 BLKENT))))
;;get text
(setq BNME (entnext (FLD -1 BLKENT))))
TXT
;;; )
;;; user
;;; )
)
;;;;;Phil Lacy: Added Mtext formatting check and parsing
;;;;;also all dimensions work if in front , parser stops reading after inch
" char
;;;;;
(defun
STRTOL (S / LST C)
(repeat (setq C (strlen S))
(setq LST (cons (substr S C 1) LST)
C (1- C)))
LST)
(defun
UNFORMAT (S / DEL DONE X L)
(setq DEL NIL
DONE NIL)
(foreach
X (STRTOL S)
(cond (DONE)
;;quit copying rest of string if done
((wcmatch X "S")
;;stacked fractions
(setq DEL NIL)
(setq L (cons " " L)))
;;COPY
((wcmatch X "A,H")
;;formatting code
(setq DEL t))
(DEL
(if (= X ";")
(setq DEL NIL)))
;;don't copy following members
((= X "\"")
;;this ends formatting
(setq L (cons "\"" L))
;; inch char. you're done
(setq DONE t))
;;COPY
((and (not DEL) (wcmatch X "#,['-/]"))
;;numbers arn't good if delflag on
(setq L (cons X L)))))
(apply 'strcat (reverse L)))
;;COPY

(defun TDIM (S) (distof (UNFORMAT S)))
;;format a number
(defun
FORMATDIM (S / X L H)
(setq H (rtos (getvar "dimtfac") 2 3))
(if (wcmatch S "*/*")
(progn
(foreach
X (STRTOL (strcat "\\A1;" S))
(cond ((wcmatch X " ")
(setq L (cons (strcat "{\\H" H "x;\\S") L)))
;;stacked frac
((= X "\"")
;; inch char. you're done
(setq L (cons ";}\"" L)))
(t (setq L (cons X L)))))
;;COPY
(apply 'strcat (reverse L)))
S))

(defun CIMCHECK () (C:CUSTOM_DIMCHECK) (princ))
(princ)