solidworks文件夹批量执行宏之宏之宏

solidworks文件夹批量执行宏之宏之宏

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Myfile As String
Dim ext As String
Private Sub browseFolderButton_Click()
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
    If Not objFolder Is Nothing Then
        folderTextBox = objFolder.self.Path & "\"
    End If
    Set objFolder = Nothing
    Set objShell = Nothing
    If prtCheckBox.Value = False And asmCheckBox.Value = False And drwCheckBox.Value = False Then prtCheckBox.Value = True
    If prtCheckBox.Value = True Then
        ext = "*.sldprt"
        AddItemToListBox
    End If
    If asmCheckBox.Value = True Then
        ext = "*.sldasm"
        AddItemToListBox
    End If
    If drwCheckBox.Value = True Then
        ext = "*.slddrw"
        AddItemToListBox
    End If
End Sub
Private Function AddItemToListBox()
    If folderTextBox <> "" Then
        Myfile = Dir(folderTextBox & ext)
        Do While Myfile <> ""
            fileListBox.AddItem folderTextBox & Myfile
            Myfile = Dir
            If Myfile = "" Then Exit Do
        Loop
    End If
End Function
Private Sub clearAllButton_Click()
    folderTextBox.Value = ""
    fileListBox.Clear
End Sub
Private Sub killFileButton_Click()
    Dim i As Integer
    If fileListBox.ListCount > 0 Then
        For i = fileListBox.ListCount - 1 To 0 Step -1
            If fileListBox.Selected(i) Then
                fileListBox.RemoveItem i
            End If
        Next i
    End If
End Sub

Private Sub MacroTextBox_Change()

End Sub

Private Sub selectMacroButton_Click()
    Dim filter                      As String
    Dim fileName                    As String
    Dim fileConfig                  As String
    Dim fileDispName                As String
    Dim fileOptions                 As Long
    Dim modulenames               As Variant
    Dim moduleName() As String
    Dim modulefilter                      As Integer
    Dim i As Integer
    modulefilter = 3 'swAllMethods
    Set swApp = Application.SldWorks
    filter = "宏 (*.swp)|*.swp|"
    fileName = swApp.GetOpenFileName("选取宏程序", "", filter, fileOptions, fileConfig, fileDispName)
    If fileName <> "" Then
        MacroTextBox = fileName
        modulenames = swApp.GetMacroMethods(fileName, modulefilter)
        moduleComboBox.Clear
        For i = 0 To UBound(modulenames)
            moduleComboBox.AddItem modulenames(i)
        Next i
        For i = 0 To UBound(modulenames)
            If UCase(Right(modulenames(i), 4)) = "MAIN" Then  'InStr(UCase(modulenames(i)), "MAIN") <> 0
               moduleComboBox.ListIndex = i
               Exit For
            Else
               moduleComboBox.ListIndex = i
            End If
        Next i
    End If
End Sub
Private Sub runButton_Click()
    If MacroTextBox = "" Or moduleComboBox.Text = "" Then
        MsgBox "请先设置好批量执行宏程序的各项参数！"
    Else
        If fileListBox.ListCount <> 0 Then
            For i = 0 To fileListBox.ListCount - 1
                Myfile = fileListBox.List(i)
                If UCase(Right(Myfile, 3)) = "PRT" Then swFileTYpe = 1
                If UCase(Right(Myfile, 3)) = "ASM" Then swFileTYpe = 2
                If UCase(Right(Myfile, 3)) = "DRW" Then swFileTYpe = 0
                Set swApp = Application.SldWorks
                Set swDoc = swApp.OpenDoc(Myfile, swFileTYpe) '开启档案
                Set Part = swApp.ActiveDoc
                Call swapp_activemodeldocchangenotify
                swApp.CloseDoc Myfile
            Next i
            MsgBox "文件列表框内文件已执行完毕"
        Else
            MsgBox "文件列表框没有文件供批量执行"
        End If
    End If
End Sub
Private Sub exitButton_Click()
    Unload Me
End Sub
Private Function swapp_activemodeldocchangenotify() As Long
    Dim runmacroerror As Long
    Dim moduleName, procedureName As String
    Dim temp As Variant
    temp = Split(moduleComboBox.Text, ".")
    moduleName = temp(0)
    procedureName = temp(1)
    swApp.RunMacro2 MacroTextBox.Text, moduleName, procedureName, 0, runmacroerror
End Function