[LISP程序]：将文字内容改成源文字内容

szx025 · 发表于 2008-11-28 16:09:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:DD (/ txt1 txt2 ent) ;;;文字刷，将文字内容改成源文字内容
(setq ent (car (entsel "\n选择源文字：")))
      (setq txt1 (entget ent))
      (setq txt1 (cdr (assoc 1 txt1)))
      (while t
(setq ent (car (entsel "\n选择目标文字：")))
            (setq ent (entget ent))
         (setq ent
   (subst (cons 1 txt1) (assoc 1 ent) ent)
         )
         (entmod ent)
)

)

(setq ent (car (entsel "\n选择源文字：")))这句是要在图中选择源文字
能否改进一下，除了能在图中选择源文字外，还能用键盘输入源文字

zml84 · 发表于 2008-11-28 19:06:54

设置个关键字。

dwg001 · 发表于 2008-11-28 19:13:02

(if (= ent nil) (setq ent (getstring "\n键盘输入" )))

szx025 · 发表于 2008-12-2 16:02:43

DWG001,
你的方法不行啊

bikeboy · 发表于 2008-12-3 10:18:18

没明白啥意思啊？原文字？

jxh2003zfr · 发表于 2008-12-3 12:27:58

[FONT=courier new]
(setq filt (list (cons -4 "<OR") (cons 0 "Text") (cons 0 "MText") (cons -4 "OR>")))
(setq ss (acet-ui-entsel (list (strcat "\n选择源文字或输入文字(Input)" )
128 "I i" T filt nil)))
(if (= ss "I") (输入文字))
[/FONT]

dwg001 · 发表于 2008-12-3 13:39:59

试试它。

[PHP];;;文字刷，将目标文字内容改成源文字内容[/PHP]

;;;文字刷，将目标文字内容改成源文字内容
;;修改 dwg001
(defun c:DD (/ ENT ENTN BASIC)
(setq BASIC (getstring
"\n...用键盘输入源文字(按回车键则改用鼠标拾取)： "))
(if (= "" BASIC)
(setq BASIC (cdr (assoc 1 (entget (car (entsel "\n...用鼠标拾取源文字: ")))))))
(while
(setq ent (entget (car (entsel "\n...选择被替换的目标文字："))))
(setq ent (subst (cons 1 BASIC) (assoc 1 ent) ent) )
(entmod ent)
)
)

carrot1983 · 发表于 2008-12-5 13:26:16

(defun C:TD (/ E1 E2 ELIST OLDERR V1)
(princ "\n选择源文字替代目标文字")
(if (not OLDERR)
(setq OLDERR *ERROR*)
)
(defun *ERROR* (MSG /)
(setq *ERROR* OLDERR
OLDERR NIL
)
(if E1 (redraw E1 4))
(princ MSG)
(princ)
)
(if (setq E1 (car (entsel "\n选择源文字<退出>: ")))
(progn
(redraw E1 3)
(while (setq E2 (car (entsel "\n选择目标文字<退出>: ")))
(progn
(setq V1 (cdr (assoc 1 (entget E1))))
(setq ELIST (entget E2))
(entmod (subst (cons 1 V1)
(assoc 1 ELIST)
ELIST
)
)
)
)
(redraw E1 4)
)
)
(setq *ERROR* OLDERR)
(princ)
)
(princ)

zml84 · 发表于 2008-12-5 13:48:21

(setq E2 (car (entsel "\n选择目标文字<退出>: ")))

点取不妥，建议 ssget

<CENTER><H1>文字内容刷.LSP</H1></CENTER>
<SCRIPT LANGUAGE="JavaScript">document.write("最后修改时间: " + document.lastModified)
</SCRIPT>
<HR SIZE=5><PRE>(defun C:TT (/ SS ENT TMP SS2 I)
(princ "\n选择源文字替代目标文字")
;;; (if (not OLDERR)
;;; (setq OLDERR *ERROR*)
;;; )
;;; (defun *ERROR* (MSG /)
;;; (setq *ERROR* OLDERR
;;; OLDERR NIL
;;; )
;;; (if E1
;;; (redraw E1 4)
;;; )
;;; (princ MSG)
;;; (princ)
;;; )
(if (and (setq SS (entsel "\n选择源文字<退出>: "))
 (setq ENT (entget (car SS)))
 (= (cdr (assoc 0 ENT)) "TEXT")
 (setq TMP (assoc 1 ENT))
)
(progn
 ;;
 (redraw (car SS) 3)
 ;;
 (princ "\n选择目标文字<退出>: ")
 (while (setq SS2 (ssget ":S" '((0 . "TEXT"))))
(setq I 0)
(repeat (sslength SS2)
 (setq ENT (entget (ssname SS2 I)))
 (entmod (subst TMP
 (assoc 1 ENT)
 ENT
 )
 )
 (setq I (1+ I))
)
 )
 ;;
 (redraw (car SS) 4)
)
)
;;; (setq *ERROR* OLDERR)
(princ)
)
(princ)
</PRE>

szlmh · 发表于 2008-12-11 22:15:38

老早就有过了，老帖，还是要顶，为了公开源码

ljm68 · 发表于 2008-12-13 20:47:50

初学者，学习学习

cj_zj · 发表于 2008-12-13 21:41:03

学习中

jize1980 · 发表于 2008-12-15 21:43:45

好像没见过，学习中

nyfzh · 发表于 2008-12-17 15:42:10

学习中……

zctao1966 · 发表于 2008-12-24 21:29:40

初来，看下。。。

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：将文字内容改成源文字内容

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块