Solidworks step file - sheet metal - dxf export tool

Hi everyone,

although this question has been raised several times and I went through several posts - I still have issues with understanding how to get my Macro working. Currently, I am extremely thankful for the sushi sheet metal to dxf tool, which I found in another post here. This works fine with single parts, which I manually convert into Sheet metal parts, collect bends, and then run the macro. But once I am running the tool on the entire assembly it won´t work.

 

More about my current situation: 

I receive step files and have to convert them to dxf for AutoCAD, the assembly needs to be "break link" first, then child parts need to be converted to sheet metal collecting all the bends considering the k factor as 0.4 mm, then flatten the converted part and save it to dxf along with options as bend lines selected, 

sometimes child parts with chamfers won't get converted to sheet metal while collecting all the bends.

 

This entire process is very time-consuming and I believe there are many shortcuts I might have missed out. 

 

thank you very much and please don't be to harsh on my limited knowledge. 

 

best regards, Dennis

 

thank you Kevin 🙂 

 

Option Explicit

Global swApp                    As SldWorks.SldWorks
Global swModel                  As SldWorks.ModelDoc2
Global SaveLocation             As String

Global DocNameAndExtension      As String
Global ExportDocName            As String
Global CurrentFolder            As String
Global RefPartFilePathName      As String

Global TempNewFolderName        As String
Global TempFolderSuffix         As String
Global SaveLocationSet          As Boolean
Global ParentFolderPath         As String
Global OriginalFolderPath       As String
Global OriginalPathName         As String
Global NewFolderName            As String

Global TotalsForExport          As Integer
Global CurrentForExportCount    As Integer

Global MappingFileLocation      As String
Global AltSaveLocation          As String

Global ConfigSuffix             As String

Global swFileType               As String
Global swExportType             As String

Global SingleStartConfig        As String
Global ExportConfigsArr         As Variant
Global ExportFilesArr           As Variant

Global FailedToExportArr           As Variant

Global CorrectBendsOnly         As Boolean

Global origDxfMapping As Boolean
Global origDxfDontShowMap As Boolean
Global origDxfVersion As Integer
Global origDxfOutputFonts As Integer
Global origDxfMappingFileIndex As Integer
Global origDxfOutputLineStyles As Integer
Global origDxfMappingFiles As String
Global origDxfEndPointMerge As Boolean
Global origDxfMergingDistance As Double
Global origDxfHighQualityExport As Boolean
Global origDxfExportSplinesAsSplines As Boolean 'true = splines. false = polylines

Global ExpFilePosition(8)       As Variant
Global Const ConfiguratorConfig = "-CONFIG-"
Global Const ConfiguratorPartName = "-PART NAME-"
Global Const ConfiguratorThickness = "-THICKNESS-"
Global Const ConfiguratorMaterial = "-MATERIAL-"
Global Const ConfiguratorFlatFeat = "-FLAT-FEAT #-"

Global MapFiles() As String

Private Const SW_RESTORE = 9

#If VBA7 Then
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    'Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    'Private Declare Function IsIconic Lib "user32.dll" (ByVal hwnd As Long) As Long
#End If

Public Function UpdateStatus(Status As String, StatusForeColor As String, Part As String, Config As String)

frmStatus.lblStatus = Status
frmStatus.lblStatus.ForeColor = StatusForeColor
frmStatus.lblCurrentPart = Part
frmStatus.lblCurrentConfig = Config
frmStatus.Repaint

End Function
Sub MainRoutine()

On Error Resume Next

Dim TimeClock           As Date
Dim f                   As Long
Dim DisplayText         As String
Dim CheckParamsResult   As Variant
Dim InitSwModel         As String
Dim p As Long
Dim error               As Boolean

If frmControlPanel.optSingle = False And frmControlPanel.optBatch = False And frmControlPanel.optAssembly = False Then
    MsgBox "An 'Export Type' must be selected.", vbExclamation, "Export type required"
    Exit Sub
End If

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetPathName <> OriginalPathName Then
    MsgBox "Filename Mismatch. Changing files after initiating the " & _
            "control panel is not allowed. Please rerun the Tool.", _
            vbCritical + vbOKOnly, "Filename Mismatch"
    End
End If

CheckParamsResult = CheckFileAndExportType

If frmControlPanel.Controls("cboPos" & (1)) = "" And _
   frmControlPanel.Controls("cboPos" & (2)) = "" And _
   frmControlPanel.Controls("cboPos" & (3)) = "" And _
   frmControlPanel.Controls("cboPos" & (4)) = "" And _
   frmControlPanel.Controls("cboPos" & (5)) = "" And _
   frmControlPanel.Controls("cboPos" & (6)) = "" And _
   frmControlPanel.Controls("cboPos" & (7)) = "" And _
   frmControlPanel.Controls("cboPos" & (8)) = "" Then
   MsgBox "An export filename must be configured before running!", _
            vbCritical + vbOKOnly, _
            "No export filename"
        Exit Sub
End If

frmControlPanel.Hide
frmStatus.Show

TimeClock = Now
mMain.UpdateStatus "Getting things ready...", RGB(0, 171, 25), "", ""
frmStatus.lblStartTime.Caption = Format(Now, "h:mm am/pm")
frmStatus.lblElapsedTime.Visible = False

ConfigSuffix = frmControlPanel.txtConfigSuffix

error = mMain.AddConfigsOrFilesToExportArr
If error = True Then
    MsgBox "No configurations or files selected.", vbOKOnly + vbInformation, "No selection"
    Exit Sub
End If

'main entry point
If CheckParamsResult = error Then
    End
ElseIf CheckParamsResult = "SLDPRT-SINGLE" Then
    Call InitPartSingle
ElseIf CheckParamsResult = "SLDPRT-BATCH" Then
    Call InitPartBatch
ElseIf CheckParamsResult = "SLDASM" Then
    Call InitAsmExport
End If

mMain.ResetDxfMap

DisplayText = DisplayText & vbNewLine & "The export has successfully completed."
DisplayText = DisplayText & vbNewLine & "Export elapsed time: " & Format(Now - TimeClock, "h:m:ss") & " (H:M:SS)"
DisplayText = DisplayText & vbNewLine & vbNewLine
If IsEmpty(FailedToExportArr) = False Then
    For f = 0 To UBound(FailedToExportArr)
        DisplayText = DisplayText & vbNewLine & FailedToExportArr(f)
    Next f
End If

frmStatus.lblElapsedTime = "Running Time: " & Format(Now - TimeClock, "h:m:ss") & " (H:M:SS)"
frmStatus.lblElapsedTime.Visible = True
frmStatus.lblStatus.Caption = "Export Complete!"
frmStatus.lblStatus.ForeColor = RGB(33, 230, 33)
frmStatus.lblCurrentPart.Caption = ""
frmStatus.lblCurrentConfig.Caption = ""
frmStatus.Repaint

Unload frmStatus
MsgBox DisplayText, vbOKOnly + vbInformation, "Export Complete"
Unload frmControlPanel

If Err.Number > 0 Then
    Debug.Print "MainRoutine " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub ConfigureList(Optional ClearList As Boolean = True)

On Error Resume Next

Dim intIndex As Integer
Dim StartPickFolder As String
Dim MyConfigs As Variant
Dim MyConfig As SldWorks.Configuration
Dim StartConfigMgr As SldWorks.ConfigurationManager
Dim c As Long
Dim e As Long
Dim FileIsInList As Boolean
Dim ConfigIsInList As Boolean
Dim ConfigCount As Integer
Dim FileCount As Integer
Dim swStartConfig As SldWorks.Configuration
Dim SelectedCount As Integer
Dim i As Long
Dim TempTitle As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetPathName = "" Then
    MsgBox "Please save the file before exporting.", vbCritical, "Partname not found"
    End
End If
    
If ClearList = True Then
    frmControlPanel.listExportOptions.Clear
    frmControlPanel.listExportOptions.ListStyle = fmListStyleOption
    ReDim ExportFilesArr(0)
End If

If swModel.GetType = 1 Then
    If frmControlPanel.optSingle = True Then
        frmControlPanel.optBatch.Enabled = True
        frmControlPanel.optSingle.Enabled = True
        frmControlPanel.optAssembly = False
        frmControlPanel.chkSelectAll.Enabled = True
        frmControlPanel.listExportOptions.BackColor = vbWhite
        
        'set the MyConfig to be returned to later
        Set swStartConfig = swModel.GetActiveConfiguration
        SingleStartConfig = swStartConfig.Name

        'add configurations to list
        MyConfigs = swModel.GetConfigurationNames
        For c = 0 To UBound(MyConfigs)
            Set MyConfig = swModel.GetConfigurationByName(MyConfigs(c))
            If frmControlPanel.optExportParentOnly = True Then
                If MyConfig.IsDerived = False Then
                    frmControlPanel.listExportOptions.AddItem UCase((MyConfigs(c)))
                End If
            Else: frmControlPanel.listExportOptions.AddItem UCase((MyConfigs(c)))
            End If
        Next c

        'select start config
        For intIndex = 0 To frmControlPanel.listExportOptions.ListCount - 1
            If frmControlPanel.listExportOptions.List(intIndex) = swStartConfig.Name Then
                frmControlPanel.listExportOptions.Selected(intIndex) = True
            End If
        Next intIndex
    ElseIf frmControlPanel.optBatch = True Then
    
        'add files in folder to list
            'if folder options hide extensions...
        If UCase(Right(swModel.GetTitle, 6)) = "SLDPRT" Then
            TempTitle = UCase(swModel.GetTitle)
        Else
            TempTitle = UCase(swModel.GetTitle) & ".SLDPRT"
        End If
        
        StartPickFolder = Left(swModel.GetPathName, Len(swModel.GetPathName) - Len(TempTitle))
        Debug.Print StartPickFolder
        
        Dim FSO As Scripting.FileSystemObject
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Dim MyFiles As Scripting.Files
        Set MyFiles = FSO.GetFolder(StartPickFolder).Files
        Dim MyFile As Scripting.File
        
        'add all prt files in folder to files array
        For Each MyFile In MyFiles
            If UCase(Right(MyFile.Name, 6)) = "SLDPRT" And UCase(Left(MyFile.Name, 1)) <> "~" Then
                If IsEmpty(ExportFilesArr) Then
                    ReDim ExportFilesArr(0)
                    FileCount = 0
                End If
                
                'if file is already in the list then do not re-add it
                For e = 0 To UBound(ExportFilesArr)
                    If MyFile.Name = ExportFilesArr(e) Then
                        FileIsInList = True
                    End If
                Next e
                
                If FileIsInList = False Then
                    FileCount = FileCount + 1
                    ReDim Preserve ExportFilesArr(FileCount)
                    ExportFilesArr(FileCount) = UCase(MyFile.Name)
                    frmControlPanel.listExportOptions.AddItem UCase(Right(MyFile, Len(MyFile) - Len(StartPickFolder)))
                End If
            End If
        Next MyFile
        
        'select start part - this is the open part file
        For intIndex = 0 To frmControlPanel.listExportOptions.ListCount - 1
            If frmControlPanel.listExportOptions.List(intIndex) = TempTitle Then
                frmControlPanel.listExportOptions.Selected(intIndex) = True
            End If
        Next intIndex
    ElseIf frmControlPanel.optAssembly = True Then
        frmControlPanel.optAssembly = False
        frmControlPanel.listExportOptions.Locked = True
        frmControlPanel.listExportOptions.BackColor = RGB(240, 240, 240)
        MsgBox "Assembly export can not be initiated on a .sldprt filetype.", _
                vbExclamation + vbOKOnly, _
                "Invalid export type"
    End If
