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

    Memory Issues

    Sean Donnelly


      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