Batch create feature folders in the active SOLIDWORKS document

Edit ArticleEdit Article

This VBA macro allows to create feature folders in the batch mode in the active SOLIDWORKS assembly or part document.

Macro will ask for the number of folders to be created and the folder prefix name.

Macro will create the specified number of folder with the prefix name followed by the index.

If folder with the next index already exists, next index will be used for the naming

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 foldersCount As Integer
        Dim folderNamePrefix As String
        foldersCount = CInt(InputBox("Specify the number of folders to create", "Batch Folder Creator", "5"))
        folderNamePrefix = InputBox("Specify the prefix name of the folder", "Batch Folder Creator", "MyFolder")
        Dim swAnchorFeat As SldWorks.Feature
        Set swAnchorFeat = swModel.Extension.GetLastFeatureAdded
        Dim swFeatMgr As SldWorks.FeatureManager
        Set swFeatMgr = swModel.FeatureManager
        Dim i As Integer
        Dim nextIndex As Integer
        nextIndex = 0
        For i = 1 To foldersCount
            swAnchorFeat.Select2 False, -1
            Dim swFolderFeat As SldWorks.Feature
            Set swFolderFeat = swFeatMgr.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
            If swFolderFeat Is Nothing Then
                Err.Raise vbError, "", "Failed to create a folder, make sure there there is at least one feature in the model"
            End If
            Dim folderName As String
                nextIndex = nextIndex + 1
                folderName = folderNamePrefix & nextIndex
            Loop While False <> swFeatMgr.IsNameUsed(swNameType_e.swFeatureName, folderName)
            swFolderFeat.Name = folderName
            swModel.Extension.ReorderFeature swFolderFeat.Name, "", swMoveLocation_e.swMoveToEnd
        Err.Raise vbError, "", "No model opened"
    End If
End Sub

Product of Xarial Product of Xarial