AnsweredAssumed Answered

Memory Issues

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

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

Outcomes