●●●●●实用程序：查找替换程序 求再增强●●●●●
本帖最后由 CTC 于 2012-4-20 21:48 编辑偶得一程序，求修改
说明：CAD自带查找替换，缺拾取文字功能。而这个程序刚好有这个功能，希望各位完美下。
1）增加一按钮“选择范围亮显查找文本数量” 。 如查找文字为“H”，选择范围后，CAD屏上会亮显某个范围内“H”的文字，并在命令行上提示：已找到并选择共 26 个包含“H”的对象，有2个文本重叠。（这个功能是CAD自带的）
2）替换最好支持属性文字。替换时命令行有这样的提示：已找替换了 26 个包含“L”的对象。
朗少的：
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid501237
;支持cad单行和多行文字、TZ单行和多行文字
(defun c:CZ(/ fn x dclid lin return# sstxt ssl ct0 ct edata etext txtln subln schct DCL_ID newtext en1 ob entype a)
(setvar "cmdecho" 0)
(command "_.undo" "_begin")
(defun xsdhk();显示对话框
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(foreach x '(
"czth : dialog{"
"label=\"查找替换V1.0--阿甘\";"
"spacer_1;"
":row {"
":edit_box"
"{"
" label=\"查找\";"
" key=\"oldword\";"
" width = 45 ;"
" height = 1.2 ;"
" allow_accept=true;"
"}"
":button{key=\"1\";label=\"拾取\";width=6;}"
"}"
"spacer;"
":row {"
":edit_box"
"{"
" label=\"替换\";"
" key=\"newword\";"
" width = 45 ;"
" height = 1.2 ;"
" allow_accept=true;"
"}"
":button{key=\"2\";label=\"拾取\";width=6;}"
"}"
"spacer;"
":row {"
":button{key=\"3\";label=\"选择范围替换\";width=6;}"
"cancel_button;"
"}"
"}"
) ; endlist
(princ x fn)
(write-line "" fn)
) ; end foreach
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(if oldch
(set_tile "oldword" oldch)
(set_tile "oldword" "")
)
(if newch
(set_tile "newword" newch)
(set_tile "newword" "")
)
(mode_tile "oldword" 2)
(action_tile "oldword" "(setq oldch $value)")
(action_tile "newword" "(setq newch $value)")
(action_tile "1" "(done_dialog 1)")
(action_tile "2" "(done_dialog 2)")
(action_tile "3" "(done_dialog 3)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
(cond
((= re 1) (shiqu1))
((= re 2) (shiqu2))
((= re 3) (tihuan))
)
(start_dialog)
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
);end xsdhk
(defun tihuan ()
(if (and (/= oldch "")(/= oldch newch)
(setq sstxt (ssget '((-4 . "<OR")(0 . "*TEXT")(0 . "TCH_DRAWINGNAME")(-4 . "OR>")))))
(progn
(setq ssl (sslength sstxt)
ct0 0
ct 0
subln (strlen oldch)
oldtxtln (strlen oldch)
)
(while (< ct0 ssl)
(setq en1 (ssname sstxt ct0));图元名
(setq edata (entget en1);组码
etext (cdr (assoc 1 edata));文字内容
entype (cdr (assoc 0 edata));文字类型
txtln (strlen etext)
schct 1
newtext ""
)
(while (<= schct txtln)
(if (= (setq readch (substr etext schct subln)) oldch)
(setq schct (+ schct subln)
a newch)
(progn
(if (> (ascii (substr readch 1 1)) 127);如果是汉字
(progn
(setq readch (substr etext schct (1+ subln)));多读取一个字节
(setq schct (+ schct 2));加2字节
(setq a (substr readch 1 2));就取第1.2个字节为a
)
(progn
(setq schct (1+ schct))
(setq a (substr readch 1 1))
)
)
)
)
(setq newtext (strcat newtext a))
)
(if (/= etext newtext)
(progn
(setq ob (vlax-ename->vla-object en1)) ;转换
(if (= entype "TEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
(if (= entype "TCH_MTEXT") (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))) ;改变特性
(if (= entype "MTEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
(if (= entype "TCH_TEXT") (vlax-put-property ob 'Text newtext)) ;改变特性
(if (= entype "TCH_DRAWINGNAME") (vlax-put-property ob 'NameText newtext)) ;改变特性
(setq ct (1+ ct))
)
)
(setq ct0 (1+ ct0))
)
(alert (strcat "共替换了" (itoa ct) "个"))
(princ (strcat ">>>>>>>>>共替换了" (itoa ct) "个"))
)
)
);end tihuan
(defun shiqu1 (/ ent1 ent2 entdata enttext)
(if (setq ent1 (entsel ))
(progn
(setq ent2 (car ent1);图元名
entdata (entget ent2);组码
enttext (cdr (assoc 1 entdata));文字内容
)
(setq oldch enttext)
(setq newch enttext)
(xsdhk)
))
);end shiqu1
(defun shiqu2 (/ ent1 ent2 entdata enttext)
(if (setq ent1 (entsel ))
(progn
(setq ent2 (car ent1);图元名
entdata (entget ent2);组码
enttext (cdr (assoc 1 entdata));文字内容
)
(setq newch enttext)
(xsdhk)
))
);end shiqu2
(xsdhk)
(command "_.undo" "_end")
(setvar "cmdecho" 1)
(princ)
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 CTC的微博
本帖最后由 CTC 于 2012-4-20 21:42 编辑
print1985 发表于 2012-4-20 17:36 http://bbs.mjtd.com/static/image/common/back.gif
试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题）
高手出招了....
不知什么问题,还请高手指点....
高手,请帮我看下可不可以加入CAD系统里面的查找替换里的
""全部选择"" 按钮,查找的文字会亮显,命令行里会提示""已找到并选择 3 个包含“L1”的对象""
因为我要知道选择了哪些,替换了哪些
这个按键功能用法同原来系统的用法一样就好了...(看下面的图片及动画)
本帖最后由 迷失1786 于 2023-6-15 12:11 编辑
试试源泉插件的TFF功能，我用过最好的查找替换功能，查字显亮，带线，带拾取字，
查找替换文字，非常实用 支持顶一下 希望高手出手相助 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91554&page=1#pid501237
这里有个更好的 拾取功能很简单 自己把2个lsp组装下就行了 试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题） 楼主的代码对有换行的多行文字也有问题 2个查找替换都有问题啊 貌似有点高深。。 做个记号，以后学习。
页:
[1]
2