ElseIf swModel.GetType = 2 Then
    'this code is dead because assembly opt button is disabled
    frmControlPanel.optBatch.Enabled = False
    frmControlPanel.optSingle.Enabled = False
    frmControlPanel.optAssembly = True
    frmControlPanel.chkSelectAll.Enabled = False
    frmControlPanel.listExportOptions.Clear
    frmControlPanel.listExportOptions.BackColor = RGB(240, 240, 240)
End If

For i = 0 To frmControlPanel.listExportOptions.ListCount - 1
    If frmControlPanel.listExportOptions.Selected(i) = True Then
        SelectedCount = SelectedCount + 1
    End If
Next i

If SelectedCount = frmControlPanel.listExportOptions.ListCount Then
    frmControlPanel.chkSelectAll = True
Else
    frmControlPanel.chkSelectAll = False
End If

If Err.Number > 0 Then
    Debug.Print "ConfigureList " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Function AddConfigsOrFilesToExportArr() As Boolean

On Error Resume Next

Dim intIndex As Integer
Dim count As Integer

If frmControlPanel.optSingle = True Then
    ExportConfigsArr = Empty
    For intIndex = 0 To frmControlPanel.listExportOptions.ListCount - 1
        If frmControlPanel.listExportOptions.Selected(intIndex) = True Then
            If IsEmpty(ExportConfigsArr) Then
                ReDim ExportConfigsArr(0)
                count = 0
            Else:
                count = count + 1
                ReDim Preserve ExportConfigsArr(count)
            End If
            ExportConfigsArr(count) = frmControlPanel.listExportOptions.List(intIndex)
        End If
    Next intIndex
ElseIf frmControlPanel.optBatch = True Then
    ExportFilesArr = Empty
    For intIndex = 0 To frmControlPanel.listExportOptions.ListCount - 1
        If frmControlPanel.listExportOptions.Selected(intIndex) = True Then
            If IsEmpty(ExportFilesArr) Then
                ReDim ExportFilesArr(0)
                count = 0
            Else:
                count = count + 1
                ReDim Preserve ExportFilesArr(count)
            End If
            ExportFilesArr(count) = frmControlPanel.listExportOptions.List(intIndex)
        End If
    Next intIndex
End If

'If either array is empty then return error state
If frmControlPanel.optSingle = True Then
    If ExportConfigsArr(0) = "" Then
        AddConfigsOrFilesToExportArr = True
    Else
        AddConfigsOrFilesToExportArr = False
    End If
ElseIf frmControlPanel.optBatch = True Then
    If ExportFilesArr(0) = "" Then
        AddConfigsOrFilesToExportArr = True
    Else
        AddConfigsOrFilesToExportArr = False
    End If
End If

If Err.Number > 0 Then
    Debug.Print "AddConfigsOrFilesToExport " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Function CheckFileAndExportType() As Variant

On Error Resume Next

Dim FileType        As String
Dim PathSize        As Long
Dim DocNameLength   As Integer
Dim TempTitle       As String

Set swModel = swApp.ActiveDoc

FileType = swModel.GetType

If UCase(Right(swModel.GetTitle, 6)) = ("SLDPRT" Or "SLDASM") Then
    TempTitle = swModel.GetTitle
Else
    TempTitle = swModel.GetTitle & ".sldprt"
End If

DocNameLength = Strings.Len(TempTitle)
PathSize = Strings.Len(swModel.GetPathName)
ParentFolderPath = Strings.Left(swModel.GetPathName, PathSize - DocNameLength) 'has end-slash. Is changed in EstablishParameters when export location is custom
    Debug.Print "Parent Folder: " & ParentFolderPath
    
If frmControlPanel.optSingle = True Then
    If FileType <> 1 Then '1 FOR SLDPRT
        MsgBox "'Single' export can only be run on a .SLDPRT file type." & _
            vbNewLine & vbNewLine & _
            "Please open a sheet-metal .SLDPRT file and re-run.", _
            vbOKOnly + vbCritical, _
            "Sheet-Metal part Required"
        CheckFileAndExportType = error
    Else
        CheckFileAndExportType = "SLDPRT-SINGLE"
    End If
ElseIf frmControlPanel.optBatch = True Then
    If FileType <> 1 Then '1 FOR SLDPRT
        MsgBox "'Batch' export can only be initiated from a .SLDPRT file type." & _
            vbNewLine & vbNewLine & _
            "Please open a sheet-metal .SLDPRT file and re-run.", _
            vbOKOnly + vbCritical, _
            "Sheet-Metal part Required"
        CheckFileAndExportType = error
    Else
        CheckFileAndExportType = "SLDPRT-BATCH"
    End If
ElseIf frmControlPanel.optAssembly = True Then
    If FileType <> 2 Then '2 FOR SLDASM
        MsgBox "'Assembly' export can only be initiated from a .SLDASM file type." & _
            vbNewLine & vbNewLine & _
            "Please open a .SLDASM file and re-run.", _
            vbOKOnly + vbCritical, _
            "Assembly Required"
        CheckFileAndExportType = error
    Else
        CheckFileAndExportType = "SLDASM"
    End If
End If

swExportType = CheckFileAndExportType

If Err.Number > 0 Then
    Debug.Print "CheckFileAndExportType " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Private Function CheckSheetMetal(ModelDoc As SldWorks.ModelDoc2, _
                        Optional FromExportAction As Boolean = False, _
                        Optional ParentFeatName As String = "", _
                        Optional Config As String = "", _
                        Optional ParentFeatType As String = "") As Collection

On Error Resume Next

Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.BodyFolder
Dim swSubSubFeat As SldWorks.Feature
Dim swSheetMetal As SldWorks.SheetMetalFeatureData
Dim Conversion As Double
Dim ChildFeatures As Variant
Dim FlatFeatData As SldWorks.FlatPatternFeatureData
Dim SheetFeatData As SldWorks.SheetMetalFeatureData
Dim subChild As SldWorks.Feature
Dim Body As SldWorks.Body2
Dim featMgr1 As SldWorks.FeatureManager
Dim i As Long
Dim u As Long
Dim BodyFolder As SldWorks.BodyFolder
Dim BodyArr As Variant
Dim FeatureArr As Variant
Dim FeatMgr As SldWorks.FeatureManager
Dim LocalFeat As SldWorks.Feature
Dim SheetData As SldWorks.SheetMetalFeatureData
Dim SolidBodies As SldWorks.BodyFolder
Dim SolidBodiesArr As Variant
Dim SolidBody() As SldWorks.Body2
Dim BodySelect As SldWorks.Body2
Dim swSelData As SldWorks.selectData
Dim swCutlistFeat As Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim b As Long
Dim swSelMgr As SldWorks.SelectionMgr
Dim x As Long
Dim sMatDb As String
Dim CurPart As SldWorks.PartDoc

Dim SheetInfo As New clsSheetInfo
Dim ThicknessTemp As Double
Dim Material As String

Set swSelMgr = ModelDoc.SelectionManager
Set swFeatMgr = ModelDoc.FeatureManager

Set SheetInfo.Sheet = New Collection
Set CurPart = ModelDoc

