I am having trouble with this macro its aim is to export multibody with mapping dxfs so they all appear on the model sheet (SW usually exports the first pattern to model sheet all subsequent on Drawing View and model sheet blank). Unfortunately, my macro exports the same flat pattern(1st) to all model spaces and the correct view is still in Drawing View. Appreciate your help fixing this.
Option Explicit
Sub ExportFlatPatternsDXF()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swFeature As SldWorks.Feature
Dim partPath As String
Dim outputPath As String
Dim fileName As String
Dim flatPatternCount As Integer
Dim exportOptions As Integer
' Initialize SolidWorks application and active document
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Check if the active document is a part file
If Not swModel.GetType() = swDocPART Then
MsgBox "Active document is not a part file", vbCritical, "Error"
Exit Sub
End If
Set swPart = swModel
' Verify that the part has been saved
partPath = swModel.GetPathName()
If partPath = "" Then
MsgBox "Please save the document first", vbCritical, "Error"
Exit Sub
End If
' Get the folder path of the part file and create an output folder for DXFs
outputPath = Left(partPath, InStrRev(partPath, "\\")) & "DXF Exports\\"
On Error Resume Next
MkDir outputPath ' Create the folder if it doesn't exist
On Error GoTo 0
' Initialize flat pattern count and export options (1 = Geometry, 4 = Bend Lines)
flatPatternCount = 0
exportOptions = 1 + 4 ' Combine options for geometry and bend lines
' Get the first feature in the FeatureManager tree
Set swFeature = swModel.FirstFeature
' Loop through all features in the FeatureManager tree
Do While Not swFeature Is Nothing
' Check if the feature is a flat pattern feature
If swFeature.GetTypeName2 = "FlatPattern" Then
' Unsuppress the flat pattern feature to ensure it exports correctly
swFeature.SetSuppression2 1, 2, Nothing ' 1 = Unsuppress
' Force rebuild to ensure proper export of current flat pattern
swModel.ForceRebuild3 False
' Use the flat pattern feature's name for the DXF filename
fileName = outputPath & swFeature.Name & ".dxf"
' Export to DXF with bend lines included and enable layer mapping dialog box
If Not swPart.ExportToDWG2(fileName, partPath, _
swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, Empty, _
False, False, exportOptions, Empty) Then
MsgBox "Failed to export: " & swFeature.Name, vbExclamation, "Export Error"
Else
flatPatternCount = flatPatternCount + 1 ' Increment count on successful export
MsgBox "Successfully exported: " & fileName, vbInformation, "Export Success"
End If
' Suppress the flat pattern feature again after export to avoid conflicts with subsequent exports
swFeature.SetSuppression2 0, 2, Nothing ' 0 = Suppress
End If
' Move to the next feature in the FeatureManager tree
Set swFeature = swFeature.GetNextFeature()
Loop
' Notify user of changes made (number of features exported)
MsgBox flatPatternCount & " flat pattern features exported to DXF.", vbInformation, "Export Complete"
End Sub
