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
SolidworksApi macros