AnsweredAssumed Answered

Memory Issues

Question asked by Sean Donnelly on Feb 19, 2018
Latest reply on Feb 20, 2018 by Artem Taturevych


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




    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)



        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



        End If


        Set feat = feat.GetNextFeature()




    Set feat = Nothing


End Function