Jamesjh1171 Posted November 30, 2016 Share Posted November 30, 2016 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. Quote Link to comment Share on other sites More sharing options...
mostafa badran Posted November 30, 2016 Share Posted November 30, 2016 Maybe this help. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 30, 2016 Share Posted November 30, 2016 Does the text only contain numerical content, or is the numerical content surrounded by other text content? Quote Link to comment Share on other sites More sharing options...
Jamesjh1171 Posted December 1, 2016 Author Share Posted December 1, 2016 It's just numerical content e.g. 12.255 Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 1, 2016 Share Posted December 1, 2016 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted December 2, 2016 Share Posted December 2, 2016 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 "") ) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 2, 2016 Share Posted December 2, 2016 (edited) 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. Edited December 2, 2016 by Grrr Quote Link to comment Share on other sites More sharing options...
Jamesjh1171 Posted December 2, 2016 Author Share Posted December 2, 2016 OK how do I attach a dwg? Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 2, 2016 Share Posted December 2, 2016 (edited) 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) Edited December 2, 2016 by Grrr Quote Link to comment Share on other sites More sharing options...
BIGAL Posted December 2, 2016 Share Posted December 2, 2016 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. Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 2, 2016 Share Posted December 2, 2016 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. Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted December 3, 2016 Share Posted December 3, 2016 (edited) ...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) ) Edited December 3, 2016 by hanhphuc opr & comment color Quote Link to comment Share on other sites More sharing options...
Jamesjh1171 Posted December 6, 2016 Author Share Posted December 6, 2016 Thanks Grrr for your help - sorry I've not had a chance to check in for a few days. 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.