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

如果你喜欢我们的文章,欢迎您分享或收藏彩红网的文章! 我们网站的目标是帮助每一个有求知欲的人,无论他们的水平和经验如何。我们相信,只要有热情和毅力,无论从什么时候开始学习都不晚。
热帖

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

 

solidworks文件夹批量执行宏之宏之宏-彩红网
solidworks文件夹批量执行宏之宏之宏
此内容为付费资源,请付费后查看
30积分
付费资源
© 版权声明
THE END
喜欢就支持一下吧
点赞11赞赏 分享
评论 抢沙发
头像
欢迎您留下宝贵的见解!
提交
头像

昵称

取消
昵称表情图片

    暂无评论内容