Set swFeat = ModelDoc.FirstFeature
    While Not swFeat Is Nothing
        Debug.Print "-----------------------------"
        Debug.Print "Feature Name: " & swFeat.Name
        Debug.Print "        Type: " & swFeat.GetTypeName2
        
        'search Solidbody folder and add all non cutlist items to cutlist as cutlist items
        If FromExportAction = False Then
            If swFeat.GetTypeName2 = "SolidBodyFolder" Then
                Set SolidBodies = swFeat.GetSpecificFeature2
                SolidBodiesArr = SolidBodies.GetBodies
                If Not IsEmpty(SolidBodiesArr) Then
                    For b = 0 To UBound(SolidBodiesArr)
                        Set BodySelect = SolidBodiesArr(b)
                        If BodySelect.isSheetMetal = False Then
                            GoTo NextFeature
                        End If
                        Set swSelData = swSelMgr.CreateSelectData
                        BodySelect.Select2 True, swSelData
                        Set swCutlistFeat = swFeatMgr.InsertWeldmentCutList
                    Next b
                End If
            End If
        End If
        
        'search cutlist items and if sheetmetal then get thickness
        'if not sheetmetal then skip
        If swFeat.GetTypeName = "CutListFolder" Then
            Set BodyFolder = swFeat.GetSpecificFeature2
            BodyFolder.SetAutomaticCutList True
            BodyFolder.SetAutomaticUpdate True
            BodyFolder.UpdateCutList
            BodyArr = BodyFolder.GetBodies
            
            'if no features exist, as with "inserted parts" then skip
            If IsEmpty(BodyArr) Then
                GoTo NextFeature
            Else
                For x = 0 To UBound(BodyArr)
                Set Body = BodyArr(x)
                Debug.Print Body.Name
                If Body.isSheetMetal = False Then
                    GoTo NextFeature
                End If
                Next x
            End If
            
            For i = 0 To UBound(BodyArr)
                Set Body = BodyArr(i)
                Debug.Print "   Body Name: " & Body.Name
                FeatureArr = Body.GetFeatures
                
                'there can be multiple bodies in the bodyarr
                For u = 0 To UBound(FeatureArr)
                    Set LocalFeat = FeatureArr(u)
                    
                    
                    If LocalFeat.GetTypeName2 = "SheetMetal" Then
                        Debug.Print "   SheetMetal Feature Name: " & LocalFeat.Name
                    
                        Set SheetData = LocalFeat.GetDefinition
                        ThicknessTemp = SheetData.Thickness
                        Conversion = 1000
                        ThicknessTemp = (ThicknessTemp * Conversion) / 25.4
                        Debug.Print "              Thickness is: " & ThicknessTemp & " in"
                        
                        Material = CurPart.GetMaterialPropertyName2(Config, sMatDb)
                            Debug.Print Material
                        
                        'add thickness and material to sheetinfo sheet collection
                        If SheetInfo.Sheet.count > 0 Then
                            SheetInfo.Sheet.Remove (1)
                            SheetInfo.Sheet.Remove (1)
                        End If
                        
                        SheetInfo.Sheet.Add ThicknessTemp
                        SheetInfo.Sheet.Add Material
                        
                        Set CheckSheetMetal = SheetInfo.Sheet
                        
                        If frmControlPanel.optExportAllBodies = False Then
                            GoTo ExitCheck
                        End If
                    End If
                    
                    If FromExportAction = True Then
                        Debug.Print LocalFeat.Name
                        If LocalFeat.GetTypeName2 = ParentFeatType Then 'Or LocalFeat.GetTypeName2 = "FlatPattern" Then
                            If ParentFeatName = LocalFeat.Name Then
                                GoTo ExitCheck
                            End If
                        End If
                    End If
                Next u
            Next i
        End If
        
NextFeature:
        Set swFeat = swFeat.GetNextFeature
    Wend

ExitCheck:

If Err.Number > 0 Then
    Debug.Print "CheckSheetMetal " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Sub InitPartSingle()

On Error Resume Next

Dim vConfigNameArr As Variant
Dim vConfigName As Variant
Dim SheetMetalExists As Boolean
Dim i As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

For i = 0 To UBound(ExportConfigsArr)
    If Not IsEmpty(ExportConfigsArr(i)) Then
        TotalsForExport = TotalsForExport + 1
    End If
Next i

vConfigNameArr = swModel.GetConfigurationNames
For Each vConfigName In vConfigNameArr
    
    If CheckSheetMetal(swModel).item(1) <> 0 Then
        SheetMetalExists = True
    End If
Next

If SheetMetalExists = True Then
    Call InitPartCycleConfigs
Else
    'the value of function return CheckSheetMetal is the thickness of the material as a Double
    MsgBox "The file is not a sheet-metal part!" & _
                vbNewLine & vbNewLine & _
                "Please open a sheet-metal part and re-run.", _
                vbOKOnly + vbCritical, _
                "Sheet-Metal part Required"
    End
End If

If Err.Number > 0 Then
    Debug.Print "InitPartSingle " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Private Sub InitPartBatch()

On Error Resume Next

Dim FSO As Scripting.FileSystemObject
Dim MyFiles As Scripting.Files
Dim MyFile As Scripting.File
Dim error As SldWorks.ModelDoc2
Dim Errors As Long
Dim Warnings As Long
Dim i As Long
Dim FileFound As Boolean
Dim f As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFiles = FSO.GetFolder(ParentFolderPath).Files

'Get total files in folder
For f = 0 To UBound(ExportFilesArr)
    If Not IsEmpty(ExportFilesArr(f)) Then
        TotalsForExport = TotalsForExport + 1
    End If
Next f

'iterate through files in the parent folder until finding the current part
For Each MyFile In MyFiles
    If swExportType = "SLDPRT-BATCH" Then
        swApp.CloseAllDocuments (True)
        'SaveLocationSet = False
        For i = 0 To UBound(ExportFilesArr)
            If UCase(MyFile.Name) = ExportFilesArr(i) Then
                FileFound = True
            End If
        Next i
            
        'If UCase(Right(MyFile.Name, 6)) = "SLDPRT" And UCase(Left(MyFile.Name, 1)) <> "~" Then
        If FileFound = True Then
            mMain.UpdateStatus "Getting a new part ready...", vbRed, MyFile.Name, ""
            swApp.OpenDoc6 MyFile.Path, swDocPART, 0, "", Errors, Warnings
            If Errors > 0 Then
                FileFound = False
                GoTo NextFile
            End If
            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
            If CheckSheetMetal(swModel).item(1) = 0 Then
                swApp.CloseDoc (MyFile.Name)
                GoTo NextFile
            Else:
                CurrentForExportCount = CurrentForExportCount + 1
                Call InitPartCycleConfigs
            End If
            FileFound = False
        Else: GoTo NextFile
        End If
    End If

NextFile:
Next MyFile

If Err.Number > 0 Then
    Debug.Print "InitPartBatch " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Private Sub InitPartCycleConfigs()

On Error Resume Next

Dim swConfig        As SldWorks.Configuration
Dim swConfigArr     As Variant
Dim swFeatMgr       As SldWorks.FeatureManager
Dim sConfigName     As String
Dim InitConfig      As SldWorks.Configuration
Dim FileOrConfig    As String
Dim x               As Long
Dim y               As Long
Dim TempCfgCount    As Integer

Set swFeatMgr = swModel.FeatureManager
swFeatMgr.EditRollback swMoveRollbackBarToEnd, ""

mMain.FindReplaceCharactersInConfig
mMain.EstablishParameters

If CorrectBendsOnly = False Then
    mMain.GenExportFolder
End If

If frmControlPanel.chkAddConfigSuffix = True Then
    mMain.UpdateStatus "Adding configuration suffix...", vbBlue, "", ""
    mMain.AddRemoveConfigSuffix (True) 'adds suffix to all configs
End If

swConfigArr = swModel.GetConfigurationNames
Set InitConfig = swModel.GetActiveConfiguration

For x = 0 To UBound(swConfigArr)
    Set swConfig = swModel.GetConfigurationByName(swConfigArr(x))
    If frmControlPanel.optSingle = True Then
        For y = 0 To UBound(ExportConfigsArr)
            If UCase(Left(swConfig.Name, Len(swConfig.Name) - Len(ConfigSuffix))) = UCase(ExportConfigsArr(y)) Then
                sConfigName = swConfigArr(x)
                swModel.ShowConfiguration2 sConfigName
                CurrentForExportCount = CurrentForExportCount + 1
                Call ExportAction(swConfig, swModel)
            End If
        Next y
    ElseIf frmControlPanel.optBatch = True Then
        If frmControlPanel.optExportParentOnly = True Then
            If swConfig.IsDerived <> False Then
                GoTo SkipConfig
            End If
        End If
        
GoForExport:
        'on the first pass, redim the array
        If x = 0 Then
            ReDim ExportConfigsArr(0)
        End If
        'populate the array with config names for deletion in ref part purpose
        ExportConfigsArr(TempCfgCount) = swConfigArr(x)
        TempCfgCount = TempCfgCount + 1
        ReDim Preserve ExportConfigsArr(TempCfgCount)
        
        sConfigName = swConfigArr(x)
        swModel.ShowConfiguration2 sConfigName
        Call ExportAction(swConfig, swModel)
    End If
    
SkipConfig:
Next x

If frmControlPanel.chkAddRefPart Or frmControlPanel.chkSaveOriginalPart = True Then
    swModel.ShowConfiguration2 InitConfig.Name
End If

If frmControlPanel.chkAddRefPart = True Then
    mMain.SaveRefPart
End If

If frmControlPanel.chkAddConfigSuffix = True Then
    mMain.AddRemoveConfigSuffix (False) 'removes suffix from all configs
End If

'Choose file save
If frmControlPanel.chkSaveOriginalPart = True Then
    mMain.UpdateStatus "Saving original part file with bend corrections...", vbBlue, swModel.GetTitle, ""
    swModel.ShowConfiguration2 InitConfig.Name
    swModel.SaveAs3 swModel.GetPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent
    SaveLocationSet = False
End If

If frmControlPanel.optSingle <> True Then
    swApp.CloseDoc (swModel.GetPathName)
End If

If Err.Number > 0 Then
    Debug.Print "InitPartCycleConfigs " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Private Sub InitAsmExport()

On Error Resume Next

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swAssy                      As SldWorks.AssemblyDoc
Dim swConf                      As SldWorks.Configuration
Dim swRootComp                  As SldWorks.Component2
Dim nStart                      As Single

Dim CountModelDoc               As SldWorks.AssemblyDoc
Dim i                           As Long
Dim CountComps                  As Variant
Dim CountComp                   As SldWorks.Component2

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
Set CountModelDoc = swModel

Call EstablishParameters

If CorrectBendsOnly = False Then
    Call GenExportFolder
End If

Debug.Print "File = " & swModel.GetPathName

CountComps = CountModelDoc.GetComponents(False) 'true to get top level, false to get all levels
For i = 0 To UBound(CountComps)
    Set CountComp = CountComps(i)
    If CountComp.IsSuppressed = False Then
        TotalsForExport = TotalsForExport + 1
    End If
Next i

TraverseComponent swRootComp, 1

If frmControlPanel.chkSaveOriginalPart = True Then
    swModel.SaveAs3 swModel.GetPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent
End If

swApp.CloseDoc swModel.GetPathName

If frmControlPanel.chkAddRefPart = True Then
    mMain.SaveAsmComponents
End If

Debug.Print "Finished!"

If Err.Number > 0 Then
    Debug.Print "InitAsmExport " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

On Error Resume Next

