[LISP]求助－如何特殊显示修改过的标注文字

feizheng

我希望能有个小程序，可以将修改过的“标注文字”以特殊颜色显示。见附件，图中尺寸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
)

ljpnb

参考一下

2. (defun c:test ()
3.   (setq ss (ssget "x" '((0 . "DIMENSION"))))
4.   (setq l (sslength ss))
5.   (setq i 0)
6.   (repeat l
7.     (setq ent (ssname ss i))
8.     (setq obj (vlax-ename->vla-object ent))
9.     (setq txt (vla-get-TextOverride obj))
10.     (if (/= txt "")
11.       (vla-put-TextColor obj 1)
12.     )
13.     (setq i (1+ i))
14.   )
15. )

(defun c:test ()   (setq ss (ssget "x" '((0 . "DIMENSION"))))   (setq l (sslength ss))   (setq i 0)   (repeat l     (setq ent (ssname ss i))     (setq obj (vlax-ename->vla-object ent))     (setq txt (vla-get-TextOverride obj))     (if (/= txt "")       (vla-put-TextColor obj 1)     )     (setq i (1+ i))   ) )

feizheng

试过了，好用的。多谢！

还有两点请教：

         一、程序默认是对图中所有的标注操作，能不能改成对选定的对象中标注操作啊。

          二、我们这里有好多图纸中标注文字颜色默认就是红色，所以用了这个程序后看不出变化。

－－－－－－－－－－－－再次感谢楼上的朋友！

龙龙仔

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=2844

ljpnb

龙哥链接的贴子请得比较全面，楼主可以参考一下，另外你提到的问题可以如下修改

(setq ss (ssget "x" '((0 . "DIMENSION"))))
--->(setq ss (ssget  '((0 . "DIMENSION"))))

(vla-put-TextColor obj 1)----->(vla-put-TextColor obj 其它颜色号)

feizheng

 谢谢 ljpnb和龙哥，我觉得  ljpnb 改过后的可以选择对象这一点更人性化一些 ，毕竟这是ljpnb大侠根据我的要求做的，我当然喜欢啦。

（当然龙哥的程序改一下也可以做到这点的）

－－－－－－－－

刚刚试了两位大侠的程序，发现一个现象，

标注文本修改后，不管测量值是否与标注文本相等，文本都变颜色，可不可以改一下，当

测量值是否与标注文本相等，文本都变颜色1

测量值是否与标注文本不相等，文本都变颜色2

谢谢！

 

ljpnb

程序当中(setq txt (vla-get-TextOverride obj))的TXT值，对TXT值多加一个判断就可以了。

feizheng

根据5楼修改后的程序如下

2. (defun c:test ()
3.   (setq ss (ssget  '((0 . "DIMENSION"))))
4.   (setq l (sslength ss))
5.   (setq i 0)
6.   (repeat l
7.     (setq ent (ssname ss i))
8.     (setq obj (vlax-ename->vla-object ent))
9.     (setq txt (vla-get-TextOverride obj))
10.     (if (/= txt "")
11.       (vla-put-TextColor obj 6)
12.     )
13.     (setq i (1+ i))
14.   )
15. )

(defun c:test ()   (setq ss (ssget  '((0 . "DIMENSION"))))   (setq l (sslength ss))   (setq i 0)   (repeat l     (setq ent (ssname ss i))     (setq obj (vlax-ename->vla-object ent))     (setq txt (vla-get-TextOverride obj))     (if (/= txt "")       (vla-put-TextColor obj 6)     )     (setq i (1+ i))   ) )

但是7楼说的增加一个TXT判断，我不会，能不能再帮忙修改一下，上传一个完整程序啊，这样也可以让别的网友直接使用啊。谢谢ljpnb了。

zmdjing

怎么把图片传的和楼主一样啊我不会拜托大家帮帮谢了

feizheng

我是直接作为上传jpg图片的，显示出来就是这样了。