Hello,

I have a part that seems to not release memory after my macro runs. I am creating a flat pattern for all of my sheet metal configurations. I've been deallocating the objects and can't figure this out. Any ideas? For basic models its not a big deal, but more complex models makes the memory jump up incredibly high.

Dim swApp               As SldWorks.SldWorks

Dim swModel             As SldWorks.ModelDoc2

Dim swModel2            As SldWorks.ModelDoc2

Dim swDraw              As SldWorks.DrawingDoc

Dim swFeature           As SldWorks.Feature

Dim swView              As SldWorks.View

Dim bSheetMetal         As Boolean

Dim iErrors             As Long

Dim sDrawingTemplate    As String

Sub CreateFlats(configs As collection)

    Set swApp = Application.SldWorks

    If swApp.GetDocumentCount() = 0 Then Exit Sub

    Set swModel = swApp.ActiveDoc

    If swModel.GetType() = 2 Then Exit Sub

    If swModel.GetType() = 3 Then Exit Sub

    sDrawingTemplate = swApp.GetUserPreferenceStringValue(swUserPreferenceStringValue_e.swDefaultTemplateDrawing)

    If sDrawingTemplate = "" Then

       MsgBox ("Error Retrieving Drawing Template")

       Exit Sub

    End If

    bSheetMetal = False

    Set swFeature = swModel.FirstFeature

    Do While Not swFeature Is Nothing

       If swFeature.GetTypeName2() = "SheetMetal" Then

          bSheetMetal = True

       End If

       Set swFeature = swFeature.GetNextFeature

    Loop

    If bSheetMetal = False Then

       MsgBox ("This Macro Is For Sheet Metal Parts Only")

       Exit Sub

    End If

    If configs.Count > 0 Then

        Set swModel2 = swApp.NewDocument(sDrawingTemplate, swDwgPaperSizes_e.swDwgPaperBsize, 0, 0)

        Dim config As Variant

        For Each config In configs

            Dim configName As String

            configName = config

            If SwFunctions.EndsWith(configName, "SM-FLAT-PATTERN") = False Then

                Set swDraw = swModel2

                'Biggest increase in memory

                Set swView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName, configName, 0, 0, 0, False, False)

                Set swView = Nothing

                swModel.ForceRebuild3 (False)

                Set swModel = swApp.ActivateDoc3(swModel.GetPathName, False, swRebuildOnActivation_e.swUserDecision, iErrors)

            End If

            'Decreases memory by 40K

            UnsuppressFeaturesFlat configName

            configName = ""

        Next config

        config = Null

        Dim path As String

        path = swModel2.GetPathName

        Set swModel = Nothing

        Set swModel2 = Nothing

        swApp.QuitDoc (path)

    Else

        MsgBox "Please select at least 1 configuration"

    End If

End Sub

Public Function UnsuppressFeaturesFlat(config As String)

    Dim feat As Object

    Dim res As Boolean

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swModelDocExt = swModel.Extension

    swModel.ShowConfiguration2 (config + "SM-FLAT-PATTERN")

    Set feat = swModel.FirstFeature

    Do While Not feat Is Nothing

        Let featureName = feat.Name

        If InStr(featureName, "Flat-Pattern") <> 0 Then

            Set swSubFeat = feat.GetFirstSubFeature

            While Not swSubFeat Is Nothing

                Let subFeatName = swSubFeat.Name

                If InStr(subFeatName, "Flatten-") <> 0 Then

                    res = swModelDocExt.SelectByID2(subFeatName, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)

                    res = swModel.EditUnsuppress2() ' Unsuppress the feature

                ElseIf InStr(subFeatName, "Bend-Line") <> 0 Then

                    res = swModelDocExt.SelectByID2(subFeatName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

                    res = swModel.EditUnsuppress2() ' Unsuppress the feature

                End If

                Set swSubFeat = swSubFeat.GetNextSubFeature

            Wend

        End If

        Set feat = feat.GetNextFeature()

    Loop

    Set feat = Nothing

End Function