Dim vChildComp                  As Variant
'Dim swApp                       As SldWorks.SldWorks
Dim swPart                      As SldWorks.PartDoc
Dim swChildComp                 As SldWorks.Component2
Dim swConfig                    As SldWorks.Configuration
Dim swConfMgr                   As SldWorks.ConfigurationManager
Dim swChildModel                As SldWorks.ModelDoc2
Dim swOpenModel                 As SldWorks.ModelDoc2
Dim swChildCustPropMngr         As CustomPropertyManager
Dim swChildModelDocExt          As ModelDocExtension
Dim swSheetMetal                As SldWorks.SheetMetalFeatureData
Dim swFeat                      As SldWorks.Feature
Dim swBody                      As SldWorks.Body2
Dim Sheet_metal                 As Boolean
Dim Boolstatus                  As Boolean
Dim conv                        As Double
Dim i                           As Long
Dim loptions                    As Long
Dim lerrors                     As Long
Dim sPadStr                     As String
Dim FilePath                    As String
Dim FileName                    As String
Dim CompFilePath                As String
Dim swThkDir                    As String
Dim swMatDir                    As String
Dim swCurrent                   As String
Dim RefCfg                      As String
Dim ChildConfigName             As String
Dim sMatName                    As String
Dim sMatDb                      As String
Dim exFileName                  As String
Dim Bodies                      As Variant
Dim x                           As Long
Dim SheetMetalFound             As Boolean
Dim SheetThickness              As Double
Dim FlatFeatData                As SldWorks.FlatPatternFeatureData
Dim FlatFace                    As SldWorks.Face2
Dim FlatFaceParentFeat          As SldWorks.Feature
Dim CompConfig                  As SldWorks.Configuration
Dim tempModelDoc                As SldWorks.ModelDoc2
Dim ExpCompsArr                 As Variant
Dim ExportedCompCfgsArr              As Variant
Dim FileCount                   As Integer
Dim ConfigCount                 As Integer
Dim f                           As Long
Dim c                           As Long

Debug.Print swComp.Name & " L=" & nLevel
vChildComp = swComp.GetChildren

For i = 0 To UBound(vChildComp)
    Set swChildComp = vChildComp(i)
    Debug.Print swChildComp.Name
    If swChildComp.IsSuppressed = False Then GoTo Active Else GoTo skip

