表骑马实开车 发表于 2023-2-21 19:01:20

改多行文字颜色

前几天要用在论坛没找到，不知是否通用，不足之处请指正.;;修改MTEXT多行文字颜色
(vl-load-com)
(defun c:tt (/ co i ss edt cb ps typ)
(setvar "cmdecho" 0)
(setq co (acad_colordlg 1))
(setq i -1)
(prompt "\n请选择文字:")
(if
    (not
      (equal
'(nil nil)
(sssetfirst
    nil
    (setq
      ss
       (ssget (list '(0 . "MTEXT,TEXT")))
    )
)
      )
    )
   (setq ss (ssget "_:L"))
)
(if ss
    (while (setq e (ssname ss (setq i (+ i 1))))
      (setq edt(entget e)
      cb(cdr (assoc 1 edt))
      ps(vl-string-search "\\C" cb)
      typ(= (cdr (assoc 0 edt)) "MTEXT")
      )
      (cond
((and ps typ) (ccol-1 cb ps (rtos co 2 0) edt))
(T (ccol-2 e co))
      )
    )
)
(setvar "cmdecho" 1)
(princ "\n完毕...")
(princ)
)

;;文字内容、"\\C"关键字序号、色号、图元表
(defun ccol-1 (cbb b col et / a c d et)
(setqa (substr cbb (+ b 2) 4)
c (vl-princ-to-string (read a))
d (vl-string-subst (strcat "C" col) c cbb)
)
(setq
    et (subst (cons 1 d)
      (assoc 1 et)
      et
       )
)
(entmod et)
)

;;图元、色号
(defun ccol-2 (ent ccol / eo)
(setqeo (vlax-ename->vla-object ent)
)
(vla-put-Color eo ccol)
)

表骑马实开车 发表于 2023-2-22 11:12:03

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 16:37:59

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

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

mokson 发表于 2023-2-22 08:13:58

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

中国梦 发表于 2023-2-21 22:29:34

不错不错，哈哈

Ming131564 发表于 2023-2-22 11:11:04

666很好的功能

hzyhzjjzh 发表于 2023-2-22 12:47:52

谢谢楼主的分享！{:1_1:}

月下闲人 发表于 2023-2-22 13:40:32

用不了，楼主在测试下

magicheno 发表于 2023-2-22 23:27:18

感谢大佬分享

cxix64 发表于 2023-2-27 21:46:07

[源码] 改多行文字颜色   这个实用 谢谢楼主
页: [1] 2
查看完整版本: 改多行文字颜色