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

Solidworks Macro在每个图纸上查找和替换

1 个答案: