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
SolidworksApi/macros