LISP to change text colour based on value range

Hi I'm looking to be able to change the colour of text based on the value. So if I have 200 text objects of differing values I can select them all and choose to change the colour to red if the value is above a certain number. It's for presenting a level survey and highlighting any discrepancies from the design level.

Maybe this help.

Does the text only contain numerical content, or is the numerical content surrounded by other text content?

It's just numerical content e.g. 12.255

Does the text only contain numerical content, or is the numerical content surrounded by other text content?

I'd ask the same thing, although this could be put in use:

; _$ (GetNumVal "abc256def,ghi1j3k4x") -> 256.134
(defun GetNumVal ( str / delimUsed )
(if (eq 'STR (type str))
	(atof
		(vl-string-subst "." ","
			(apply 'strcat
				(vl-remove 'nil
					(mapcar
						(function
							(lambda (x)
								(if (member x (mapcar 'chr (vl-string->list "1234567890.,")))
									(cond
										((and (member x '("." ",")) (not delimUsed) (setq delimUsed T))
											x
										)
										((and (member x '("." ",")) delimUsed) nil)
										(T x)
									); cond
								); if
							); lambda
						); funciton
						(mapcar 'chr (vl-string->list str))
					); mapcar
				); vl-remove
			); apply 'strcat
		); vl-string-subst
	); atof
); if
); defun GetNumVal

And an example for not recommended strings:

; _$ (GetNumVal "245.5x640.2") -> 245.564 

Real quick and dirty

(setq ss (ssget "x" (list (cons 0 "TEXT"))))
(repeat (setq x (sslength ss))
(setq obj  (ssname ss (setq x (- x 1))))
(if (< 100.0 (atof (vla-get-textstring (vlax-ename->vla-object obj))))
(command "chprop" obj "" "col" 1 "")
)
)

Jamesjh1171, could you provide a sample drawing to test on, please.

EDIT:

Nevermind, wrote something (might be not exactly what you want):

; Symetrical text coloring from the mid value
(defun C:test ( / colInc colRange inc SSX i Lst NumVals MMM Range c enx )
(if 
	(and
		(setq colInc 1)
		(setq colRange '(10 250))
		(not (initget (+ 1 2 4)))
		(setq inc (getreal "\nSpecify increment: "))
		(setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
	)
	(progn
		(repeat (setq i (sslength SSX))
			(setq Lst (cons (entget (ssname SSX (setq i (1- i)))) Lst))
		); repeat
		
		; (setq Lst (vl-remove-if (function (lambda (x) (= 0.0 (atof (cdr (assoc 1 x)))))) Lst))
		; (setq NumVals (mapcar (function (lambda (x) (atof (cdr (assoc 1 x))))) Lst))
		(setq Lst (vl-remove-if (function (lambda (x) (= 0.0 (GetNumVal (cdr (assoc 1 x)))))) Lst))
		(setq NumVals (mapcar (function (lambda (x) (GetNumVal (cdr (assoc 1 x))))) Lst))
		(setq
			MMM (cons (apply 'min NumVals) MMM)
			MMM (cons (apply 'max NumVals) MMM)
			MMM (cons (/ (apply '+ MMM) 2.) MMM)
			MMM (vl-sort MMM '<)
		); setq Min Mid Max
		(and (not Range) (setq Range (list (- (cadr MMM) inc) (+ (cadr MMM) inc))))
		(and (not c) (setq c (car colRange)))
		(while (apply '<= (mapcar 'abs (list (apply '- Range) (apply '- (list (car MMM) (caddr MMM))))))		
			(foreach x NumVals
				(and 
					(not (apply '<= (list (car Range) x (cadr Range))))
					(setq enx (nth (vl-position x Numvals) Lst))
					(or
						(and (assoc 62 enx) (entmod (subst (cons 62 c) (assoc 62 enx) enx)))
						(entmod (append enx (list (cons 62 c))))
					)
				); and
			); foreach
			(setq Range (apply (function (lambda (a b) (list (- a (/ inc 2)) (+ b (/ inc 2))))) Range)) 
			(setq c (rem (+ c colInc) (cadr colRange)))
			(cond (= 0 c) (setq c (car colRange)))
		); while
	); progn
); if
(princ)
);| defun |; (vl-load-com) (princ)

(defun GetNumVal ( str / delimUsed )
(if (eq 'STR (type str))
	(atof
		(vl-string-subst "." ","
			(apply 'strcat
				(vl-remove 'nil
					(mapcar
						(function
							(lambda (x)
								(if (member x (mapcar 'chr (vl-string->list "1234567890.,")))
									(cond
										((and (member x '("." ",")) (not delimUsed) (setq delimUsed T))
											x
										)
										((and (member x '("." ",")) delimUsed) nil)
										(T x)
									); cond
								); if
							); lambda
						); funciton
						(mapcar 'chr (vl-string->list str))
					); mapcar
				); vl-remove
			); apply 'strcat
		); vl-string-subst
	); atof
); if
); defun GetNumVal

It changes symetrically the colour from the mid value.

OK how do I attach a dwg?

OK how do I attach a dwg?

See this

EDIT: Aaany way..

(defun C:test ( / CustomPrompt ChangeCol inputLst SSX i Lst Start End n c )

(defun CustomPrompt ( / Lst R c )
	(setq Lst (list (cons "nInc" 10) (cons "cInc" 1) (cons "cMin" 10) (cons "cMax" 250)))
	(not (initget (+ 2 4) "Color")) 
	(cond 
		( (not (setq R (getreal (strcat "\nSpecify increment or [Color] < " (rtos (cdr (assoc "nInc" Lst)) 2 2) " >: ")))) (setq R (cdr (assoc "nInc" Lst))) )
		( (numberp R) (setq Lst (subst (cons "nInc" R) (assoc "nInc" Lst) Lst)) )
		((= "Color" R)
			(foreach x (mapcar 'list '("cInc" "cMin" "cMax" "nInc") '("Specify color increment" "Specify min color range" "Specify max color range" "Specify increment"))
				(and (not (initget (+ 2 4))) (setq c (getint (strcat "\n " (cadr x) " < " (itoa (cdr (assoc (car x) Lst))) " >: ")))
					(if (not (and (wcmatch (car x) "c*") (>= c 256))) (setq Lst (subst (cons (car x) c) (assoc (car x) Lst) Lst)) )
				)
			)
		)
	); cond
	Lst
); defun CustomPrompt
(defun ChangeCol ( enx col ) (or (and (assoc 62 enx) (entmod (subst (cons 62 col) (assoc 62 enx) enx))) (entmod (append enx (list (cons 62 col)))) ) ); defun ChangeCol

(if 
	(and
		ChangeCol CustomPrompt (setq inputLst (CustomPrompt))
		(setq SSX (ssget "_X" (list (cons 0 "TEXT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
	); and
	(progn
		(repeat (setq i (sslength SSX)) (setq Lst (cons (cdr (assoc 5 (entget (ssname SSX (setq i (1- i)))))) Lst)) ); repeat
		(setq Lst (mapcar 'list (setq Lst (vl-remove-if (function (lambda (x) (= 0.0 (atof (cdr (assoc 1 (entget (handent x)))))))) Lst))
			(mapcar (function (lambda (x) (atof (cdr (assoc 1 (entget (handent x))))))) Lst)
		); setq Lst
		); setq Lst
		(setq Lst (vl-sort Lst (function (lambda (a b) (< (cadr a) (cadr b))))))
		(setq Start (cadar Lst))
		(setq End (last (last Lst)))
		(and (not n) (setq n Start))
		(and (not c) (setq c (cdr (assoc "cMin" inputLst))))
		(while (<= n End)
			(foreach x Lst (and (<= n (cadr x) End) (ChangeCol (entget (handent (car x))) c) ) ); foreach
			(setq n (+ n (cdr (assoc "nInc" inputLst))))
			(setq c (rem (+ c (cdr (assoc "cInc" inputLst))) (cdr (assoc "cMax" inputLst))))
		); while
	); progn
); if
(princ)
);| defun |; (vl-load-com) (princ)

Nice one Grr I think you have been out watching the sun set to often making all those colours . In Civ3d they have a style called Rainbow for contours very similar.

Nice one Grr I think you have been out watching the sun set to often making all those colours . In Civ3d they have a style called Rainbow for contours very similar.

Thanks, it was interesting to write it, tho I feel bad that I didn't leave it for Lee.

...highlighting any discrepancies from the design level.

hi all

If TEXT are elevated, quick & dirty

[color="darkgreen"];Highlight text above input elevations
;if survey topo dwg spot level text content not telly with elevation (Z coordinates)[/color]
(defun c:demo (/  z ss) 
(while (setq z (getreal "\nEnter elevation : ")) ;enter to exit
     (if (setq ss (ssget "_X"(mapcar 'cons '(0 -4 10) (list "TEXT" "*,*,[color="red"]>=[/color]" (list 0.0 0.0 z))))) [color="green"];try <=,<>,<,>,=[/color]
(sssetfirst nil ss)(sssetfirst nil)))
     (princ)
 )

Thanks Grrr for your help - sorry I've not had a chance to check in for a few days.