LISP更改文字颜色bas
嗨，我希望能够改变文字的颜色的基础上的价值。因此，如果我有200个不同值的文本对象，我可以将它们全部选中，如果值高于某个数字，我可以选择将颜色更改为红色。它用于呈现水平调查，并强调与设计水平的任何差异。 也许这有帮助。 文本是否仅包含数字内容，或者数字内容是否被其他文本内容包围？ 它只是数字内容，例如12.255我会问同样的问题，尽管这可以使用：
; _$ (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
以及不推荐字符串的示例：
; _$ (GetNumVal "245.5x640.2") -> 245.564 又快又脏
(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，你能提供一张样品图来测试一下吗。
编辑：
没关系，写了点什么（可能不是你想要的）：
; 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
它从中间值对称地改变颜色。 好的，如何附着dwg？
看到这个了吗
编辑：aa任何方式。。
（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”）（not（setq R（getreal（strcat“\n指定增量或[颜色]<”（rtos（cdr（assoc“nInc”Lst））2）>））））（setq R（cdr（ass OC“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”））（和（not（initget（+2 4））（setq c（getint（strcat“\ n”（cadr x）”<（itoa（cdr（assoc（car x）Lst）））“>）））（如果（not（和（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）（或（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”）））；和（progn（repeat（setq i（sslength SSX））（setq Lst（cons（cdr（assoc 5（entget（ssname SSX（setq i（1-i \107;））））））））；重复（setq Lst（mapcar’list）（setq Lst（vl remove if（function（lambda（x））（=0.0（atof（cdr（assoc 1（entget（handent x k）а）а）Lst））（mapcar（function（lambda（x）（atof（cdr（assoc 1（entget（handent xа）））））））））））））；setq Lst）；setq Lst（setq Lst（vl sort Lst（function（lambda（a b）（<（cadr a）（cadr b kЮ）Ю））（setq Start（cadar Lst））（setq End（last（last Lst）））（and（not n）（setq n Start））（and（not c）（setq c（cdr（assoc“cMin”inputLst））））（而（ 很好，我想你一直在外面看太阳落山，经常做出那些颜色。在Civ3d中，它们有一种称为彩虹的样式，轮廓非常相似。
页:
[1]
2