Active:
    Set swApp = Application.SldWorks
    Set swChildModel = swChildComp.GetModelDoc2
    
    If (swChildModel.GetType <> swDocPART) Then
        GoTo Jump 'Skips Subassemby level
    End If
    
    Set swPart = swChildModel 'Applies part commands for current component
    CompFilePath = swChildModel.GetPathName
    FilePath = Left(swComp.GetPathName, InStrRev(swComp.GetPathName, "\") - 1)
    FileName = swChildModel.GetTitle 'Get title of component
    swCurrent = swChildComp.ReferencedConfiguration 'Get current configuration of component
    
    'Search for sheet metal body
    Bodies = swPart.GetBodies2(swBodyType_e.swAllBodies, True)
    For x = 0 To UBound(Bodies)
        Set swBody = Bodies(x)
        Debug.Print swBody.Name
        If swBody.isSheetMetal = 1 Then
            SheetMetalFound = True
        End If
    Next x
    
    If SheetMetalFound = True Then
        Debug.Print "Processing component " & FileName & " as a sheet metal component"
        Debug.Print "Current Config is : "; swCurrent
        GoTo Process
    Else
        GoTo Jump
    End If
    
Process:
    'The first part found is processed for export without processing for SKIP decision
    If Not IsEmpty(ExpCompsArr) Then  'initializes empty. line skip on first pass. When all other new parts are found, on first pass, they do not result in SKIP
        For f = 0 To UBound(ExpCompsArr)  'iterate through array (on first pass only has the first component found added)
            If UCase(ExpCompsArr(f)) = UCase(CompFilePath) Then
                For c = 0 To UBound(ExportedCompCfgsArr)
                    If Not IsEmpty(ExportedCompCfgsArr) Then
                        If UCase(ExportedCompCfgsArr(c)) = UCase(swCurrent) Then
                            GoTo skip
                        End If
                    End If
                Next c
            End If
        Next f
    End If
    
    'fill the export file array with the current filename
    If IsEmpty(ExpCompsArr) Then
        ReDim ExpCompsArr(FileCount)
        ExpCompsArr(FileCount) = CompFilePath
    Else
        FileCount = FileCount + 1
        ReDim Preserve ExpCompsArr(FileCount)
        ExpCompsArr(FileCount) = CompFilePath
    End If
    
    'fill the export config array with the current config name
    If IsEmpty(ExportedCompCfgsArr) Then
        ReDim ExportedCompCfgsArr(ConfigCount)
        ExportedCompCfgsArr(ConfigCount) = swCurrent
    Else
        ConfigCount = ConfigCount + 1
        ReDim Preserve ExportedCompCfgsArr(ConfigCount)
        ExportedCompCfgsArr(ConfigCount) = swCurrent
    End If

    'open the sldprt file for export
    Set swPart = swChildModel
    Set swOpenModel = swApp.ActivateDoc3(swChildModel.GetPathName, True, loptions, lerrors)
    Boolstatus = swChildModel.ShowConfiguration2(swCurrent)
    Set CompConfig = swChildModel.GetActiveConfiguration
    Set tempModelDoc = swApp.ActiveDoc
    
    Debug.Print CheckSheetMetal(tempModelDoc).item(1)  'this line ensures that sheetmetal bodies are added to the cutlist
    
    'add config suffix
    If frmControlPanel.chkAddConfigSuffix = True Then
        AddRemoveConfigSuffix True, swCurrent
    End If
    
    CurrentForExportCount = CurrentForExportCount + 1
    
    ExportAction CompConfig, swChildModel 'bend correction and body export is handled in ExportAction
    
    'the suffix must be removed or the renamed config will throw this process
    If frmControlPanel.chkAddConfigSuffix = True Then
        AddRemoveConfigSuffix False, swCurrent & ConfigSuffix
    End If
    
    'save part with bend correction if requested
    If frmControlPanel.chkSaveOriginalPart = True Then
        swChildModel.SaveAs3 swChildModel.GetPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent
    End If
    
    swApp.CloseDoc (swChildModel.GetPathName)
    
    GoTo Jump
    
skip:
       Debug.Print "Skipped"
    
Jump:
    TraverseComponent swChildComp, nLevel + 1

Next i

ExportFilesArr = Null
ExportConfigsArr = Null
ExportFilesArr = ExpCompsArr
ExportConfigsArr = ExportedCompCfgsArr

If Err.Number > 0 Then
    Debug.Print "TraverseComponent" & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Function SaveAsmComponents()

On Error Resume Next

Dim b                       As Long
Dim g                       As Long
Dim x                       As Long
Dim FirstSlash              As Integer
Dim swCurrent               As String
Dim ExportedFiles           As Variant
Dim ExpFilesCount           As Integer
Dim IsExported              As Boolean

For b = 0 To UBound(ExportFilesArr)

    If IsEmpty(ExportedFiles) <> True Then
        For x = 0 To UBound(ExportedFiles)
            If UCase(ExportedFiles(x)) = UCase(ExportFilesArr(b)) Then
                IsExported = True
            End If
        Next x
    End If
    
    If IsExported = True Then
        GoTo SkipFile
    End If
    
    swApp.OpenDoc6 ExportFilesArr(b), swDocPART, swOpenDocOptions_Silent, "", 1, 1
    
    Set swModel = swApp.ActiveDoc
    
    If IsEmpty(ExportedFiles) = True Then
        ReDim ExportedFiles(0)
        ExportedFiles(0) = ExportFilesArr(b)
    Else
        ExpFilesCount = ExpFilesCount + 1
        ReDim Preserve ExportedFiles(ExpFilesCount)
        ExportedFiles(ExpFilesCount) = ExportFilesArr(b)
    End If
    
    FirstSlash = InStrRev(ExportFilesArr(b), "\", -1)
    RefPartFilePathName = SaveLocation & "\" & Right(ExportFilesArr(b), Len(ExportFilesArr(b)) - FirstSlash) & " (REF)" & ConfigSuffix & ".SLDPRT"
    Debug.Print "RefPartFileName: " & RefPartFilePathName
    
    For g = 0 To UBound(ExportConfigsArr)
        swCurrent = ExportConfigsArr(g)
        If frmControlPanel.chkAddConfigSuffix = True And frmControlPanel.chkRenameConfigs = True Then
            AddRemoveConfigSuffix True, swCurrent
        End If
    Next g
    
    mMain.SaveRefPart
    
    swApp.CloseDoc ExportFilesArr(b)
    
SkipFile:
Next b

If Err.Number > 0 Then
    Debug.Print "SaveAsmComponents " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Sub EstablishParameters()

On Error Resume Next

mMain.UpdateStatus "Establishing Parameters...", vbBlue, ExportDocName, ""

Dim PathNoFilename  As String
Dim NameLength      As Integer

ExportDocName = swModel.GetTitle
If UCase(Right(ExportDocName, 6)) = ("SLDPRT" Or "SLDASM") Then
    ExportDocName = Left(swModel.GetTitle, Len(swModel.GetTitle) - 7)
Else
    ExportDocName = Left(swModel.GetTitle, Len(swModel.GetTitle))
End If
TempFolderSuffix = 0
NewFolderName = "FP-" & ExportDocName
TempNewFolderName = NewFolderName & "_" & TempFolderSuffix 'adjust location in GenExportFolder

If Len(AltSaveLocation) > 1 Then
    SaveLocation = AltSaveLocation & NewFolderName & "_" & TempFolderSuffix 'adjust location in GenExportFolder - this is the save to folder
Else
    SaveLocation = ParentFolderPath & NewFolderName & "_" & TempFolderSuffix 'adjust location in GenExportFolder - this is the save to folder
End If

If Err.Number > 0 Then
    Debug.Print "EstablishParameters " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub GenExportFolder()

On Error GoTo GenFolderError

Dim strFolderName As String
Dim strFolderExists As String

mMain.UpdateStatus "Setting up the export folder", vbBlue, ExportDocName, ""

ReRunSave:

If SaveLocationSet = False Then
    If Len(AltSaveLocation) > 1 Then
        SaveLocation = AltSaveLocation & NewFolderName & "_" & TempFolderSuffix 'adjust location in establishParameters
    Else
        SaveLocation = ParentFolderPath & NewFolderName & "_" & TempFolderSuffix 'adjust location in establishParameters
    End If
    ParentFolderPath = Left(SaveLocation, Len(SaveLocation) - Len(TempNewFolderName))
    TempNewFolderName = NewFolderName & "_" & TempFolderSuffix 'adjust location in establishParameters
End If

strFolderName = SaveLocation
strFolderExists = Dir(strFolderName, vbDirectory)

Debug.Print "savelocation: " & SaveLocation
 
If strFolderExists = "" Then
        RefPartFilePathName = SaveLocation & "\" & ExportDocName & " (REF)" & ConfigSuffix & ".SLDPRT"
        SaveLocationSet = True
        Debug.Print RefPartFilePathName
Else
        TempFolderSuffix = TempFolderSuffix + 1 'this will update exportchild variable
        SaveLocationSet = False
        GoTo ReRunSave
End If

MkDir SaveLocation

If frmControlPanel.chkOpenExpFolder = True Then
    mMain.OpenFolder SaveLocation
End If

GenFolderError:
If Err.Number = 75 Then
    TempFolderSuffix = TempFolderSuffix + 1
    GoTo ReRunSave
ElseIf Err.Description <> "" Then
    MsgBox "GenExportFolder " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub SaveRefPart()

On Error Resume Next

Dim SaveFile As String

mMain.UpdateStatus "Saving the REF. part file(s)", vbBlue, "", ""
frmStatus.lblElapsedTime = ""

SaveFile = swModel.SaveAs2(RefPartFilePathName, _
                        swSaveAsCurrentVersion, _
                        True, _
                        True)
                    
If SaveFile <> 0 Then
    Debug.Print "FILE SAVE ERROR"
End If

Set swModel = swApp.OpenDoc6(RefPartFilePathName, swDocPART, swOpenDocOptions_Silent, "", 1, 1)

If frmControlPanel.chkDeleteSmFlatConfigs = True Then
    mMain.DeleteRefPartConfigs
End If

If frmControlPanel.chkDeleteDesignTable = True Then
    mMain.DeleteDesignTable
End If

Set swModel = swApp.ActiveDoc
SaveFile = swModel.SaveAs2(RefPartFilePathName, _
                        swSaveAsCurrentVersion, _
                        True, _
                        True)
swApp.CloseDoc (RefPartFilePathName)

Set swModel = swApp.ActiveDoc

If Err.Number > 0 Then
    Debug.Print "SaveRefPart " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Public Function OpenFolder(strDirectory As String)
'DESCRIPTION: Open folder if not already open. Otherwise, activate the already opened window
'DEVELOPER: Ryan Wells (wellsr.com)

On Error Resume Next

mMain.UpdateStatus "Opening export folder location", vbBlue, "", ""

Dim w As Variant
Dim pID As Variant
Dim sh As Variant
Dim Path As String

Set sh = CreateObject("shell.application")
For Each w In sh.Windows
    If w.Name = "Windows Explorer" Or w.Name = "File Explorer" Then
        If w.Document.Folder.Self.Path = strDirectory Then
            'if already open, bring it front
            If CBool(IsIconic(w.hWnd)) Then ' If it's minimized, show it
                w.Visible = False
                w.Visible = True
                ShowWindow w.hWnd, SW_RESTORE
            Else
                w.Visible = False
                w.Visible = True
            End If
            Exit Function
        End If
    End If
Next
'if you get here, the folder isn't open so open it
'Shell("explorer.exe """ & "C:\" & "", vbNormalFocus)
pID = shell("explorer.exe """ & strDirectory & "", vbNormalFocus)

If Err.Number > 0 Then
    Debug.Print "OpenFolder " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Private Function ExportAction(ConfigObj As SldWorks.Configuration, ModelDoc As SldWorks.ModelDoc2)

On Error Resume Next

Dim sModelName          As String
Dim sPathName           As String
Dim swPart              As SldWorks.PartDoc
Dim options             As Long
Dim sDwgOrDxf           As String
Dim Index               As Boolean
Dim FlatFeatNum         As Integer
Dim DxfMappingFileIndex As Integer
Dim DxfMapFileLoc       As Boolean

Dim SheetThickness      As Double
Dim Conversion          As Double

Dim swFeat              As SldWorks.Feature
Dim swSelMgr            As SldWorks.SelectionMgr
Dim swConfiMgr          As SldWorks.ConfigurationManager
Dim swConfig            As SldWorks.Configuration
Dim ExpConfigName       As String
Dim ExportFailed        As Boolean
Dim FailCount           As Integer

Dim varViews            As Variant
Dim dataViews(0)        As String

Dim FlatFeatData        As SldWorks.FlatPatternFeatureData
Dim FlatFace            As SldWorks.Face2
Dim FlatFaceParentFeat  As SldWorks.Feature
Dim FlatParentFeatType  As String
Dim IsSmFlatConfig      As Boolean

Dim swMatDir            As String
Dim swThkDir            As String
Dim sMatName            As String
Dim FileName            As String
Dim swCurrent           As String

Dim PathLength          As Integer
Dim p                   As Long

Dim Bit(1 To 12)        As Integer
Dim BendLineOptions     As Integer
Dim b                   As Integer

frmStatus.lblElapsedTime.Caption = "Exporting... " & CurrentForExportCount & " of " & TotalsForExport
frmStatus.lblElapsedTime.Visible = True
frmStatus.Repaint

Set swPart = ModelDoc

If frmControlPanel.optDWG.Value = True Then
    sDwgOrDxf = ".DWG"
ElseIf frmControlPanel.optDXF = True Then
    sDwgOrDxf = ".DXF"
End If

BendLineOptions = 0
Bit(1) = 1 'to export flat-pattern geometry; 0 to not
Bit(2) = 2 'to include hidden edges; 0 to not
Bit(3) = 4 'to export bend lines; 0 to not
Bit(4) = 8 'to include sketches; 0 to not
Bit(5) = 16 'to merge coplanar faces; 0 to not
Bit(6) = 32 'to export library features; 0 to not
Bit(7) = 64 'to export forming tools; 0 to not
Bit(8) = 128
Bit(9) = 256
Bit(10) = 512
Bit(11) = 1024
Bit(12) = 2048 'to export bounding box; 0 to not

For b = 1 To 12
    If b = 5 Or b = 8 Or b = 9 Or b = 10 Or b = 11 Then
        GoTo SkipBit
    Else
        If frmControlPanel.Controls("chkBit" & (b)) = True Then
            BendLineOptions = BendLineOptions + Bit(b)
        End If
    End If
SkipBit:
Next b
Debug.Print "BendLineOptions: " & BendLineOptions

Set swConfiMgr = ModelDoc.ConfigurationManager
Set swConfig = swConfiMgr.ActiveConfiguration
Set swSelMgr = ModelDoc.SelectionManager
Set swFeat = ModelDoc.FirstFeature

sModelName = ModelDoc.GetPathName

dataViews(0) = "Flat pattern"
varViews = dataViews

'do loops through all flat pattern features
Do Until swFeat Is Nothing
    If swFeat.GetTypeName = "FlatPattern" Then
        Debug.Print swFeat.Name
        'skip flat-pattern feature if its suppressed in flat pattern configuration
        If InStr(1, UCase(ConfigObj.Name), UCase("SM-Flat-Pattern"), vbTextCompare) > 0 Then
            IsSmFlatConfig = True
            If swFeat.IsSuppressed <> False Then
                GoTo SkipFlatFeature
            End If
        End If
        
        Set FlatFeatData = swFeat.GetDefinition
        Set FlatFace = FlatFeatData.FixedFace2
        Set FlatFaceParentFeat = FlatFace.GetFeature
        FlatParentFeatType = FlatFaceParentFeat.GetTypeName
            Debug.Print swFeat.Name
            Debug.Print FlatFaceParentFeat.Name
            Debug.Print FlatFaceParentFeat.GetTypeName
        
        SheetThickness = CheckSheetMetal(ModelDoc, True, FlatFaceParentFeat.Name, "", FlatParentFeatType).item(1)
        sMatName = CheckSheetMetal(ModelDoc, True, FlatFaceParentFeat.Name, ConfigObj.Name, FlatParentFeatType).item(2)
        
        If SheetThickness = 0 Then
            GoTo SkipFlatFeature
        End If
        
        'if selected, run Correct Bend Suppression
        If frmControlPanel.chkFlatBendCorrection = True Then
            mMain.UpdateStatus "Correcting bends...", vbRed, ModelDoc.GetTitle, ConfigObj.Name
            Call mMain.CorrectBendSuppression(ConfigObj, IsSmFlatConfig, swFeat.Name)
        End If
        
        If CorrectBendsOnly = False Then
        
            FlatFeatNum = Right(swFeat.Name, Len(swFeat.Name) - Len("Flat-Pattern"))
            
            If frmControlPanel.chkRenameConfigs = True Then
                ExpConfigName = ConfigObj.Name
            Else
                If frmControlPanel.chkAddConfigSuffix = True Then
                    ExpConfigName = Left(ConfigObj.Name, Len(ConfigObj.Name) - Len(ConfigSuffix))
                End If
            End If
            
            'Make material and thickness directories
            swMatDir = SaveLocation & "\" & sMatName & "\"
            Debug.Print swMatDir
            If Dir(swMatDir, vbDirectory) = "" Then MkDir swMatDir
            
            swThkDir = SaveLocation & "\" & sMatName & "\" & SheetThickness
            Debug.Print swThkDir
            If Dir(swThkDir, vbDirectory) = "" Then MkDir swThkDir
            
            GetSetCustPropFileNames ModelDoc, ConfigObj.Name
            
            For p = 1 To 8
                Debug.Print frmControlPanel.Controls("cboPos" & (p))
                If frmControlPanel.Controls("cboPos" & (p)) = ConfiguratorConfig Then
                    ExpFilePosition(p) = ExpConfigName & "_"
                ElseIf frmControlPanel.Controls("cboPos" & (p)) = ConfiguratorFlatFeat Then
                    ExpFilePosition(p) = "FP-" & FlatFeatNum & "_"
                ElseIf frmControlPanel.Controls("cboPos" & (p)) = ConfiguratorPartName Then
                    ExpFilePosition(p) = ExportDocName & "_"
                ElseIf frmControlPanel.Controls("cboPos" & (p)) = ConfiguratorMaterial Then
                    ExpFilePosition(p) = sMatName & "_"
                ElseIf frmControlPanel.Controls("cboPos" & (p)) = ConfiguratorThickness Then
                    ExpFilePosition(p) = SheetThickness & "in_"
                Else
                    If frmControlPanel.Controls("cboPos" & (p)) = "" Then
                        ExpFilePosition(p) = ""
                    Else
                        ExpFilePosition(p) = frmControlPanel.Controls("cboPos" & (p)) & "_"
                    End If
                End If
             Next p
             
            'update export final location
            sPathName = ExpFilePosition(1) & _
                        ExpFilePosition(2) & _
                        ExpFilePosition(3) & _
                        ExpFilePosition(4) & _
                        ExpFilePosition(5) & _
                        ExpFilePosition(6) & _
                        ExpFilePosition(7) & _
                        ExpFilePosition(8)

            PathLength = Len(sPathName)
            sPathName = Left(sPathName, PathLength - 1)
            sPathName = SaveLocation & "\" & sMatName & "\" & SheetThickness & "\" & sPathName & sDwgOrDxf
            Debug.Print "Export Path Name: " & sPathName
            
            mMain.UpdateStatus "Exporting configuration...", RGB(0, 171, 25), ModelDoc.GetTitle, ConfigObj.Name & " (Flat-Pattern" & FlatFeatNum & ")"
            
            ModelDoc.EditRebuild3
            swFeat.Select True
            
            If frmControlPanel.optExportAnnotationFlat = True Then
                If swPart.ExportToDWG2(sPathName, sModelName, swExportToDWG_ExportAnnotationViews, False, Empty, False, False, BendLineOptions, varViews) <> False Then
                    Debug.Print "Successfully exported --: " & ExpConfigName
                    Debug.Print "Path -------------------: " & sPathName
                Else
                    Debug.Print "Export failed ----------: " & ExpConfigName
                    Debug.Print "Path: ------------------: " & sPathName
                    ExportFailed = True
                End If
            Else
                If swPart.ExportToDWG2(sPathName, sModelName, swExportToDWG_ExportSheetMetal, True, Empty, False, False, BendLineOptions, Null) <> False Then
                    Debug.Print "Successfully exported --: " & ExpConfigName
                    Debug.Print "Path -------------------: " & sPathName
                Else
                    Debug.Print "Export failed ----------: " & ExpConfigName
                    Debug.Print "Path: ------------------: " & sPathName
                    ExportFailed = True
                End If
            End If
            
            If ExportFailed = True Then
                If IsEmpty(FailedToExportArr) Then
                    FailCount = 0
                    ReDim FailedToExportArr(FailCount)
                    FailedToExportArr(FailCount) = "Export failed for configurations:"
                    FailCount = FailCount + 1
                    ReDim Preserve FailedToExportArr(FailCount)
                    FailedToExportArr(FailCount) = ConfigObj.Name & " (FP-" & FlatFeatNum & ")"
                Else:
                    FailCount = FailCount + 1
                    ReDim Preserve FailedToExportArr(FailCount)
                    FailedToExportArr(FailCount) = ConfigObj.Name & " (FP-" & FlatFeatNum & ")"
                End If
                ExportFailed = False
            End If
        
            'if not multibody export, exit the loop
            If frmControlPanel.optExportAllBodies = False Then
                GoTo ExitLoop
            End If
        End If
    End If
    
SkipFlatFeature:
    Set swFeat = swFeat.GetNextFeature
Loop
ExitLoop:

If Err.Number > 0 Then
    Debug.Print "ExportAction " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Sub GetSetCustPropFileNames(ModelDoc As SldWorks.ModelDoc2, Config As String)

On Error Resume Next

Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vCustPropNames As Variant
Dim vConfigNamesArray As Variant
Dim vConfigName As Variant
Dim vName As Variant
Dim valOut As String
Dim strValue As String
Dim p As Long

Set swCustPropMgr = ModelDoc.Extension.CustomPropertyManager(Empty)
vCustPropNames = swCustPropMgr.GetNames
If IsEmpty(vCustPropNames) = False Then
    For Each vName In vCustPropNames
        swCustPropMgr.Get3 vName, True, valOut, strValue
            For p = 1 To 8
                If UCase(frmControlPanel.Controls("cboPos" & (p))) = UCase(vName) And _
                    vName <> ConfiguratorConfig And _
                    vName <> ConfiguratorPartName And _
                    vName <> ConfiguratorThickness And _
                    vName <> ConfiguratorMaterial And _
                    vName <> ConfiguratorFlatFeat Then
                    frmControlPanel.Controls("cboPos" & (p)) = strValue
                End If
            Next p
    Next vName
End If

vConfigNamesArray = ModelDoc.GetConfigurationNames
For Each vConfigName In vConfigNamesArray
    If vConfigName = Config Then
        Set swCustPropMgr = ModelDoc.Extension.CustomPropertyManager(vConfigName)
        vCustPropNames = swCustPropMgr.GetNames
        If IsEmpty(vCustPropNames) = False Then
            For Each vName In vCustPropNames
                swCustPropMgr.Get3 vName, True, valOut, strValue
                    For p = 1 To 8
                        If UCase(frmControlPanel.Controls("cboPos" & (p))) = UCase(vName) And _
                            vName <> ConfiguratorConfig And _
                            vName <> ConfiguratorPartName And _
                            vName <> ConfiguratorThickness And _
                            vName <> ConfiguratorMaterial And _
                            vName <> ConfiguratorFlatFeat Then
                            frmControlPanel.Controls("cboPos" & (p)) = strValue
                        End If
                    Next p
            Next vName
        End If
    End If
        'Exit For
Next vConfigName

If Err.Number > 0 Then
    Debug.Print "GetSetCustomPropFileNames " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Function GetDxfMap(Optional FromInit As Boolean = False)

On Error Resume Next

Dim f As Long
Dim i As Long
Dim CurMaps As String
Dim CurIndex As Integer
Dim FirstSlash As Integer
Dim FileName As String
Dim FolderName As String
Dim MapsCount As Integer
Dim FileNameExists As Boolean

'on startup of SW, map file index if -1 if none found, or 0 if one found.
'if one found, then dxfmappingfiles is on full path length.
'more files added during the session will lengthen dxfmapping files string with carriage return.
'each new found path represents a new index number.
If FromInit = True Then
    origDxfMappingFileIndex = swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
        frmMappingSettings.lblDxfMappingFileIndex = origDxfMappingFileIndex
        CurIndex = origDxfMappingFileIndex
    origDxfMappingFiles = swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)
        frmMappingSettings.lblActiveMap = origDxfMappingFiles
        CurMaps = origDxfMappingFiles
        Debug.Print CurMaps
    origDxfMapping = swApp.GetUserPreferenceToggle(swDxfMapping)
        frmControlPanel.optMappingFile = origDxfMapping
    origDxfDontShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
        frmMappingSettings.optDxfDontShowMap = origDxfDontShowMap
    origDxfVersion = swApp.GetUserPreferenceIntegerValue(swDxfVersion)
        frmMappingSettings.lblDxfVersion = origDxfVersion
    origDxfOutputFonts = swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
        frmMappingSettings.lblDxfOutputFonts = origDxfOutputFonts
    origDxfOutputLineStyles = swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
        frmMappingSettings.lblDxfOutputLineStyles = origDxfOutputLineStyles
    origDxfEndPointMerge = swApp.GetUserPreferenceToggle(swDxfEndPointMerge)
        frmMappingSettings.optDxfEndPointMerge = origDxfEndPointMerge
    origDxfMergingDistance = swApp.GetUserPreferenceDoubleValue(swDxfMergingDistance)
        frmMappingSettings.txtDxfMergingDistance = origDxfMergingDistance
    origDxfHighQualityExport = swApp.GetUserPreferenceToggle(swDXFHighQualityExport)
        frmMappingSettings.optDxfHighQualityExport = origDxfHighQualityExport
    origDxfExportSplinesAsSplines = swApp.GetUserPreferenceToggle(swDxfExportSplinesAsSplines)
        frmMappingSettings.optDxdExportSplinesAsSplines = origDxfExportSplinesAsSplines
Else
    CurIndex = swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)
        frmMappingSettings.lblDxfMappingFileIndex = CurIndex
    CurMaps = swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)
        Debug.Print CurMaps
        'Will set the active map label below
    frmControlPanel.optMappingFile = swApp.GetUserPreferenceToggle(swDxfMapping)
    frmMappingSettings.optDxfDontShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)
    frmMappingSettings.optDxfEndPointMerge = swApp.GetUserPreferenceToggle(swDxfEndPointMerge)
    frmMappingSettings.txtDxfMergingDistance = swApp.GetUserPreferenceDoubleValue(swDxfMergingDistance)
    frmMappingSettings.optDxfHighQualityExport = swApp.GetUserPreferenceToggle(swDXFHighQualityExport)
    frmMappingSettings.optDxdExportSplinesAsSplines = swApp.GetUserPreferenceToggle(swDxfExportSplinesAsSplines)
    
    origDxfVersion = swApp.GetUserPreferenceIntegerValue(swDxfVersion)
        frmMappingSettings.lblDxfVersion = origDxfVersion
    origDxfOutputFonts = swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)
        frmMappingSettings.lblDxfOutputFonts = origDxfOutputFonts
    origDxfOutputLineStyles = swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)
        frmMappingSettings.lblDxfOutputLineStyles = origDxfOutputLineStyles
