在每张图纸上查找和替换 Solidworks 宏

Question

我有一些 VBA 的背景，我讨厌做同样的任务 100 次。我经常需要制作 Solidworks 图纸，这些图纸是模板，主要是我填充数据的表格。文件中的每张纸上需要更改 3 项内容（从第 3 页到最后一张）。通常我会进入每张纸并进行 3 次查找和替换以更改每张纸。然后转到下一张纸并重复。

我的计划是让代码计算工作表的数量，提示用户第一次查找/替换，替换所有工作表上的文本，然后重复第二次替换，第三次重复。我录制了一个宏并添加了一些代码，但我不断收到运行时错误（在下面的代码中）。我记录的每个其他宏都没有给我这么多错误，如果你能帮忙

Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim Part As Object
Dim Otext As String
Dim Ntext As String
Dim Smax As Integer
Dim i As Integer
Dim swSheet As SldWorks.Sheet
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc
 'Set swSheet = swdraw.GetCurrentSheet

Smax = instance.GetSheetCount() - 3   ' runtime 424 error here
Set swSheet = swdraw.GetCurrentSheet  ' runtime 91 error if i skip the line above

Otext = Application.InputBox("find this text")
Ntext = Application.InputBox("find this text")

For i = 1 To Smax

Set Part = swApp.ActiveDoc
'--------------------Find and Replace Annotations--------------------
Set swUtil = swApp.GetAddInObject("Utilities.UtilitiesApp")
Set swUtilFindReplaceAnnotations = swUtil.FindReplaceAnnotations
longstatus = swUtilFindReplaceAnnotations.InitPMPage()
'--------------------Block Recording--------------------
#If 0 Then
#End If
'--------------------UnBlock Recording------------------
swUtilFindReplaceAnnotations.FindText = Otext
swUtilFindReplaceAnnotations.ReplaceText = Ntext
swUtilFindReplaceAnnotations.options = gtFraMatchCase
swUtilFindReplaceAnnotations.AnnotationFilter = gtFraAllTypes
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
longstatus = swUtilFindReplaceAnnotations.ReplaceAll()
'--------------------Block Recording--------------------
#If 0 Then
#End If
'--------------------UnBlock Recording------------------
longstatus = swUtilFindReplaceAnnotations.Close()
Part.SheetNext
Part.ViewZoomtofit2

Next i

End Sub

Answer 1

这应该可以解决问题。它将为每张工作表弹出一个成功窗口，但这就是 SOLIDWORKS 查找替换实用程序的工作方式。

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim vSheetNames As Variant
Dim longstatus As Long

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawingDoc = swModel
    vSheetNames = swDrawingDoc.GetSheetNames
    Otext = InputBox("find this text")
    Ntext = InputBox("find this text")

    For i = 0 To UBound(vSheetNames)
        swDrawingDoc.ActivateSheet (vSheetNames(i))
        Set swUtil = swApp.GetAddInObject("Utilities.UtilitiesApp")
        Set swUtilFindReplaceAnnotations = swUtil.FindReplaceAnnotations
        longstatus = swUtilFindReplaceAnnotations.InitPMPage()
        swUtilFindReplaceAnnotations.FindText = Otext
        swUtilFindReplaceAnnotations.ReplaceText = Ntext
        swUtilFindReplaceAnnotations.Options = gtFraWholeWord
        swUtilFindReplaceAnnotations.AnnotationFilter = gtFraAllTypes
        longstatus = swUtilFindReplaceAnnotations.ReplaceAll()
        longstatus = swUtilFindReplaceAnnotations.Close()
    Next i

End Sub