Skip to content

Commit aecb10a

Browse files
artem1tartem1t
committed
Added export and export individual bodies macro+
1 parent 1c69303 commit aecb10a

File tree

5 files changed

+410
-0
lines changed

5 files changed

+410
-0
lines changed

‎solidworks-api/import-export/export-individual-bodies/CustomVariableValueProvider.vba‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
Option Explicit
2+
3+
Implements IMacroCustomVariableValueProvider
4+
5+
Function IMacroCustomVariableValueProvider_Provide(ByVal varName As String, ByVal args As Variant, ByVal context As Variant) As Variant
6+
7+
Dim swBody As SldWorks.Body2
8+
Set swBody = context
9+
10+
Select Case varName
11+
Case "bodyName":
12+
IMacroCustomVariableValueProvider_Provide = swBody.Name
13+
Case Else
14+
Err.Raise vbError, "", "Not supported variable: " & varName
15+
End Select
16+
17+
End Function

‎solidworks-api/import-export/export-individual-bodies/Macro.vba‎

Lines changed: 223 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,223 @@
1+
'#Const TEST = True
2+
3+
Dim swApp As SldWorks.SldWorks
4+
Dim swCadPlus As ICadPlusSwAddIn
5+
6+
Sub main()
7+
8+
Set swApp = Application.SldWorks
9+
10+
Dim swCadPlusFact As CadPlusSwAddInFactory
11+
Set swCadPlusFact = New CadPlusSwAddInFactory
12+
13+
Set swCadPlus = swCadPlusFact.Create(swApp, True)
14+
15+
Dim macroOper As IMacroOperation
16+
Set macroOper = GetMacroOperation()
17+
18+
Dim vArgs As Variant
19+
vArgs = macroOper.Arguments
20+
21+
Dim swModel As SldWorks.ModelDoc2
22+
Set swModel = macroOper.model
23+
24+
Dim swPart As SldWorks.PartDoc
25+
26+
Set swPart = swModel
27+
28+
Dim vBodies As Variant
29+
vBodies = swPart.GetBodies2(swBodyType_e.swAllBodies, True)
30+
31+
Dim i As Integer
32+
Dim swBody As SldWorks.Body2
33+
34+
Dim customVarValProv As IMacroCustomVariableValueProvider
35+
Set customVarValProv = New CustomVariableValueProvider
36+
37+
Dim resFilePaths() As String
38+
Dim inputBodies() As SldWorks.Body2
39+
40+
For i = 0 To UBound(vBodies)
41+
42+
Set swBody = vBodies(i)
43+
44+
Dim j As Integer
45+
46+
For j = 0 To UBound(vArgs)
47+
48+
Dim macroArg As IMacroArgument
49+
Set macroArg = vArgs(j)
50+
51+
Dim fileName As String
52+
fileName = macroArg.GetValue(customVarValProv, swBody)
53+
54+
Dim filePath As String
55+
filePath = GetDirectory(swModel.GetPathName) & fileName
56+
57+
If (Not resFilePaths) = -1 Then
58+
ReDim resFilePaths(0)
59+
ReDim inputBodies(0)
60+
Else
61+
ReDim Preserve resFilePaths(UBound(resFilePaths) + 1)
62+
ReDim Preserve inputBodies(UBound(inputBodies) + 1)
63+
End If
64+
65+
resFilePaths(UBound(resFilePaths)) = filePath
66+
Set inputBodies(UBound(inputBodies)) = swBody
67+
68+
Next
69+
70+
Next
71+
72+
Dim vResFiles As Variant
73+
vResFiles = macroOper.SetResultFiles(resFilePaths)
74+
75+
For i = 0 To UBound(vResFiles)
76+
77+
Dim resFile As IMacroOperationResultFile
78+
Set resFile = vResFiles(i)
79+
Set swBody = inputBodies(i)
80+
81+
Dim ext As String
82+
ext = GetExtension(resFile.path)
83+
84+
If LCase(ext) = "dxf" Or LCase(ext) = "dwg" Then
85+
If False <> swBody.IsSheetMetal() Then
86+
TryExportFlatPattern swModel, swBody, resFile, macroOper
87+
Else
88+
resFile.Status = MacroOperationResultFileStatus_e_Initializing
89+
macroOper.ReportIssue "Flat pattern export is skipped for " & swBody.Name, MacroIssueType_e_Information
90+
End If
91+
Else
92+
TryExportBody swModel, swBody, resFile, macroOper
93+
End If
94+
95+
Next
96+
97+
End Sub
98+
99+
Sub TryExportBody(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation)
100+
101+
try_:
102+
On Error GoTo catch_
103+
104+
Dim swSelMgr As SldWorks.SelectionMgr
105+
Set swSelMgr = model.SelectionManager
106+
107+
swSelMgr.SuspendSelectionList
108+
109+
Dim swBodies(0) As SldWorks.Body2
110+
Set swBodies(0) = body
111+
112+
If swSelMgr.AddSelectionListObjects(swBodies, Nothing) = 1 Then
113+
114+
Dim filePath As String
115+
filePath = resFile.path
116+
117+
Dim errs As Long
118+
Dim warns As Long
119+
Dim dir As String
120+
121+
dir = GetDirectory(filePath)
122+
123+
CreateDirectories dir
124+
125+
If False <> model.Extension.SaveAs2(filePath, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, "", False, errs, warns) Then
126+
resFile.Status = MacroOperationResultFileStatus_e_Succeeded
127+
Else
128+
Err.Raise vbError, "", "Failed to export '" & body.Name & "' to '" & filePath & "'. Error code: " & errs
129+
End If
130+
Else
131+
Err.Raise vbError, "", "Failed to select " & body.Name
132+
End If
133+
134+
GoTo finally_
135+
catch_:
136+
macroOper.ReportIssue Err.Description, MacroIssueType_e_Error
137+
resFile.Status = MacroOperationResultFileStatus_e_Failed
138+
finally_:
139+
140+
swSelMgr.ResumeSelectionList2 False
141+
142+
End Sub
143+
144+
Sub TryExportFlatPattern(model As SldWorks.ModelDoc2, body As SldWorks.Body2, resFile As IMacroOperationResultFile, macroOper As MacroOperation)
145+
146+
try_:
147+
On Error GoTo catch_
148+
149+
Dim expData(0) As FlatPatternExportDataCom
150+
Set expData(0) = New FlatPatternExportDataCom
151+
152+
Set expData(0).body = body
153+
expData(0).Options = FlatPatternOptionsCom_e.FlatPatternOptionsCom_e_BendLines
154+
expData(0).OutFilePath = resFile.path
155+
156+
Dim vRes As Variant
157+
vRes = swCadPlus.FlatPatternExport.BatchExportFlatPatterns(model, expData)
158+
159+
Dim res As FlatPatternExportResult
160+
Set res = vRes(0)
161+
162+
If False = res.Succeeded Then
163+
Err.Raise vbError, "", res.Error
164+
End If
165+
166+
resFile.Status = MacroOperationResultFileStatus_e_Succeeded
167+
168+
GoTo finally_
169+
catch_:
170+
macroOper.ReportIssue Err.Description, MacroIssueType_e_Error
171+
resFile.Status = MacroOperationResultFileStatus_e_Failed
172+
finally_:
173+
174+
End Sub
175+
176+
Function GetMacroOperation() As IMacroOperation
177+
178+
Dim macroOper As IMacroOperation
179+
180+
#If TEST Then
181+
Dim swCadPlusFact As Object
182+
Set swCadPlusFact = CreateObject("CadPlusFactory.Sw")
183+
184+
Set swCadPlus = swCadPlusFact.Create(swApp, False)
185+
186+
Dim args(2) As String
187+
args(0) = "MFGs\STEP\{ path [FileNameWithoutExtension] }-{ bodyName }.step"
188+
args(1) = "MFGs\IGES\{ path [FileNameWithoutExtension] }-{ bodyName }.igs"
189+
args(2) = "MFGs\DWG\{ path [FileNameWithoutExtension] }-{ bodyName }.dwg"
190+
Set macroOper = swCadPlus.CreateMacroOperation(swApp.ActiveDoc, "", args)
191+
#Else
192+
Dim macroOprMgr As IMacroOperationManager
193+
Set macroOprMgr = CreateObject("CadPlus.MacroOperationManager")
194+
195+
Set macroOper = macroOprMgr.PopOperation(swApp)
196+
#End If
197+
198+
Set GetMacroOperation = macroOper
199+
200+
End Function
201+
202+
Function GetExtension(path As String) As String
203+
GetExtension = Right(path, Len(path) - InStrRev(path, "."))
204+
End Function
205+
206+
Function GetDirectory(path As String)
207+
GetDirectory = Left(path, InStrRev(path, "\"))
208+
End Function
209+
210+
Sub CreateDirectories(path As String)
211+
212+
Dim fso As Object
213+
Set fso = CreateObject("Scripting.FileSystemObject")
214+
215+
If fso.FolderExists(path) Then
216+
Exit Sub
217+
End If
218+
219+
CreateDirectories fso.GetParentFolderName(path)
220+
221+
fso.CreateFolder path
222+
223+
End Sub

‎solidworks-api/import-export/export-individual-bodies/index.md‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
---
2+
caption: Export Individual Bodies
3+
title: Export individual bodies and flat-patterns from SOLIDWORKS part file via Macro+ framework
4+
description: VBA macro demonstrates how to use Macro+ and CAD+ API to export individual bodies to foreign format and flat pattern (for sheet metal) from the active SOLIDWORKS part
5+
image:
6+
macro-plus: vba
7+
---
8+
9+
This VBA macro is [Macro+](https://cadplus.xarial.com/macro-plus/) enabled macro that allows exporting all bodies in the active part file as individual files to foreign format (e.g. STEP, IGES, Parasolid etc.).
10+
11+
Sheet metal bodies could be exported to DXF/DWG format as flat pattern via [Flat Pattern Export](https://cadplus.xarial.com/drawing/export-flat-patterns/) tool API of [CAD+ Toolset](https://cadplus.xarial.com/)
12+
13+
This macro supports the custom argument **bodyName** and it will be resolved to the corresponding body name.
14+
15+
{% code-snippet { file-name: Macro.vba } %}
16+
17+
## CustomVariableValueProvider Class Module
18+
19+
{% code-snippet { file-name: CustomVariableValueProvider.vba } %}

0 commit comments

Comments
 (0)