End If

'add found maps to MapFiles string array and MappingSettings cbo
If CurMaps = "" Then
    ReDim MapFiles(1)
    MapFiles(0) = ""
    CurIndex = 0
Else
    MapFiles = Split(CurMaps, vbLf, -1, vbTextCompare)
End If

For f = 0 To UBound(MapFiles)
    MapFiles(f) = Replace(MapFiles(f), vbLf, "", 1, -1, vbTextCompare)
    If Len(MapFiles(f)) > 4 And UCase(Right(MapFiles(f), 4)) = ".TXT" Then
        
        MapFiles(MapsCount) = MapFiles(f)
            
            Debug.Print "Map(" & MapsCount & ")--------------------"
            Debug.Print "Current index: " & CurIndex
            Debug.Print "Map full path: " & MapFiles(MapsCount)

        If MapsCount = CurIndex Then
            frmMappingSettings.lblActiveMap = MapFiles(CurIndex)
            frmMappingSettings.Repaint
        End If
        
        MapsCount = MapsCount + 1
    End If
Next f

If frmMappingSettings.lblActiveMap = MapFiles(CurIndex) Then
    MappingFileLocation = FolderName & FileName
    frmControlPanel.frmMapFile.BorderColor = vbBlue
    frmControlPanel.frmMapFile.ForeColor = vbBlue
    frmControlPanel.frmMapFile.Caption = "Use Map File - Map Found"
