可以使用SOLIDWORKS API函数ISldWorks::RunMacro2从另一个宏中运行宏。
这使得在一个宏中运行多个宏成为可能。当在宏工具栏上添加自定义宏按钮时,这非常有用,因为可以通过单击一个按钮来执行多个命令。
以下示例允许在一个宏中运行多个SOLIDWORKS宏。
Dim swApp As SldWorks.SldWorksSub main() Set swApp = Application.SldWorks RunMacro "C:MacrosMacro1.swp", "Macro11", "main" RunMacro "C:MacrosMacro2.swp", "Macro21", "main" RunMacro "C:MacrosMacro3.swp", "Macro31", "main" End SubSub RunMacro(path As String, moduleName As String, procName As String) swApp.RunMacro2 path, moduleName, procName, swRunMacroOption_e.swRunMacroUnloadAfterRun, 0End Sub更改RunMacro调用的参数以调用您自己的一组宏。
RunMacro "宏的完整路径", "模块名称", "入口函数名称"其中
{ width=350 }
宏的完整路径 - .swp或.dll的完整路径,用于VBA或VSTA宏模块名称 - 定义主入口函数的模块的名称。通常是宏名称后跟1。入口函数名称 - 入口函数的名称。此函数不能有参数。通常命名为main根据需要修改宏。您可以添加或删除对RunMacro的调用,并更改路径、模块和函数名称以匹配库中宏的路径
以下宏提供了更高级的运行宏功能。它允许指定多个逗号分隔的宏以及使用完整路径或相对路径的文件夹。
这样可以更好地维护宏。
此宏还处理以下错误:
当找不到指定的宏路径时:{ width=250 }
当无法运行宏时(例如宏损坏){ width=250 }
要配置宏,需要修改MACROS_PATH变量的值:
可以通过逗号分隔它们来指定要运行的多个宏,例如Macro1.swp, Macro2.swp可以使用完整路径(例如D:MacrosMacro1.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, MacrosAssembly"Const PATH_DELIMETER As String = ","Const MACRO_EXT As String = "swp"Dim swApp As SldWorks.SldWorksSub main() Set swApp = Application.SldWorks Dim swMacrosColl As Collection Set swMacrosColl = New Collection AddMacros swMacrosColl Set swMacrosColl = ResolvePaths(swMacrosColl) RunMacros swMacrosCollEnd SubFunction 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 FunctionSub 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 SubSub 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 SubSub 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 SubSub 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