【源码分享】向caoyin致敬----也来发个带刷子的文字内容刷。

wowan1314

                                               说再见不容易，戒lisp更不容易哈!
          caoyin版主发过一个“带刷子的文字内容刷”，从中学到很多。
今天无聊就想另做个刷子。当然本人画工实在无法与之相比，还处了画一二三的地步。

浪费一个上午时间，终于有所成效，由于是借用CAD的刷子，所以更稳定，更准确。
         缺点是不能自定义颜色


;;;==================={ 文字内容刷V1.0 BY wowan1314 }===========================;;;
;;;功能：文字内容刷，源文字可点选，也可先选择后输入命令,操作类似CAD特性匹配     ;;;
;;;        (支持天正文字、图元名文字、引出标注文字)                             ;;;
;;;特别说明：本程序主要实现了，类似CAD特性匹配一样的刷子,使程序更加友好         ;;;
;;;             仅以此程序表达对caoyin的敬意,从他的帖子中受益良多!              ;;;
;;;=============================================================================;;;

另外：SHORTCUTMENU不为0时，无法右键退出。 无奈了         

     勉强算是解决了变量不为0时的情况。 但是解决的不是很完美。期待高人吧
[sell];;;==================={ 文字内容刷V1.0 BY wowan1314 }===========================;;;
;;;功能：文字内容刷，源文字可点选，也可先选择后输入命令,操作类似CAD特性匹配     ;;;
;;;        (支持天正文字、图元名文字、引出标注文字)                             ;;;
;;;特别说明：本程序主要实现了，类似CAD特性匹配一样的刷子,使程序更加友好         ;;;
;;;             仅以此程序表达对caoyin的敬意,从他的帖子中受益良多!              ;;;
;;;=============================================================================;;;
(DEFUN C:YY-SHUAZI (/ E UU SS BB AA N X ENT OB ENTYPE *ERROR* OLDSH ERR_END DOC)
  (DEFUN *ERROR* (X) (ERR_END))
(DEFUN ERR_END NIL (IF OLDSH (SETVAR "SHORTCUTMENU" OLDSH)))
  (SETQ OLDSH (GETVAR "SHORTCUTMENU"))
  (SETVAR "SHORTCUTMENU" 0)
  (while (not E)
    (princ "\n选择源文字")
    (setq e (SSGET ":S:E"
                   '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER"))
            )
    )
  )
  (SETQ UU (CDR (ASSOC 1 (ENTGET (SETQ E (SSNAME E 0))))))
  (VL-CMDF "MATCHPROP" E)
(WHILE (AND UU (not (member (SETQ CC (car (grread NIL 5 2))) '(11 12 25))))
  (PRINC "\n选择目标文字:<刷为")
  (PRINC UU)
  (PRINC ">")
    (SETQ
      SS (vl-catch-all-apply
           '(LAMBDA NIL
              (SSGET ":S:L"
                     '((0 . "*TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER"))
              )
            )
         )
    )
    (IF        (VL-CATCH-ALL-ERROR-P SS)
      (SETQ UU NIL)
      (IF SS
        (PROGN
          (IF (SETQ BB (SSDEL E SS))
            (SETQ AA (/= (SSLENGTH BB) 0))
            (SETQ AA 1314)
          )
          (IF AA
            (REPEAT (SETQ N (SSLENGTH SS))
              (SETQ N (1- N)
                    X (SSNAME SS N)
              )
              (setq ent (entget x))
              (setq ob (vlax-ename->vla-object X))
              (SETQ entype (cdr (assoc 0 ENT)))
              (COND
                ((= entype "TCH_MTEXT")    ;;天正多行文字还是不稳定
                 (entmod (subst (cons 1 UU) (assoc 1 ent) ent))
                )
                ((= entype "TCH_TEXT") (vlax-put-property ob 'Text UU))
                ((= entype "TCH_DRAWINGNAME")
                 (vlax-put-property ob 'NameText UU)
                )
                ((= entype "TCH_MULTILEADER")
                 (vlax-put-property ob 'UPText UU)
                )
                (T (vlax-put-property ob 'TextString UU))
              )
            )
          )
        )
      )
    )
  )
  (VL-CMDF "")
  (ERR_END)
  (setq doc (vlax-get (vlax-get-acad-object) "activedocument"))
  (IF (AND UU (/= OLDSH 0)) (vla-sendcommand doc "SHORTCUTMENU "))
  (PRINC)
)

[/sell]

newer

怎么还跟画工扯上了尼

ycao

右键不能退出程序，只能按ESC。有点不方便啊。

ycao

SHORTCUTMENU 的值是2
右键的返回值是25

xieyanghui123

是否支持属性文字？

flyfox1048

wowan1314不玩LISP了，是论坛的一大损失啊

qingqiu555

用处不大 比不了文字刷V2.1

zhang000111

看示例很好用，看看对天正支持如何。

imikes

这个方法还行，和我以前用的就多个提示功能！

开水瓶游泳

这个方法还行，和我以前用的就多个提示功能！

深蓝1深蓝

多谢楼主 非常好用

holybear

楼主，加载lsp后提示 错误: 输入的字符串有缺陷