Else
    frmControlPanel.frmMapFile.BorderColor = vbRed
    frmControlPanel.frmMapFile.ForeColor = vbRed
    frmControlPanel.frmMapFile.Caption = "Use Map File - Not Found!"

End If

If Err.Number > 0 Then
    Debug.Print "GetDxfMap " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Function SetDxfMap(MapFilePath As String, MapIndex As Integer)

On Error Resume Next

Dim Index As Integer
Dim FirstSlash As Integer
Dim FileName As String
Dim FolderName As String

swApp.SetUserPreferenceIntegerValue swDxfMappingFileIndex, MapIndex
    frmMappingSettings.lblDxfMappingFileIndex = MapIndex
swApp.SetUserPreferenceStringListValue swDxfMappingFiles, MapFilePath
    
swApp.SetUserPreferenceToggle swDxfMapping, frmControlPanel.optMappingFile
swApp.SetUserPreferenceToggle swDXFDontShowMap, frmMappingSettings.optDxfDontShowMap
swApp.SetUserPreferenceIntegerValue swDxfVersion, origDxfVersion
swApp.SetUserPreferenceIntegerValue swDxfOutputFonts, origDxfOutputFonts
swApp.SetUserPreferenceIntegerValue swDxfOutputLineStyles, origDxfOutputLineStyles
swApp.SetUserPreferenceStringListValue swDxfEndPointMerge, frmMappingSettings.optDxfEndPointMerge
swApp.SetUserPreferenceStringListValue swDxfMergingDistance, frmMappingSettings.txtDxfMergingDistance
swApp.SetUserPreferenceStringListValue swDXFHighQualityExport, frmMappingSettings.optDxfHighQualityExport
swApp.SetUserPreferenceStringListValue swDxfExportSplinesAsSplines, frmMappingSettings.optDxdExportSplinesAsSplines

If Err.Number > 0 Then
    Debug.Print "SetDxfMap " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Function ResetDxfMap()

On Error Resume Next

swApp.SetUserPreferenceToggle swDxfMapping, origDxfMapping
swApp.SetUserPreferenceToggle swDXFDontShowMap, origDxfDontShowMap
swApp.SetUserPreferenceIntegerValue swDxfVersion, origDxfVersion
swApp.SetUserPreferenceIntegerValue swDxfOutputFonts, origDxfOutputFonts
swApp.SetUserPreferenceIntegerValue swDxfMappingFileIndex, origDxfMappingFileIndex
swApp.SetUserPreferenceIntegerValue swDxfOutputLineStyles, origDxfOutputLineStyles
swApp.SetUserPreferenceStringListValue swDxfMappingFiles, origDxfMappingFiles
swApp.SetUserPreferenceToggle swDxfEndPointMerge, origDxfEndPointMerge
swApp.SetUserPreferenceDoubleValue swDxfMergingDistance, origDxfMergingDistance
swApp.SetUserPreferenceToggle swDXFHighQualityExport, origDxfHighQualityExport
swApp.SetUserPreferenceToggle swDxfExportSplinesAsSplines, origDxfExportSplinesAsSplines

If Err.Number > 0 Then
    Debug.Print "ResetDxfMap " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Function AddRemoveConfigSuffix(Action As Boolean, Optional Config As String = "")

On Error Resume Next

Dim ModifiedName As String
Dim OriginalName As String
Dim NewName As String
Dim i As Long

Dim swConfigArr As Variant
Dim swConfig As SldWorks.Configuration

Set swModel = swApp.ActiveDoc
swConfigArr = swModel.GetConfigurationNames

For i = 0 To UBound(swConfigArr)
    If Config = "" Then 'when Config is empty, all configs in file get the suffix appended
        GoTo Rename
    ElseIf Config = swConfigArr(i) Then
        GoTo Rename
    Else
        GoTo skip
    End If
Rename:
    If Action = True Then
        OriginalName = swConfigArr(i)
        ModifiedName = Replace(swConfigArr(i), OriginalName, OriginalName & ConfigSuffix, 1, -1, vbTextCompare)
        NewName = ModifiedName
    Else
        ModifiedName = swConfigArr(i)
        OriginalName = Left(ModifiedName, Len(ModifiedName) - Len(ConfigSuffix))
        NewName = OriginalName
    End If
    
    NewName = ReplaceChars(NewName)
    
    Set swConfig = swModel.GetConfigurationByName(swConfigArr(i))
    swConfig.Name = NewName
skip:
    Next i

If Err.Number > 0 Then
    Debug.Print "AddRemoveConfigSuffix " & "Err #" & Err.Number & " " & Err.Description
End If

End Function
Sub DeleteDesignTable()

On Error Resume Next

Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature

Set swFeat = swModel.FirstFeature

While Not swFeat Is Nothing
    Debug.Print swFeat.GetTypeName
      
    Set swSubFeat = swFeat.GetFirstSubFeature
    While Not swSubFeat Is Nothing
        Debug.Print vbTab & swSubFeat.GetTypeName
          
        If swSubFeat.GetTypeName = "DesignTableFeature" Then
            swSubFeat.Select2 False, 0
            swModel.EditDelete
            Exit Sub
        End If
          
        Set swSubFeat = swSubFeat.GetNextSubFeature
    Wend
      
    Set swFeat = swFeat.GetNextFeature
Wend
      
DeleteDesignTableHandler:
If Err.Number > 0 Then
    MsgBox "DeleteDesignTable " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub DeleteRefPartConfigs()

On Error Resume Next

Dim Errors As Long
Dim ExportPart As SldWorks.IModelDoc2
Dim Save As Boolean
Dim i As Long
Dim c As Long
Dim f As Long
Dim x As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
    
Dim HasSmFlat As Integer
Dim RefConfigs As Variant
Dim RemainingConfigs As Variant
Dim swCfg As Configuration
Dim DoNotDelConfig As Boolean
Dim RefConfig As SldWorks.Configuration
Dim RConfig As String
Dim ActiveCfgMrg As SldWorks.ConfigurationManager
Dim ActiveCfg As SldWorks.Configuration
Dim RemainingCount As Integer

Set RefConfigs = swApp.ActiveDoc
Set ActiveCfgMrg = swModel.ConfigurationManager
RefConfigs = swModel.GetConfigurationNames
RemainingConfigs = swModel.GetConfigurationNames
RemainingCount = swModel.GetConfigurationCount - 1

For i = 0 To UBound(RefConfigs)
    RConfig = RefConfigs(i)
    
        For c = 0 To UBound(ExportConfigsArr)
            If Not IsEmpty(ExportConfigsArr) Then
               If UCase(Left(RConfig, Len(RConfig) - Len(ConfigSuffix))) = ExportConfigsArr(c) Then
                   DoNotDelConfig = True
               End If
            End If
        Next c
        
        'false = delete config
        If DoNotDelConfig = False Then
            
            Set swCfg = swModel.GetConfigurationByName(RefConfigs(i))
            Set ActiveCfg = ActiveCfgMrg.ActiveConfiguration
            If ActiveCfg.Name = RefConfigs(i) Then
                If i = 0 Then
                    swModel.ShowConfiguration RemainingConfigs(1)
                Else
                    swModel.ShowConfiguration RemainingConfigs(0)
                End If
            End If
            swModel.DeleteConfiguration2 (RefConfigs(i))
            RemainingConfigs = swModel.GetConfigurationNames
        Else
            DoNotDelConfig = False
        End If
    
        If InStr(1, RefConfigs(i), "SM-FLAT-PATTERN", vbTextCompare) <> 0 Or _
           InStr(1, RefConfigs(i), "FLAT-PATTERN", vbTextCompare) <> 0 Then
                Set swCfg = swModel.GetConfigurationByName(RefConfigs(i))
                Set ActiveCfg = ActiveCfgMrg.ActiveConfiguration
                If ActiveCfg.Name = RefConfigs(i) Then
                    If i = 0 Then
                        swModel.ShowConfiguration RemainingConfigs(1)
                    Else
                        swModel.ShowConfiguration RemainingConfigs(0)
                    End If
                End If
                Set swCfg = swModel.GetConfigurationByName(RefConfigs(i))
                swModel.DeleteConfiguration2 (RefConfigs(i))
        End If
        
Next i

Save = swModel.Save3(swSaveAsOptions_Silent, 1, 1)
        
If Err.Number > 0 Then
    Debug.Print "DeleteRefPartConfigs " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Sub FindReplaceCharactersInConfig()

On Error Resume Next

Dim ConfigName As String
Dim TempName As String
Dim i As Long
Dim r As Long
Dim vRet As Variant
Dim swCfg As Configuration

vRet = swModel.GetConfigurationNames
For i = 0 To UBound(vRet)
    ConfigName = vRet(i)
    TempName = ReplaceChars(ConfigName)
    If TempName <> vRet(i) Then
        Set swCfg = swModel.GetConfigurationByName(vRet(i))
        swCfg.Name = TempName
    End If
Next i

If Err.Number > 0 Then
    Debug.Print "FindReplaceCharacterInConfig " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Function ReplaceChars(TempName As String) As String

On Error Resume Next

Dim iChars As Variant
Dim i As Long
Dim r As Long

