Solidworks宏查找并替换每个图纸

Question

我在VBA上有一些背景，我讨厌100次执行相同的任务。我经常必须制作固体图纸，这些图纸是模板，主要是我用数据填充的桌子。文件中的每个纸上需要更改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

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

这对我有好处！

Answer 2

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swView As SldWorks.View
Dim swNote As SldWorks.Note
Dim vSheetNames As Variant
Dim Otext As String
Dim Ntext As String

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "No active document found. Please open a drawing file.", vbCritical
        Exit Sub
    End If

    If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
        MsgBox "Active document is not a drawing. Please open a drawing file.", vbCritical
        Exit Sub
    End If

    Set swDrawingDoc = swModel
    vSheetNames = swDrawingDoc.GetSheetNames
    If IsEmpty(vSheetNames) Then
        MsgBox "No sheets found in the drawing.", vbCritical
        Exit Sub
    End If

    Otext = InputBox("Find this text")
    Ntext = InputBox("Replace with this text")

    For i = 0 To UBound(vSheetNames)
        swDrawingDoc.ActivateSheet vSheetNames(i)
        Set swSheet = swDrawingDoc.GetCurrentSheet()

        ' Access the sheet format view directly
        Set swView = swDrawingDoc.GetFirstView
        If Not swView Is Nothing Then
            Set swNote = swView.GetFirstNote
            Do While Not swNote Is Nothing
                If InStr(1, swNote.GetText, Otext, vbTextCompare) > 0 Then
                    swNote.SetText Replace(swNote.GetText, Otext, Ntext)
                End If
                Set swNote = swNote.GetNext
            Loop
        End If
    Next i

    MsgBox "Text replacement complete."

End Sub