改多行文字颜色

表骑马实开车

前几天要用在论坛没找到，不知是否通用，不足之处请指正.

2. ;;修改MTEXT多行文字颜色
   
3. (vl-load-com)
   
4. (defun c:tt (/ co i ss edt cb ps typ)
   
5.   (setvar "cmdecho" 0)
   
6.   (setq co (acad_colordlg 1))
   
7.   (setq i -1)
   
8.   (prompt "\n请选择文字:")
   
9.   (if
   
10.     (not
    
11.       (equal
    
12.   '(nil nil)
    
13.   (sssetfirst
    
14.     nil
    
15.     (setq
    
16.       ss
    
17.        (ssget (list '(0 . "MTEXT,TEXT")))
    
18.     )
    
19.   )
    
20.       )
    
21.     )
    
22.      (setq ss (ssget "_:L"))
    
23.   )
    
24.   (if ss
    
25.     (while (setq e (ssname ss (setq i (+ i 1))))
    
26.       (setq edt  (entget e)
    
27.       cb  (cdr (assoc 1 edt))
    
28.       ps  (vl-string-search "\\C" cb)
    
29.       typ  (= (cdr (assoc 0 edt)) "MTEXT")
    
30.       )
    
31.       (cond
    
32.   ((and ps typ) (ccol-1 cb ps (rtos co 2 0) edt))
    
33.   (T (ccol-2 e co))
    
34.       )
    
35.     )
    
36.   )
    
37.   (setvar "cmdecho" 1)
    
38.   (princ "\n完毕...")
    
39.   (princ)
    
40. )
    
41. 
    
42. ;;文字内容、"\\C"关键字序号、色号、图元表
    
43. (defun ccol-1 (cbb b col et / a c d et)
    
44.   (setq  a (substr cbb (+ b 2) 4)
    
45.   c (vl-princ-to-string (read a))
    
46.   d (vl-string-subst (strcat "C" col) c cbb)
    
47.   )
    
48.   (setq
    
49.     et (subst (cons 1 d)
    
50.         (assoc 1 et)
    
51.         et
    
52.        )
    
53.   )
    
54.   (entmod et)
    
55. )
    
56. 
    
57. ;;图元、色号
    
58. (defun ccol-2 (ent ccol / eo)
    
59.   (setq  eo (vlax-ename->vla-object ent)
    
60.   )
    
61.   (vla-put-Color eo ccol)
    
62. )

;;修改MTEXT多行文字颜色<br /> (vl-load-com)<br /> (defun c:tt (/ co i ss edt cb ps typ)<br />   (setvar "cmdecho" 0)<br />   (setq co (acad_colordlg 1))<br />   (setq i -1)<br />   (prompt "\n请选择文字:")<br />   (if<br />     (not<br />       (equal<br />   '(nil nil)<br />   (sssetfirst<br />     nil<br />     (setq<br />       ss<br />        (ssget (list '(0 . "MTEXT,TEXT")))<br />     )<br />   )<br />       )<br />     )<br />      (setq ss (ssget "_:L"))<br />   )<br />   (if ss<br />     (while (setq e (ssname ss (setq i (+ i 1))))<br />       (setq edt  (entget e)<br />       cb  (cdr (assoc 1 edt))<br />       ps  (vl-string-search "\\C" cb)<br />       typ  (= (cdr (assoc 0 edt)) "MTEXT")<br />       )<br />       (cond<br />   ((and ps typ) (ccol-1 cb ps (rtos co 2 0) edt))<br />   (T (ccol-2 e co))<br />       )<br />     )<br />   )<br />   (setvar "cmdecho" 1)<br />   (princ "\n完毕...")<br />   (princ)<br /> )<br /> <br /> ;;文字内容、"\\C"关键字序号、色号、图元表<br /> (defun ccol-1 (cbb b col et / a c d et)<br />   (setq  a (substr cbb (+ b 2) 4)<br />   c (vl-princ-to-string (read a))<br />   d (vl-string-subst (strcat "C" col) c cbb)<br />   )<br />   (setq<br />     et (subst (cons 1 d)<br />         (assoc 1 et)<br />         et<br />        )<br />   )<br />   (entmod et)<br /> )<br /> <br /> ;;图元、色号<br /> (defun ccol-2 (ent ccol / eo)<br />   (setq  eo (vlax-ename->vla-object ent)<br />   )<br />   (vla-put-Color eo ccol)<br /> )

表骑马实开车

mokson 发表于 2023-2-22 08:13
准备了那么多工作，就是为了那个  vla-put-Color

(vl-load-com)
(setq eo (vlax-ename->vla-object (car (entsel))))
(vla-put-Color eo 1)

试下能改吗？

表骑马实开车

月下闲人 发表于 2023-2-22 13:40
用不了，楼主在测试下

那个是回复3楼的，用1楼的代码试试

mokson

准备了那么多工作，就是为了那个  vla-put-Color

中国梦

不错不错，哈哈

Ming131564

666很好的功能

hzyhzjjzh

谢谢楼主的分享！

月下闲人

用不了，楼主在测试下

magicheno

感谢大佬分享

cxix64

[源码] 改多行文字颜色   这个实用 谢谢楼主