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

forowhl

使用方法：
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

希望能改进，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()

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

wqi127

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

dong20030432

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

forowhl

“批量查找替换.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

短歌行

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

forowhl

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

zwf100

高手，佩服

forowhl

 

更新第2.2版，更新内容
 1.增加了批量移出，批量保留功能。本版本没有上传到网络。
 

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

 

lrd1861

下来试一试

tjuzkj

下来试一试,谢谢楼主

mikewolf2k

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

forowhl

回复 mikewolf2k 的帖子

只替换一次，不是死循环