本帖最后由 作者 于 2008-11-26 21:44:27 编辑

我希望能有个小程序，可以将修改过的“标注文字”以特殊颜色显示。见附件，图中尺寸334为修改过的“标注文字”，其余标注文字为默认值。谢谢！

------------------------------------------------------------------------------------------------------------------------------------------------------------------------

2008-11-26

根据七楼之前的总结，最后编好的lsp如下，但最近发现不能用于CAD 2008,特来向各位再次求助。先谢谢了。

;尺寸修改过的特殊颜色标出change text color

;一、标注文本改成"%%c<>"、"M<>x0.75"之类的，由于有<>，

;    标注会随修改自动更新，这种情况下文字颜色也保持不变。

;二、当text override 中不含<>时实际测量长度是100，

;    text override 的不是文本是100，而是40或者一个文本等，显示为紫色。

;三、实际测量长度是100，text override 的文本也是100，显示为蓝色

(defun c:ctc ()

(setvar "cmdecho" 0)

(command "undo" "be")

(setq ss (ssget '((0 . "DIMENSION"))))

(setq l (sslength ss))

(setq    i 0

j 0

)

(repeat l

(setq ent (ssname ss i))

(setq obj (vlax-ename->vla-object ent))

(setq txt (vla-get-TextOverride obj))

(setq mea (vla-get-Measurement obj))

(if    (/= txt "")

;_标注文本为M<>x0.75、M10.0x0.75的样式

(cond ((= (substr txt 1 1) "M")

(setq k 2)

(if (/= (substr txt 2 1) "

(progn

(while    (and (> (ascii (substr txt k 1)) 46)

(< (ascii (substr txt k 1)) 57)

)

(setq k (1+ k))

)

(setq txt1 (substr txt 2 (- k 2)))

(if (not (equal (atof txt1) mea 0.0001))

(vla-put-TextColor obj 3)

)

(setq j (1+ j))

)

)

)

;_标注文本为%%c<>、%%C6.0 的样式

((= (substr txt 1 1) "%")

(if (not (= (substr txt 4 1) "

(setq j (modify-color obj txt mea 4 j))

)

)

;_标注文本为6-%%c<>、6-%%C1.2 的样式

((= (substr txt 2 1) "-")

(if (= (substr txt 3 1) "%")

(if (not (= (substr txt 6 1) "

(setq j (modify-color obj txt mea 6 j))

)

(if (not (= (substr txt 3 1) "

(setq j (modify-color obj txt mea 3 j))

)

)

)

;_标注文本为<>、6.0的形式

(T

(if (not (= (substr txt 1 1) "

(setq j (modify-color obj txt mea 1 j))

)

)

)

)

(setq i (1+ i))

)

(command "undo" "e")

(setvar "cmdecho" 1)

(if (= j 0)

(princ "\n 程序执行完毕，未发现手工修改过的尺寸!")

(princ (strcat "\n 共发现" (rtos j) "个尺寸被修改过"))

)

(princ)

)

(defun modify-color (obj0 txt0 mea0 k0 j0 / jj txt11)

(setq txt11 (substr txt0 k0))

(if (equal (atof txt11) mea0 0.0001)

(vla-put-TextColor obj0 5)

(vla-put-TextColor obj0 6)

)

(setq jj (1+ j0))

jj

)