使用SOLIDWORKS API运行一组宏的宏

Windows文件夹中的宏库

可以使用SOLIDWORKS API函数ISldWorks::RunMacro2从另一个宏中运行宏。

这使得在一个宏中运行多个宏成为可能。当在宏工具栏上添加自定义宏按钮时，这非常有用，因为可以通过单击一个按钮来执行多个命令。

以下示例允许在一个宏中运行多个SOLIDWORKS宏。

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    RunMacro "C:\Macros\Macro1.swp", "Macro11", "main"
    RunMacro "C:\Macros\Macro2.swp", "Macro21", "main"
    RunMacro "C:\Macros\Macro3.swp", "Macro31", "main"
    
End Sub

Sub RunMacro(path As String, moduleName As String, procName As String)
    swApp.RunMacro2 path, moduleName, procName, swRunMacroOption_e.swRunMacroUnloadAfterRun, 0
End Sub

更改RunMacro调用的参数以调用您自己的一组宏。

RunMacro "宏的完整路径", "模块名称", "入口函数名称"

其中

宏入口点 { width=350 }

宏的完整路径 - .swp或.dll的完整路径，用于VBA或VSTA宏
模块名称 - 定义主入口函数的模块的名称。通常是宏名称后跟1。
入口函数名称 - 入口函数的名称。此函数不能有参数。通常命名为main

根据需要修改宏。您可以添加或删除对RunMacro的调用，并更改路径、模块和函数名称以匹配库中宏的路径

以下宏提供了更高级的运行宏功能。它允许指定多个逗号分隔的宏以及使用完整路径或相对路径的文件夹。

这样可以更好地维护宏。

此宏还处理以下错误：

当找不到指定的宏路径时：

找不到宏错误 { width=250 }

当无法运行宏时（例如宏损坏）

无法运行宏错误 { width=250 }

要配置宏，需要修改MACROS_PATH变量的值：

可以通过逗号分隔它们来指定要运行的多个宏，例如Macro1.swp, Macro2.swp
可以使用完整路径（例如D:\Macros\Macro1.swp）或使用相对路径（例如Macro1.swp）指定宏。如果后者，宏必须与此主宏位于同一文件夹中
可以指定要运行的宏的文件夹（例如D:\Macros或Macros）。与宏路径一样，接受完整路径或相对文件夹路径。在这种情况下，将运行指定文件夹中的所有宏
如果指定空字符串，即

Const MACROS_PATH As String = " "

将运行放置此主宏的文件夹中的所有宏。此选项非常有用，因为只需将主宏复制到宏库的位置即可运行，无需修改它。

#If VBA7 Then
     Private Declare PtrSafe Function PathIsRelative Lib "shlwapi" Alias "PathIsRelativeA" (ByVal path As String) As Boolean
#Else
     Private Declare Function PathIsRelative Lib "shlwapi" Alias "PathIsRelativeA" (ByVal Path As String) As boolean
#End If
        
Const MACROS_PATH As String = "Macro1.swp, D:\Macro2.swp, D:\MacrosFolder, Macros\Assembly"

Const PATH_DELIMETER As String = ","
Const MACRO_EXT As String = "swp"

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
              
    Dim swMacrosColl As Collection
    Set swMacrosColl = New Collection
    
    AddMacros swMacrosColl
    
    Set swMacrosColl = ResolvePaths(swMacrosColl)
    
    RunMacros swMacrosColl

End Sub

Function ResolvePaths(swMacrosColl As Collection) As Collection

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim resColl As Collection
    Set resColl = New Collection
    
    Dim i As Integer
    
    For i = 1 To swMacrosColl.Count
        
        Dim path As String
        path = swMacrosColl(i)
        
        If PathIsRelative(path) Then
            path = fso.BuildPath(swApp.GetCurrentMacroPathFolder(), path)
        End If
        
        If fso.FolderExists(path) Then
            
            swMacrosColl.Remove i
            
            For Each file In fso.GetFolder(path).Files
                If LCase(fso.GetExtensionName(file)) = LCase(MACRO_EXT) Then
                    AddMacroToCollection resColl, file.path
                End If
            Next
            
        ElseIf fso.FileExists(path) Then
            AddMacroToCollection resColl, path
        Else
            Err.Raise vbObjectError, , "找不到宏文件：" & path
        End If
        
    Next
    
    Set ResolvePaths = resColl
    
End Function

Sub AddMacroToCollection(coll As Collection, item As String)
    
    If UCase(item) <> UCase(swApp.GetCurrentMacroPathName()) Then
        Dim i As Integer
        
        For i = 1 To coll.Count
            If UCase(coll.item(i)) = UCase(item) Then
                Exit Sub
            End If
        Next
        
        coll.Add item
    End If
    
End Sub

Sub RunMacros(swMacrosColl As Collection)
    
    Dim i As Integer
    
    For i = 1 To swMacrosColl.Count
        Dim path As String
        path = swMacrosColl(i)
        Dim macroErr As Long
        
        Dim moduleName As String
        Dim procName As String
        
        GetMacroEntryPoint path, moduleName, procName
        
        If False = swApp.RunMacro2(path, moduleName, procName, swRunMacroOption_e.swRunMacroUnloadAfterRun, macroErr) Then
            Err.Raise vbObjectError, , "无法运行宏：" & path & "，错误：" & macroErr
        End If
        
    Next
    
End Sub

Sub GetMacroEntryPoint(macroPath As String, ByRef moduleName As String, ByRef procName As String)
        
    Dim vMethods As Variant
    vMethods = swApp.GetMacroMethods(macroPath, swMacroMethods_e.swMethodsWithoutArguments)
    
    Dim i As Integer
    
    If Not IsEmpty(vMethods) Then
    
        For i = 0 To UBound(vMethods)
            Dim vData As Variant
            vData = Split(vMethods(i), ".")
            
            If i = 0 Or LCase(vData(1)) = "main" Then
                moduleName = vData(0)
                procName = vData(1)
            End If
        Next
        
    End If
    
End Sub

Sub AddMacros(swMacrosColl As Collection)
    
    Dim vPaths As Variant
    vPaths = Split(MACROS_PATH, PATH_DELIMETER)
    
    Dim i As Integer
    
    For i = 0 To UBound(vPaths)
    
        Dim path As String
        path = Trim(vPaths(i))
        swMacrosColl.Add path
        
    Next
    
End Sub