Hello there.

I hope you can help me out, as i'm done with my "magic"

Can you help me, to

a) manually choose a destination folder when starting the macro (e.g. starting macro -> where do you want to save pops up -> browse for the destination - > macro creates Material and Thickness folder in the set destination folder and saves all parts of assemblys and sub-assemblys there)

b) I need to export the layers from my line map - it only exports the geometry, no sketches for example. How to solve this problem?

Tested the line map by exporting the part to .dxf manually and it worked well.

#TASK does the job, BUT it exports every part, and i have some configurations where i set some parts to not be in the bom etc... so thats actually a deal-breaker for me.

***attached is the code

Sub main()

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 bRet As Boolean

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swConf = swModel.GetActiveConfiguration

Set swRootComp = swConf.GetRootComponent3(True)

Debug.Print "File = " & swModel.GetPathName

TraverseComponent swRootComp, 1

Debug.Print "Finished!"

End Sub

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

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 Thickness                                           As Double

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 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

vChildComp = swComp.GetChildren

For i = 0 To UBound(vChildComp)

Set swChildComp = vChildComp(i)

    If swChildComp.ExcludeFromBOM Then GoTo Skip

Active:

Set swApp = Application.SldWorks

'Layer

swApp.SetUserPreferenceToggle swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1

swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfMapping, True

swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDXFDontShowMap, True

swApp.SetUserPreferenceStringListValue swUserPreferenceStringListValue_e.swDxfMappingFiles, "D:\Solidworks\000_Aufträge\Solidworks 2016\Layereinstellungen\SW16Layer.txt"

index = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMappingFileIndex)

    If (index = -1) Then

        swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMappingFileIndex, 0

    End If

index = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMappingFileIndex)

'Layer

Set swChildModel = swChildComp.GetModelDoc2

    If (swChildModel.GetType <> swDocPART) Then GoTo Jump

    Set swpart = swChildModel

    FilePath = Left(swComp.GetPathName, InStrRev(swComp.GetPathName, "\") - 1)

    FileName = swChildModel.GetTitle

    swCurrent = swChildComp.ReferencedConfiguration

    Bodies = swpart.GetBodies2(swBodyType_e.swAllBodies, True)

    Set swBody = Bodies(0)

        If swBody.IsSheetMetal = 0 Then

        GoTo Jump

End If

    If swBody.IsSheetMetal = 1 Then

    Debug.Print "Processing component " & FileName & " as a sheet metal component"

    Debug.Print "Current Config is : "; swCurrent

    GoTo Process

    End If

Process:

Set swpart = swChildModel

sMatName = swpart.GetMaterialPropertyName2(swCurrent, sMatDB)

    If sMatName = "" Then sMatName = "None"

    Debug.Print " Current material is : "; sMatName

    Set swFeat = swChildModel.FirstFeature

    While Not swFeat Is Nothing

        If swFeat.GetTypeName = "SheetMetal" Then

        Set swsheetmetal = swFeat.GetDefinition

        Thickness = swsheetmetal.Thickness

        conv = 1000

        Thickness = Thickness * conv

        Debug.Print " Thickness is :"; Thickness; "mm"

End If

Set swFeat = swFeat.GetNextFeature

Wend

swMatDir = FilePath & "\" & sMatName

Debug.Print swMatDir

    If Dir(swMatDir, vbDirectory) = "" Then MkDir swMatDir

    swThkDir = FilePath & "\" & sMatName & "\" & Thickness

    Debug.Print swThkDir

        If Dir(swThkDir, vbDirectory) = "" Then MkDir swThkDir

        exFileName = FilePath & "\" & sMatName & "\" & Thickness & "\" & FileName & "-" & swCurrent

        Debug.Print exFileName

        Set swOpenModel = swApp.ActivateDoc3(swChildModel.GetPathName, True, loptions, lerrors)

        Boolstatus = swChildModel.ShowConfiguration2(swCurrent)

        swChildModel.ExportFlatPatternView exFileName & ".DXF", 1

        swApp.CloseDoc (swChildModel.GetPathName)

        GoTo Jump

Skip:

Debug.Print "Skipped"

Jump:

TraverseComponent swChildComp, nLevel + 1

Next i

End Sub