多重文本替换程序(2015-12-25更新)

mikewolf2k

AutoCAD的find/replace只支持一个字符串替换，如果要替换多个字符串或者多个文件有相同的字符串要替换就非常麻烦了，因此我编写了一个多重文本替换程序，可以将要替换的文字写在excel中，要替换时只需选中excel中相应单元格就可以了。
使用方法：将要替换的文字写在excel中的A列，替换为B列文字，再选中A列中文本。加载multitextreplace.dvb，按ALT+F8选中执行dvb中multitextreplace函数，执行即可。 新版本更新了下，加了个Batch_singlefolder程序批量处理某文件夹下的所有dwg文件。 2015-12-25再次更新，增加按文件名区别替换功能，请移步34楼。

mikewolf2k

再次更新，增加了文件名，可以同一字符串在不同的文件名中被替换为不同的字符串。
使用方法：
加载dvb，Alt+F8可以看到两个程序，一个是单文件执行，一个是文件夹内多文件批量执行。

打开一个excel文件（对excel文件无要求，取当前激活的一个。为避免误操作，最好只打开替换列表的这一个文件），将要被替换的文字写在A列，替换为的文字写在B列，如果需要分文件的话，将文件名的部分字符串写在C列（C列空的话认为是不区分文件，所有文件都被替换）。
如下图所示：

text1在所有文件中被替换为textA
text2在文件名包含ing2的文件中被替换为textB
text2在文件名包换ing1的文件中被替换为textC
当前的文件名是drawing1，因此text2被替换为textC

jpg102329

1. (DEFUN C:TT(/ E ET LST O RANGE SL SS1 STR STRNEW STROLD)
   
2.   (setq et(vlax-get-or-create-object"excel.application"))
   
3.   (setq range(BF-excel-getusedrange et (BF-excel-getActiveSheet et)))
   
4.   (setq lst(BF-excel-getrangevalue et (BF-excel-getrangeindex range)));内容
   
5.   (setq ss1(ssget'((0 . "*text"))))
   
6.   (setq sl(sslength ss1))
   
7.   (repeat sl
   
8.   (setq e(ssname ss1(setq sl(1- sl))))
   
9.   (setq o(vlax-ename->vla-object e))
   
10.   (setq strold(vlax-get o'textstring))
    
11.   (if (setq str(car(vl-remove-if-not '(lambda(x)(WCMATCH strold (strcat"*"(car x)"*")))lst)));有这个文字
    
12.     (progn
    
13.     (setq strnew(vl-string-subst (cadr str)(car str)strold));新内容
    
14.     (vlax-put o'textstring strnew)
    
15.     )
    
16.     )
    
17.   )(prompt"***大懒猪荣誉出品***")
    
18. (princ)
    
19.   )

(DEFUN C:TT(/ E ET LST O RANGE SL SS1 STR STRNEW STROLD)<br />   (setq et(vlax-get-or-create-object"excel.application"))<br />   (setq range(BF-excel-getusedrange et (BF-excel-getActiveSheet et)))<br />   (setq lst(BF-excel-getrangevalue et (BF-excel-getrangeindex range)));内容<br />   (setq ss1(ssget'((0 . "*text"))))<br />   (setq sl(sslength ss1))<br />   (repeat sl<br />   (setq e(ssname ss1(setq sl(1- sl))))<br />   (setq o(vlax-ename->vla-object e))<br />   (setq strold(vlax-get o'textstring))<br />   (if (setq str(car(vl-remove-if-not '(lambda(x)(WCMATCH strold (strcat"*"(car x)"*")))lst)));有这个文字<br />     (progn<br />     (setq strnew(vl-string-subst (cadr str)(car str)strold));新内容<br />     (vlax-put o'textstring strnew)<br />     )<br />     )<br />   )(prompt"***大懒猪荣誉出品***")<br /> (princ)<br />   )

无法上传附近百度云链接：http://pan.baidu.com/s/1c1X67mC 密码：rac5

crossrainbows

mikewolf2k 发表于 2015-12-25 12:17
再次更新，增加了文件名，可以同一字符串在不同的文件名中被替换为不同的字符串。
使用方法：
加载dvb，A ...

你好。我下载了你的ReplaceMultiText.dvb文件。但是我用cad2014打开alt+F11。提供我acadproject密码。请问密码是什么？我从官网上下载的vba 2014.显示是英文版。第一次没有安装好，第二次就怎么也安装不了了，安装路径是灰度的。我想借用你的程序替换不同的数字。路由图上的数字，特别多。

rdhhb

源码都不共享，有个屁用

mycad

很好的,你可以把源码发给我一份吗,我们可以交换程序,共同学习.

czlj2008@163.com

18hzt

为何不写成命令方便大家呢~

dragonzhou

我也在做地质图的时候，为了解决重复的输入上下标的时候，用vb.net也编写了个程序，可以把选中的文本提取到excel，在另外一列输入改变后的文本，然后一次替换掉，需要的话跟我联系。QQ12230359比这两个好用

phoenixdjq

为什么不共享源码呀

好东西就要大家分享嘛

netseeker

谢谢了～ 试一下！

renjj

谢谢。下来看看

梦醒才知原是梦

学习~~~~~~~~