iChars = Array("<", ">", ":", "/", """", "\", "|", "?", "*", "@")

For r = 0 To UBound(iChars)
    TempName = Replace(TempName, iChars(r), "_", 1, -1, vbTextCompare)
Next r

ReplaceChars = TempName

If Err.Number > 0 Then
    Debug.Print "ReplaceChars " & "Err #" & Err.Number & " " & Err.Description
End If
   
End Function
Sub CorrectBendSuppression(ConfigObj As SldWorks.Configuration, IsSmFlatConfig As Boolean, FlatFeatName As String)

On Error Resume Next

Debug.Print ConfigObj.Name

If IsSmFlatConfig = False Then
    UnsuppressFlatBends False, FlatFeatName
    SuppressFlatFeatures FlatFeatName
Else
    UnsuppressFlatBends True, FlatFeatName
    UnsuppressFlatFeature FlatFeatName
End If

If Err.Number > 0 Then
    Debug.Print "CorrectBendSuppression " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Private Sub UnsuppressFlatBends(IsSmFlatConfig As Boolean, FlatFeatName As String)

On Error Resume Next

Dim swConfiMgr                  As SldWorks.ConfigurationManager
Dim swConfig                    As SldWorks.Configuration
Dim swFeat                      As SldWorks.Feature
Dim swSubFeat                   As SldWorks.Feature
Dim vSubFeat                    As Variant
Dim lerrors                     As Long
Dim lWarnings                   As Long
Dim swSelMgr                    As SldWorks.SelectionMgr

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Set swConfiMgr = swModel.ConfigurationManager
Set swConfig = swConfiMgr.ActiveConfiguration
Set swSelMgr = swModel.SelectionManager

Set swFeat = swModel.FirstFeature
    
Do Until swFeat Is Nothing
    If swFeat.Name = FlatFeatName Then
        Debug.Print "Feature Name  : " & swFeat.Name
        
        Set swSubFeat = swFeat.GetFirstSubFeature
        Do Until swSubFeat Is Nothing
            If swSubFeat.GetTypeName = "ProfileFeature" Or swSubFeat.GetTypeName = "UiBend" Then
                Debug.Print "Flat Sub Feature: " & swSubFeat.Name
                If swSubFeat.SetSuppression2(swUnSuppressFeature, swThisConfiguration, Nothing) = False Then
                    Debug.Print "Failed to unsuppress feature: " & swFeat.Name
                End If
            End If

            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop
    End If
    
NextFeature:
    Set swFeat = swFeat.GetNextFeature
Loop

If Err.Number > 0 Then
    Debug.Print "UnsuppressFlatBends " & "Err #" & Err.Number & " " & Err.Description
End If

End Sub
Private Sub SuppressFlatFeatures(FlatFeatName As String)

On Error Resume Next
  
Dim swConfiMgr                  As SldWorks.ConfigurationManager
Dim swConfig                    As SldWorks.Configuration
Dim swFeat                      As SldWorks.Feature
Dim swSubFeat                   As SldWorks.Feature
Dim vSubFeat                    As Variant
Dim lerrors                     As Long
Dim lWarnings                   As Long
Dim swSelMgr                    As SldWorks.SelectionMgr
  
Set swConfiMgr = swModel.ConfigurationManager
Set swConfig = swConfiMgr.ActiveConfiguration

Set swFeat = swModel.FirstFeature
Do Until swFeat Is Nothing
    If swFeat.Name = FlatFeatName Then
        Debug.Print swFeat.Name
        If swFeat.SetSuppression2(swSuppressFeature, swThisConfiguration, Nothing) = False Then
            Debug.Print "Failed to suppress flat feature " & swFeat.Name
        End If
    End If

    Set swFeat = swFeat.GetNextFeature
Loop

If Err.Number > 0 Then
    Debug.Print "SuppressFlatFeatures " & "Err #" & Err.Number & " " & Err.Description
End If
    
End Sub
Private Sub UnsuppressFlatFeature(FlatFeatName As String)

On Error Resume Next

Dim swConfiMgr                  As SldWorks.ConfigurationManager
Dim swConfig                    As SldWorks.Configuration
Dim swFeat                      As SldWorks.Feature
Dim swSubFeat                   As SldWorks.Feature
Dim vSubFeat                    As Variant
Dim lerrors                     As Long
Dim lWarnings                   As Long
Dim swSelMgr                    As SldWorks.SelectionMgr

Set swConfiMgr = swModel.ConfigurationManager
Set swConfig = swConfiMgr.ActiveConfiguration

Set swFeat = swModel.FirstFeature
Do Until swFeat Is Nothing
    If swFeat.Name = FlatFeatName Then
        Debug.Print swFeat.Name
        If swFeat.SetSuppression2(swUnSuppressFeature, swThisConfiguration, Nothing) = False Then
            Debug.Print "Failed to Unsuppress flat feature" & swFeat.Name
        End If
    End If
SkipFlatPattern:
    Set swFeat = swFeat.GetNextFeature
Loop

If Err.Number > 0 Then
    Debug.Print "UnsuppressFlatFeature " & "Err #" & Err.Number & " " & Err.Description
End If
    
End Sub
Function BrowseForFile()

    Dim wso
    Dim hta
    
    Set wso = CreateObject("Wscript.Shell")
    hta = """about:" & vbCrLf _
                 & """"

    BrowseForFile = wso.Exec("mshta.exe " & hta).StdOut.ReadLine

End Function
Function BrowseForFolder(title, options, startPath)

    Dim shell
    Dim item
    
    Set shell = CreateObject("Shell.Application")
    Set item = shell.BrowseForFolder(0, title, options, startPath)

    'If Cancel or Close is clicked, or no selection is made then the result is Nothing

    If item Is Nothing Then
        BrowseForFolder = ""
    Else
        AltSaveLocation = item.Items().item.Path & "\"
        
        If AltSaveLocation = OriginalFolderPath Then
            MsgBox "Folder Conflict!" & _
                    vbNewLine & vbNewLine & _
                    "Same as currently active doc location. Not allowed.", _
                    vbCritical + vbOKOnly, "Save Location not allowed!"
            AltSaveLocation = ""
        Else
            frmControlPanel.lblSaveLocation = AltSaveLocation
            Debug.Print "Atlernate Save location: " & AltSaveLocation
        End If
    End If
    
End Function
Sub Refresh()

OriginalFolderPath = Strings.Left(swModel.GetPathName, Strings.Len(swModel.GetPathName) - Strings.Len(swModel.GetTitle)) 'has end-slash
frmControlPanel.LblOriginalLocation = OriginalFolderPath
mMain.GetDxfMap True

End Sub
Sub Main()

On Error Resume Next

Dim DocNames As Variant
Dim FileObj As SldWorks.ModelDoc2
Dim DocName As String
Dim i As Long
Dim p As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swApp.GetDocumentCount < 1 Then
    MsgBox "A file must be open to initialize the export!", _
        vbOKOnly + vbCritical, _
        "No File Open"
    End
ElseIf swApp.GetDocumentCount > 1 Then
    If swModel.GetType = 1 Then
        If MsgBox("More than one Solidworks file is currently open." & _
                    vbNewLine & vbNewLine & _
                    "The DXF Export tool must close all non-active files " & _
                    "before proceeding. Click 'Yes' to close all non-active " & _
                    "files WITHOUT saving." & _
                    vbNewLine & vbNewLine & _
                    "Continue?", _
                    vbCritical + vbYesNo, _
                    "More than 1 document open") _
                = vbNo Then
                    Exit Sub
        End If
    End If
    If swModel.GetType = 2 Then
        If MsgBox("The DXF Export Tool has detected an assembly for export. " & _
                    "The tool cannot detect whether additional Solidworks files " & _
                    "are open. Please confirm that no additional Solidworks files are open." & _
                    vbNewLine & vbNewLine & _
                    "If 'Yes' is selected, the DXF Export tool will close " & _
                    "all non-active files WITHOUT saving." & _
                    vbNewLine & vbNewLine & _
                    "Select 'No' if you have additional Solidworks files open " & _
                    "that require saving." & _
                    vbNewLine & vbNewLine & _
                    "Continue?", _
                    vbQuestion + vbYesNo, _
                    "Active doc check") _
                = vbNo Then
                    End
        End If
    End If

    'Close non relevant docs that are open in SW
    DocNames = swApp.GetDocuments
    For i = 0 To UBound(DocNames)
        Set FileObj = DocNames(i)
        If FileObj.GetTitle <> swModel.GetTitle Then
            swApp.CloseDoc (FileObj.GetTitle)
        End If
    Next i
End If

OriginalFolderPath = Strings.Left(swModel.GetPathName, Strings.Len(swModel.GetPathName) - Strings.Len(swModel.GetTitle)) 'has end-slash
OriginalPathName = swModel.GetPathName
frmControlPanel.LblOriginalLocation = OriginalFolderPath

'form init settings
If swModel.GetType = 1 Then
    frmControlPanel.optAssembly.Enabled = False
ElseIf swModel.GetType = 2 Then
    frmControlPanel.optBatch.Enabled = False
    frmControlPanel.optSingle.Enabled = False
    frmControlPanel.optAssembly = True
    frmControlPanel.chkSelectAll.Enabled = False
    frmControlPanel.lblCurrentFile = OriginalPathName
    'frmControlPanel.chkDeleteSmFlatConfigs.Enabled = False
    'frmControlPanel.chkAddRefPart.Enabled = False
Else
    MsgBox "Export tool must be initiated from a .sldprt " & _
            "or .sldasm file only." & _
            vbNewLine & vbNewLine & _
            "Terminating...", _
            vbExclamation + vbOKOnly, _
            ".SLDPRT/.SLDASM not found"
    End
End If

mMain.UpdateStatus "Not Running", vbRed, "", ""
frmControlPanel.optDXF.Value = True
frmControlPanel.chkAddConfigSuffix = False
frmControlPanel.cmdRunExport.Caption = "Run Export"
frmControlPanel.listExportOptions.Locked = True
frmControlPanel.listExportOptions.BackColor = RGB(240, 240, 240)
frmControlPanel.txtViewScale = 100


For p = 1 To 8
    With frmControlPanel.Controls("cboPos" & (p))
        .AddItem ConfiguratorConfig
        .AddItem ConfiguratorPartName
        .AddItem ConfiguratorThickness
        .AddItem ConfiguratorMaterial
        .AddItem ConfiguratorFlatFeat
    End With
Next p

frmControlPanel.cboPos1 = ConfiguratorConfig
frmControlPanel.cboPos2 = ConfiguratorMaterial
frmControlPanel.cboPos3 = ConfiguratorThickness
frmControlPanel.cboPos4 = ""
frmControlPanel.cboPos5 = ""
frmControlPanel.cboPos6 = ""
frmControlPanel.cboPos7 = ""
frmControlPanel.cboPos8 = ""

mMain.GetDxfMap True

frmControlPanel.Show

If Err.Number > 0 Then
    Debug.Print "Main" & "Err #" & Err.Number & " " & Err.Description
End If

End Sub