土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 请高手帮我调试一下这lsp程序!

请高手帮我调试一下这lsp程序!

发布于:2009-10-21 11:02:21 来自:建筑设计/CAD下载及教程 [复制转发]
在网上找了一段文字替换的代码,我想改进下,就是文本自动替换,只要出现%%132就自动替换成},请问该如何实现?
源代码:
(defun reptext
(char-A char-B / pc ss
index ent typeA typeA-len char-Alen
char-Blen n char-aa newsize
)
(setq pc 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))) ;选择文字
(if ss
(progn
(setq index 0)
(repeat (sslength ss)
(setq ent (entget (ssname ss index)))
(setq index (+ 1 index))
(setq typeA (cdr (assoc 1 ent))) ;选择的文字内容
(setq typeA-len (strlen typeA)) ;选择的文字内容的长度
(setq char-Alen (strlen char-A)) ;取得要找的文字的长度
(setq char-Blen (strlen char-B)) ;取得替换文字的长度
(setq n 1)
(if (= char-A "")
(setq typeA-len 1)
)
(repeat typeA-len
(setq char-aa (substr typeA n char-Alen))
;查找选择的文字内容里是否有要被替换的文字
(if (= char-aa char-A)
(progn ;如果有
(setq typeA (vl-string-subst char-B char-A typeA))
(setq newsize (cons 1 typeA))
(setq ent (subst newsize (assoc 1 ent) ent))
(entmod ent)
(setq pc (1+ pc))
)
;;End progn
)
;;End if
(setq n (1+ n))
)
;;End repeat
)
;;End repeat
(princ (strcat "\n替换了" (rtos pc) "个."))
)
;;End progn
)
;;End if
)
;;;_______________________________________________________
(defun c:chtext (/ cm char-A char-B)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.UNDO" "Group")
(setq char-A (getstring "\n请输入替换文字:"))
(setq char-B (getstring "\n请输入新的文字:"))
(reptext char-A char-B)
(command "_.UNDO" "End")
(setvar "cmdecho" cm)
(princ)
)

全部回复(2 )

只看楼主 我来说两句抢地板
  • zxc001
    zxc001 沙发
    你还是下载我的 蓝天结构设计软件 那里面有替换的功能 很多种的 你的这个程序是子程序,是程序内部调用的程序,你加载能行,就是用不了,这样的才行 (defun c:
    2009-11-03 09:23:03

    回复 举报
    赞同0
  • coolwzx1209
    coolwzx1209 板凳
    :time: :handshake
    2009-10-21 11:02:21

    回复 举报
    赞同0
这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.08 万条内容 · 657 人订阅

猜你喜欢

阅读下一篇

【求书籍】AutoCAD 2004 与AutoLISP二次开发技术

AutoCAD 2004 与AutoLISP二次开发技术 作者: 赵景亮 李志刚等 出版社: 清华大学出版社 出版日期: 2004-04 :L

回帖成功

经验值 +10