LISP更改文字颜色bas

Jamesjh1171 · 发表于 2022-7-5 16:54:32

嗨，我希望能够改变文字的颜色的基础上的价值。因此，如果我有200个不同值的文本对象，我可以将它们全部选中，如果值高于某个数字，我可以选择将颜色更改为红色。它用于呈现水平调查，并强调与设计水平的任何差异。

mostafa badran · 发表于 2022-7-5 17:01:44

也许这有帮助。

Lee Mac · 发表于 2022-7-5 17:08:04

文本是否仅包含数字内容，或者数字内容是否被其他文本内容包围？

Jamesjh1171 · 发表于 2022-7-5 17:13:19

它只是数字内容，例如12.255

Grrr · 发表于 2022-7-5 17:16:29

我会问同样的问题，尽管这可以使用：

copy


; _$ (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

以及不推荐字符串的示例：

copy

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

BIGAL · 发表于 2022-7-5 17:22:39

又快又脏

copy


(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 "")
)
)

Grrr · 发表于 2022-7-5 17:25:28

Jamesjh1171，你能提供一张样品图来测试一下吗。
编辑：
没关系，写了点什么（可能不是你想要的）：

copy


; 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

它从中间值对称地改变颜色。

Jamesjh1171 · 发表于 2022-7-5 17:34:26

好的，如何附着dwg？

Grrr · 发表于 2022-7-5 17:38:52

看到这个了吗
编辑：aa任何方式。。
[code]（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））））（而（

BIGAL · 发表于 2022-7-5 17:41:02

很好，我想你一直在外面看太阳落山，经常做出那些颜色。在Civ3d中，它们有一种称为彩虹的样式，轮廓非常相似。

[编程交流] LISP更改文字颜色bas

发表回复

精选推荐