4 Replies Latest reply on Feb 20, 2018 5:36 PM by Artem Taturevych

    Memory Issues

    Sean Donnelly

      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