根据更改文本颜色

Astro · 发表于 2022-7-6 04:15:11

大家好，
我再次需要你的帮助。我在谷歌上做了很多搜索（没有成功），找到了一个lisp，它可以完成以下任务：

执行命令时，

-扫描图形中的TXT、MTXT和属性
-根据尺寸范围改变颜色

尺寸表：
从0.000mm到2.150mm白色
从2.151mm到3.000mm绿色
从3.001mm到4.250mm黄色
从4.251mm到6.000mm红色
从6.001mm到无限洋红

当您使用与不同线宽相关联的打印样式颜色进行打印时，这可能非常有用。像这样，你的所有文本都是正确的颜色，并得到良好的打印在良好的线宽。
此外，它还有助于清理您的绘图，而不必选择每个文本，检查大小和分配所需的颜色。

提前谢谢你的好意帮助

BIGAL · 发表于 2022-7-6 04:49:43

这是一个开始，需要一个条件来更改高度值。看看我有没有时间。

copy

(setq ss (ssget "X" (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil) 
(princ "\nnothing inside")
(progn
(setq numb2 (sslength ss))
(setq y numb2)
(repeat y
(setq tobj (vlax-ename->vla-object (ssname ss (setq y (- y 1)))))
(setq textht (vlax-get-property tobj "Height"))
(princ textht) ; change to write text to file
(COND ((and (> textht 0.0) (< textht 2.5)) (vla-put-Color tobj 1)) ; 1 is color number
((and (> textht 2.501) (< textht 5.0)) (vla-put-Color tobj 2))
((and (> textht 5.01) (< textht 7.5)) (vla-put-Color tobj 3))
((> textht 7.501) (vla-put-Color tobj 4))
); end cond
); repeat 
); end progn
); end if

Astro · 发表于 2022-7-6 05:08:51

woow谢谢Bigal

它已经运行得很好了。
我只根据需要更改了范围和颜色。我的Lisp程序水平不允许我做更多的事情呵呵

copy


(defun C:test ()
(setq ss (ssget "X" (list (cons 0 "Text,Mtext")))) ; 
selection set of text within polygon
(if (= ss nil) 
(princ "\nnothing 
inside")
(progn
(setq numb2 (sslength ss))
(setq y numb2)
(repeat 
y
(setq tobj (vlax-ename->vla-object (ssname ss (setq y (- y 
1)))))
(setq textht (vlax-get-property tobj "Height"))
;(princ textht) ; 
change to write text to file
(COND ((and (> textht 0.0) (< textht 
2.15)) (vla-put-Color tobj 7)) ; 1 is color number
((and (> textht 2.151) 
(< textht 3.0)) (vla-put-Color tobj 3))
((and (> textht 3.001) (< 
textht 4.25)) (vla-put-Color tobj 2))
((and (> textht 4.251) (< textht 
6.0)) (vla-put-Color tobj 1))
((> textht 6.001) (vla-put-Color tobj 
6))
); end cond
); repeat 
); end progn
); end if
) ;_ end of 
defun

只有两件事。是否有可能使其在块内（如果可能，还包括动态块）和属性中工作？

非常感谢你的帮助，它已经帮了我很多

David Bethel · 发表于 2022-7-6 05:19:27

我对动态块一无所知。。。。

这应适用于所有版本的AutoCAD：

[code]（defun c:txtclr（/ct ss i en ed h cn bl bn td fe fd f（defun lookup（v l/c）（foreach h l（如果（

[编程交流] 根据更改文本颜色

发表回复

精选推荐