王与韩1 发表于 2014-8-2 09:47:03

请各位帮忙完善下程序

本帖最后由 王与韩1 于 2014-8-2 09:48 编辑

这是论坛里的 大师ZZXXQQ帮我写的一个程序，提问再三，不好意思再行叨扰，现在只支持cad文字，请大师们改为天正和cad文字均支持

[*];显示下一字 明经 ZZXXQQ 2014.7.30

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif(defun c:tt ()

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif (vl-load-com)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif (if (and(setq s1 (entsel "\n选择文字: "))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         (setq ent (entget(car s1)))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         (= (cdr(assoc 0 ent)) "TEXT")) (progn

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif(setq txt (cdr(assoc 1 ent)))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif(if (>(sslength(setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txt))))) 1) (progn

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif   (ssdel (car s1) ss)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif   (while (>(sslength ss) 0)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (setq en (ssname ss 0))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (ssdel en ss)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (command "_.ZOOM" "W" p1 p2)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    (setq k (getpoint))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif   )

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif ))

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif (princ)

[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif)

reyun 发表于 2014-8-2 14:53:35

(defun c:tt ()
        (if (and(setq s1 (entsel "\n选择文字: "))
                 (setq ent (entget(car s1)))
                 (or (= (cdr(assoc 0 ent)) "TEXT") (= (cdr(assoc 0 ent)) "TCH_TEXT"))
      )
      (progn
                        (setq txt (cdr(assoc 1 ent)))
                        (if (>(sslength(setq ss (ssget "X" (list '(0 . "text,TCH_TEXT") (cons 1 txt))))) 1)
                                (progn
                                           (ssdel (car s1) ss)
                                           (while (>(sslength ss) 0)
                                            (setq en (ssname ss 0))
                                            (command "_.ZOOM" "o" en "")
                                            (ssdel en ss)
                                            (setq k (getpoint))
                                           )
                                )
                        )
                )
        )
        (princ)
)

王与韩1 发表于 2014-8-2 15:10:52

reyun 发表于 2014-8-2 14:53 static/image/common/back.gif


真心谢谢了

ZZXXQQ 发表于 2014-8-2 20:02:23

(or (= (cdr(assoc 0 ent)) "TEXT") (= (cdr(assoc 0 ent)) "TCH_TEXT"))
可改成
(wcmatch (cdr(assoc 0 ent)) "TEXT,TCH_TEXT")

reyun 发表于 2014-8-2 23:04:24

ZZXXQQ 发表于 2014-8-2 20:02 static/image/common/back.gif
(or (= (cdr(assoc 0 ent)) "TEXT") (= (cdr(assoc 0 ent)) "TCH_TEXT"))
可改成
(wcmatch (cdr(assoc 0...

一直以来我i都是用OR的...
谢谢Z版，学习了，嘿嘿~

wowan1314 发表于 2014-8-2 23:13:34

wcmatch"*TEXT"
手机上没法测试！
页: [1]
查看完整版本: 请各位帮忙完善下程序