[分享]批量打开文件批量查找替换【更新第2.1版】

forowhl 发表于 2010-5-15 00:20:00

本帖最后由作者于 2010-9-1 23:53:50 编辑 

使用方法： 1.确保你的电脑上面装有AutoCAD 和 excel 程序。 2.在“TT_AutoCAD文字自动替代.xls”文件里面设置好你要替换的数据，A列是查找项，B列是替换项。注意查找项不能为空，否则后面的查找项将读取不到。 3.点击“批量查找替换”程序，程序会打开配置文件（TT_AutoCAD文字自动替代），如果AutoCAD未启动，程序将打开“TT_AutoCAD启动页.dwg”文件启动AutoCAD。 4.等待一会后，将出现批量查找程序界面。 5.先添加文件，如果添加文件夹，程序会搜索此文件夹（包括子目录）里面dwg图形文件。 6.点击“确定”，等待一会，你的所有添加的文件都将被查找替换。

-----------------------------------------------
  更新第二版，更新内容
  1.这次用的vb做的一个dll组件，界面更漂亮了，增加了CAD应该是所有显示的文字的替换，可以修改被替代对象的颜色。
  如下图。


 2.启动更方便了，直接点击“批量查找替换”的CAD文件启动（启动后记得点启用宏）。
 3.上一个版本做的很不成功，在好些人的电脑上面不能直接运行，需要调试后才能运行，这次试了好几个电脑没有发现问题。
 4..其它小细节方面。
 
欢迎试用，有什么问题可以去我的空间说一下，呵呵！
 
 
 
更新第2.1版，更新内容 1.增加了表格内容替换选项。 2.增加了一个状态栏，有了好些提示，而且可以显示系统时间。 3.其它小细节。

qqask 发表于 2017-8-22 10:04:39

希望能改进，06版，或者更高版本都不行
命令: netload
无法加载程序集。错误详细信息: System.BadImageFormatException:
未能加载文件或程序集“file:///D:\SOFT\CAD批量替换\PiLiangTiHuan.dll”或它的某一
个依赖项。该模块应包含一个程序集清单。
文件名:“file:///D:\SOFT\CAD批量替换\PiLiangTiHuan.dll”
在 System.Reflection.Assembly._nLoad(AssemblyName fileName, String codeBase,
Evidence assemblySecurity, Assembly locationHint, StackCrawlMark& stackMark,
Boolean throwOnFileNotFound, Boolean forIntrospection)
在 System.Reflection.Assembly.nLoad(AssemblyName fileName, String codeBase,
Evidence assemblySecurity, Assembly locationHint, StackCrawlMark& stackMark,
Boolean throwOnFileNotFound, Boolean forIntrospection)
在 System.Reflection.Assembly.InternalLoad(AssemblyName assemblyRef,
Evidence assemblySecurity, StackCrawlMark& stackMark, Boolean forIntrospection)
在 System.Reflection.Assembly.InternalLoadFrom(String assemblyFile, Evidence
securityEvidence, Byte[] hashValue, AssemblyHashAlgorithm hashAlgorithm,
Boolean forIntrospection, StackCrawlMark& stackMark)
在 System.Reflection.Assembly.LoadFrom(String assemblyFile)
在 Autodesk.AutoCAD.Runtime.ExtensionLoader.Load(String fileName)
在 loadmgd()

警告: 程序集绑定日志记录被关闭。
要启用程序集绑定失败日志记录，请将注册表值
(DWORD)设置为 1。
注意: 会有一些与程序集绑定失败日志记录关联的性能损失。
要关闭此功能，请移除注册表值。

wqi127 发表于 2019-11-15 16:50:44

作者您好！一直在用您编写的“批量查找与替换”插件，感觉非常好！现在系统更换成64位的Win7，无法运行，还请您抽出宝贵的时间测试一下！联系方式：lwb@jns.net.cn

dong20030432 发表于 2018-1-15 12:00:48

我的是CAD 2006，2.1和2.3版本都不能正常工作，点击确定后直接跳出完成对话榵，替换报告不出来，是不支持我的版本吗？

forowhl 发表于 2010-5-15 00:24:00

