Split feature folders of the SOLIDWORKS file to individual configurations

VBA macro creates individual configurations for each feature folder in the active SOLIDWORKS part or assembly

This VBA macro creates configuration for each top-level feature folder in the active SOLIDWORKS part or assembly.

If no objects selected in the model then all folder features will be processed, otherwise only selected feature folders will be processed.

Created configuration will be named after the feature folder.

It is possible to specify if derived or top level configurations should be created for each feature folder.

Const CREATE_DERIVED_CONFS As Boolean = True 'True to create derived configuration, False to create top level configuration

All other folders will be suppressed for each configuration. Features outside of the folders will not be suppressed.

Const CREATE_DERIVED_CONFS As Boolean = True

Const FOLDER_END_TAG As String = "___EndTag___"

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        
        Dim vFeatFolders As Variant
        Dim vAllFeatFolders As Variant
        
        Dim swSelMgr As SldWorks.SelectionMgr
        Set swSelMgr = swModel.SelectionManager
        
        vAllFeatFolders = GetAllFeatureFolders(swModel)
        
        If swSelMgr.GetSelectedObjectCount2(-1) = 0 Then
            vFeatFolders = vAllFeatFolders
        Else
            vFeatFolders = GetSelectedFeatureFolders(swModel)
        End If
        
        If Not IsEmpty(vFeatFolders) Then
            
            Dim activeConfName As String
            activeConfName = swModel.ConfigurationManager.ActiveConfiguration.Name
            
            Dim i As Integer
            
            For i = 0 To UBound(vFeatFolders)
                Dim swFeatFolder As SldWorks.Feature
                Set swFeatFolder = vFeatFolders(i)
                CreateConfigurationForFolder swModel, swFeatFolder, vAllFeatFolders, IIf(CREATE_DERIVED_CONFS, activeConfName, "")
            Next
            
        End If
                
    Else
        Err.Raise vbError, "", "No active document"
    End If
    
End Sub

Function GetAllFeatureFolders(model As SldWorks.ModelDoc2) As Variant
    
    Dim swFeatFolders() As SldWorks.Feature
    
    Dim swFeat As SldWorks.Feature
    Set swFeat = model.FirstFeature
    
    While Not swFeat Is Nothing
        
        If swFeat.GetTypeName2() = "FtrFolder" And InStr(LCase(swFeat.Name), LCase(FOLDER_END_TAG)) = 0 Then

            If (Not swFeatFolders) = -1 Then
                ReDim swFeatFolders(0)
            Else
                ReDim Preserve swFeatFolders(UBound(swFeatFolders) + 1)
            End If
            
            Set swFeatFolders(UBound(swFeatFolders)) = swFeat
            
        End If
        
        Set swFeat = swFeat.GetNextFeature
        
    Wend
    
    
    If (Not swFeatFolders) = -1 Then
        GetAllFeatureFolders = Empty
    Else
        GetAllFeatureFolders = swFeatFolders
    End If
        
End Function

Function GetSelectedFeatureFolders(model As SldWorks.ModelDoc2) As Variant
    
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = model.SelectionManager

    Dim swFeatFolders() As SldWorks.Feature
    
    Dim i As Integer
    
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelFTRFOLDER Then
        
            Dim swFeat As SldWorks.Feature
            Set swFeat = swSelMgr.GetSelectedObject6(i, -1)
            
            If (Not swFeatFolders) = -1 Then
                ReDim swFeatFolders(0)
            Else
                ReDim Preserve swFeatFolders(UBound(swFeatFolders) + 1)
            End If
            
            Set swFeatFolders(UBound(swFeatFolders)) = swFeat
        End If
    
    Next
        
    If (Not swFeatFolders) = -1 Then
        GetSelectedFeatureFolders = Empty
    Else
        GetSelectedFeatureFolders = swFeatFolders
    End If
    
End Function

Sub CreateConfigurationForFolder(model As SldWorks.ModelDoc2, folderFeat As SldWorks.Feature, allFeatFolders As Variant, parentConfName As String)
    
    Dim swFolderConf As SldWorks.Configuration
    Set swFolderConf = model.ConfigurationManager.AddConfiguration2(folderFeat.Name, "", "", swConfigurationOptions2_e.swConfigOption_DontActivate Or swConfigurationOptions2_e.swConfigOption_SuppressByDefault, parentConfName, "", False)
    
    If swFolderConf Is Nothing Then
        Err.Raise vbError, "", "Failed to create configuration for " & folderFeat.Name
    End If
    
    Dim i As Integer
    
    For i = 0 To UBound(allFeatFolders)
        
        Dim swOtherFeatFolder As SldWorks.Feature
        Set swOtherFeatFolder = allFeatFolders(i)
        
        If swApp.IsSame(folderFeat, swOtherFeatFolder) <> swObjectEquality.swObjectSame Then
        
            Dim targetConf(0) As String
            targetConf(0) = swFolderConf.Name
            
            If False = swOtherFeatFolder.SetSuppression2(swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swSpecifyConfiguration, targetConf) Then
                Err.Raise vbError, "", "Failed to configure the suppression of the folder feature for " & swOtherFeatFolder.Name & " in " & swFolderConf.Name
            End If
            
        End If
        
    Next
    
End Sub