“批量查找替换.exe”程序代码。 Option Explicit '-------------------打开文件------------- Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Const SW_SHOW = 5 '-------------------打开文件------------- '-------------------切换线程------------- Private Declare Function GetWindowThreadProcessId Lib "user32" _     (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function AttachThreadInput Lib "user32" _     (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ShowWindow Lib "user32" _     (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long'Private Const SW_SHOW = 5  '与打开文件里面的重复了，这里取消 Private Const SW_RESTORE = 9 '-------------------切换线程-------------Private Sub Form_Load()   Dim App As Object   Dim AppDoc As Object   Dim xlApp As Object 'Excel.Application   Dim xlSheet As Object ' Worksheet       Dim XPath As String     Dim VBAProjectPath As String   Dim i As Integer      On Error Resume Next       XPath = VB.App.Path       DoEvents       Set App = GetObject(, "autocad.Application")        If Err.Number <> 0 Then     Err.Clear      ShellExecute Me.hwnd, "open", XPath & "\TT_AutoCAD启动页.dwg", vbNullString, vbNullString, SW_SHOW       If Err Then         MsgBox "没有发现正在运行中的AutoCAD，请先启动AutoCAD软件！", vbInformation, "提示"         Err.Clear                  End        End If DengDai:     Set App = GetObject(, "autocad.Application")         'MsgBox "没有发现正在运行中的AutoCAD，请先启动AutoCAD软件！", vbInformation, "提示"        ' End     End If          If App.Documents.Count = 0 Then         App.Documents.Add     End If        Set AppDoc = App.ActiveDocument    If Err Then    Err.Clear    GoTo DengDai    End If              For i = 1 To Len(XPath)       If Mid(XPath, i, 1) = "\" Then        VBAProjectPath = VBAProjectPath & "/"       Else           VBAProjectPath = VBAProjectPath & Mid(XPath, i, 1)             End If     Next i         Set xlApp = GetObject(, "Excel.Application")     Set xlSheet = xlApp.Workbooks("TT_AutoCAD文字自动替代").ActiveSheet         If Err Then         Err.Clear     ShellExecute Me.hwnd, "open", XPath & "\TT_AutoCAD文字自动替代.xls", vbNullString, vbNullString, SW_SHOW         End If     ForceForegroundWindow Me.hwnd     DoEvents         ForceForegroundWindow App.hwnd     AppDoc.SendCommand "-vbarun " & VBAProjectPath & "/批量打开文件文字替代.dvb!ThisDrawing.PiLiangTiHuan "                ForceForegroundWindow App.hwnd     End     End Sub Public Function ForceForegroundWindow(ByVal hwnd As Long) As Boolean    Dim ThreadID1 As Long    ' 线程ID    Dim ThreadID2 As Long    ' 线程ID    Dim nRet As Long       ' 如果指定的窗体已经在前台，不做任何操作    If hwnd = GetForegroundWindow() Then       ForceForegroundWindow = True    Else       ' 首先获得指定窗体相关的线程和当前前台窗口所在的线程       ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)       ThreadID2 = GetWindowThreadProcessId(hwnd, ByVal 0&)             ' 通过共享输入状态，两个线程分享当前窗口       If ThreadID1 <> ThreadID2 Then          Call AttachThreadInput(ThreadID1, ThreadID2, True)          nRet = SetForegroundWindow(hwnd)          Call AttachThreadInput(ThreadID1, ThreadID2, False)       Else          nRet = SetForegroundWindow(hwnd)       End If             ' 恢复和重画       If IsIconic(hwnd) Then          Call ShowWindow(hwnd, SW_RESTORE)       Else          Call ShowWindow(hwnd, SW_SHOW)       End If             ' 精确地返回函数执行结果       ForceForegroundWindow = CBool(nRet)    End If End Function

短歌行 发表于 2010-8-12 14:33:00

谢谢试用了一下就是老爱出现“内存溢出”的错误

forowhl 发表于 2010-8-26 22:33:00

欢迎试用第二版，呵呵！！

zwf100 发表于 2010-10-14 22:53:00

高手，佩服

forowhl 发表于 2010-11-24 19:30:00

更新第2.2版，更新内容  1.增加了批量移出，批量保留功能。本版本没有上传到网络。  
----------------------------------------------------------------- 更新第2.3版，更新内容  1.增加了图纸空间替换，但是只能替换默认图纸空间，如果你的一个图里面有两个布局的话，第二个布局就替换不了，由于水平有限没有好的办法解决，如果你有方法，请去我的空间留言吧，谢谢。。  2.增加了公差的文字替换。  3.在替换报告里面增加了为你节省了多少时间，然后换算成金钱有多少，呵呵，让你切实感受到本软件的好处。  4.其它小细节吧。

lrd1861 发表于 2010-12-4 12:12:21

下来试一试

tjuzkj 发表于 2010-12-19 19:23:06

下来试一试,谢谢楼主

mikewolf2k 发表于 2010-12-20 10:40:45

俺以前也做过类似的程序，http://bbs.mjtd.com/forum.php?mod=viewthread&tid=32200&highlight=%B6%E0%D6%D8
几点建议：
1. 能完成dtext的替换
2. 能完成mtext的替换
3. 能完成块属性的替换
4. 能完成块内text的替换
5. 替换的规则是什么，只修改一次还是每次对修改后的文本重新进行替换？（“AA”替换成“AA+”是死循环么？“AA”替换成“A”会导致“AAAA”变成“AA”还是“A”？）

forowhl 发表于 2011-5-10 22:00:52

回复 mikewolf2k 的帖子

只替换一次，不是死循环

页: [1] 2 3 4 5

明经CAD社区's Archiver

[分享]批量打开文件批量查找替换【更新第2.1版】