Community
Select to view content in your preferred language

Releasing memory using Marshal.FinalReleaseComObject

6628
23
Jump to solution
03-07-2012 11:37 AM
USFS_AGOLAdministrator
by
Deactivated User
‎03-07-2012 11:37 AM
Hi all,

I know this is alot of code, but you have to see the whole thing understand the problem. The code below is doing a Reverse Eliminate of sorts by looping through a selected set of sliver polygons, doing a spatial selection to find out what polygons are touching the slivers, getting the 2nd largest polygon that touches the sliver, and merging the sliver to the second largest polygon by unioning them together, and deleting the original sliver polygon.

It works beautifully well, except it bombs out after processing ~900 slivers with a memory error. I've tried everything I can think of to release the memory, as you will see below. Can anyone see anywhere I can release more memory?

Try
     Using comReleaser As ESRI.ArcGIS.ADF.ComReleaser = New ESRI.ArcGIS.ADF.ComReleaser()
Dim pFeat As IFeature = Nothing
Dim pEnumFeat As IEnumFeature = CType(pMap.FeatureSelection, IEnumFeature)
'Dim pEnumFeat As IEnumFeature = CType(pFLayer.SelectionSet, IEnumFeature)
pEnumFeat.Reset()
Dim pFCur As IFeatureCursor = Nothing
Dim pSF As ISpatialFilter
pSF = New SpatialFilter
Dim pTopoOp As ITopologicalOperator
Dim pLargestAdj As IFeature = Nothing
Dim sliverFeat As IFeature = Nothing
sliverFeat = pEnumFeat.Next

Do Until sliverFeat Is Nothing
'this is really the smallest
'---------------------------------------------------------------------
pLargestAdj = GetLargestAdjacent(sliverFeat, True, pSF, pFCur, pFClass)
'---------------------------------------------------------------------

If Not pLargestAdj Is Nothing Then

pTopoOp = CType(pLargestAdj.ShapeCopy, ITopologicalOperator)
pLargestAdj.Shape = pTopoOp.Union(sliverFeat.ShapeCopy)

updateFeature(m_pFLayer.FeatureClass, pLargestAdj.OID, pLargestAdj.Shape)

sliverFeat.Delete()

Marshal.FinalReleaseComObject(sliverFeat)
Marshal.FinalReleaseComObject(pTopoOp)
Marshal.FinalReleaseComObject(pLargestAdj)

Else
Debug.Print("nothing adjacent to: " & sliverFeat.OID)
End If

nCurRecNo = nCurRecNo + 1
My.ArcMap.Application.StatusBar.Message(0) = nCurRecNo.ToString & "/" & n.ToString & " records complete."

Application.DoEvents()

comReleaser.ManageLifetime(sliverFeat)

sliverFeat = pEnumFeat.Next
Loop

'Stop editing and save the edits
pEditor.StopEditing(True)
Runtime.InteropServices.Marshal.FinalReleaseComObject(pLargestAdj)
End Using

Catch ex As Exception
MsgBox("Error: " & ex.StackTrace, , "RElimAddinPB_onClick")
End Try

---------------------------------------------------------------------------------------------------------------------------------------------
'!!!!!!!!!!!!!!!!!!!!!!!This function is where it bombs out after ~900 records!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Function GetLargestAdjacent(ByVal pFeat As IFeature, ByVal getSecondLargest As Boolean, ByVal pSF As ISpatialFilter, ByVal pFcur As IFeatureCursor, ByVal pFC As IFeatureClass) As IFeature

Try

pSF.Geometry = pFeat.Shape
pSF.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects

pFcur = pFC.Search(pSF, False)

If pFC.FeatureCount(pSF) < 3 Then 'This is set if there is only polygons on one side of the sliver
getSecondLargest = False
End If

Using comReleaser As ESRI.ArcGIS.ADF.ComReleaser = New ESRI.ArcGIS.ADF.ComReleaser()

Dim pFeat2 As IFeature = Nothing, pLargestFeat As IFeature = Nothing
comReleaser.ManageLifetime(pFeat2)
comReleaser.ManageLifetime(pFcur)
Dim dMaxArea As Double = 0
pFeat2 = pFcur.NextFeature

Do Until pFeat2 Is Nothing 'This loop executes everytime, no matter if there are slivers on both sides or not

If Not pFeat2 Is pFeat Then
If pLargestFeat Is Nothing Then
pLargestFeat = pFeat2

dMaxArea = GetArea(CType(pFeat2.Shape, IArea))

Else
If GetArea(CType(pFeat2.Shape, IArea)) > dMaxArea Then
pLargestFeat = pFeat2
dMaxArea = GetArea(CType(pFeat2.Shape, IArea))
Runtime.InteropServices.Marshal.FinalReleaseComObject(pLargestFeat)
Runtime.InteropServices.Marshal.FinalReleaseComObject(pFeat2)
End If
End If
End If

pFeat2 = pFcur.NextFeature
pFcur.Flush()

Loop

Marshal.ReleaseComObject(pFcur)
'comReleaser.Dispose()

If getSecondLargest Then 'This loop will execute only if there are polygons on both sides of the sliver
'pFCur = pFC.Search(pSF, False)
pFcur = m_pFLayer.FeatureClass.Search(pSF, False)

Dim pSecondLargestFeat As IFeature = Nothing
Dim dSecondMaxArea As Double = 0

pFeat2 = pFcur.NextFeature
Do Until pFeat2 Is Nothing
comReleaser.ManageLifetime(pFcur)
If Not pFeat2 Is pLargestFeat Then
If Not pFeat2 Is pFeat Then
If pSecondLargestFeat Is Nothing Then
pSecondLargestFeat = pFeat2
dSecondMaxArea = GetArea(CType(pFeat2.Shape, IArea))
Else
If GetArea(CType(pFeat2.Shape, IArea)) > dSecondMaxArea Then
pSecondLargestFeat = pFeat2
dSecondMaxArea = GetArea(CType(pFeat2.Shape, IArea))
End If
End If
End If
End If

pFeat2 = pFcur.NextFeature
pFcur.Flush()
Loop

pLargestFeat = pSecondLargestFeat

End If

Marshal.ReleaseComObject(pFcur)
GetLargestAdjacent = pLargestFeat
'comReleaser.Dispose()

End Using

Catch ex As Exception
MsgBox(ex.Message, , "Ex routine")
MsgBox(ex.StackTrace, , "Ex routine")
GetLargestAdjacent = Nothing
End Try


End Function

----------------------------------------------------------------------------------------------

Private Sub updateFeature(ByVal fc As IFeatureClass, ByVal oid As Integer, ByVal newGeom As IGeometry)
Dim queryFilter As IQueryFilter = New QueryFilter() With { _
.WhereClause = Convert.ToString(fc.OIDFieldName) & " = " & oid.ToString() _
}

Dim featureCursor As IFeatureCursor = fc.Update(queryFilter, False)
Dim featureToUpdate As IFeature = featureCursor.NextFeature()

featureToUpdate.Shape = newGeom
featureCursor.UpdateFeature(featureToUpdate)
Runtime.InteropServices.Marshal.ReleaseComObject(featureToUpdate)
featureCursor.Flush()
End Sub

--------------------------------------------------------------------------------------------------------------

Function GetArea(ByVal pArea As IArea) As Double
GetArea = pArea.Area
End Function
0 Kudos
23 Replies
NeilClemmons
by
Honored Contributor
‎03-08-2012 12:11 PM
Here's part of the documentation:

http://help.arcgis.com/en/sdk/10.0/arcobjects_net/conceptualhelp/index.html#/Releasing_COM_reference...

And here's the documentation for the ManageLifetime method:

http://help.arcgis.com/en/sdk/10.0/arcobjects_net/componenthelp/index.html#/ManageLifetime_Method/00...

As you can see, it says objects are released during the Dispose process, which I take to mean when they go out of scope or when the ComReleaser itself goes out of scope (i.e. exiting a Using block).  It also states that ReleaseComObject is called until the reference count is 0, which is the same as calling FinalReleaseComObject.  Again, I'm not advising anyone not to use the ComReleaser class, I'm just saying that releasing the objects yourself is one sure-fire way of knowing exactly what your code is doing.

Also, the only time I've ever found I needed to explicitly release anything is when dealing with cursors and feature/row objects.  For everything else I just them go out of scope and be at the mercy of the garbage collector.
0 Kudos
sapnas
by
Frequent Contributor
‎03-08-2012 12:17 PM
... and sometimes a simple SetEmpty method will clear geometries and release memory.
0 Kudos
USFS_AGOLAdministrator
by
Deactivated User
‎03-09-2012 07:23 AM
The system wouldn't let me post my whole code block, so this will be the main code that had the issues.  My next post will be the beginning of the code.



            Try
                ' Using comReleaser As ESRI.ArcGIS.ADF.ComReleaser = New ESRI.ArcGIS.ADF.ComReleaser()
                Dim pFeat As IFeature = Nothing
                Dim pEnumFeat As IEnumFeature = CType(pMap.FeatureSelection, IEnumFeature)
                'Dim pEnumFeat As IEnumFeature = CType(pFLayer.SelectionSet, IEnumFeature)


                pEnumFeat.Reset()
                'Dim pFCur As IFeatureCursor = Nothing
                Dim pSF As ISpatialFilter
                pSF = New SpatialFilter
                Dim pTopoOp As ITopologicalOperator
                Dim pLargestAdj As IFeature = Nothing
                Dim sliverFeat As IFeature = Nothing
                sliverFeat = pEnumFeat.Next

                Do Until sliverFeat Is Nothing
                    'this is really the smallest
                    '---------------------------------------------------------------------
                    pLargestAdj = GetLargestAdjacent(sliverFeat, True, pSF, pFClass)
                    '---------------------------------------------------------------------


                    If Not pLargestAdj Is Nothing Then

                        pTopoOp = CType(pLargestAdj.ShapeCopy, ITopologicalOperator)
                        pLargestAdj.Shape = pTopoOp.Union(sliverFeat.ShapeCopy)


                        updateFeature(m_pFLayer.FeatureClass, pLargestAdj.OID, pLargestAdj.Shape)
                        Marshal.FinalReleaseComObject(pLargestAdj)

                        sliverFeat.Delete()
                        Marshal.FinalReleaseComObject(sliverFeat)

                        GC.Collect()
                        GC.WaitForPendingFinalizers()


                    Else
                        Debug.Print("nothing adjacent to: " & sliverFeat.OID)
                    End If
                    nCurRecNo = nCurRecNo + 1
                    My.ArcMap.Application.StatusBar.Message(0) = nCurRecNo.ToString & "/" & n.ToString & " records complete."
                    Application.DoEvents()

                    sliverFeat = pEnumFeat.Next
                Loop

                'Stop editing and save the edits
                pEditor.StopEditing(True)
                Runtime.InteropServices.Marshal.FinalReleaseComObject(pLargestAdj)
                'End Using

            Catch ex As Exception
                MsgBox("Error: " & ex.StackTrace, , "RElimAddinPB_onClick")
            End Try

            m_gdbPath = ""

            'refresh the selectionset on screen
            Dim pActiveView As IActiveView
            pActiveView = CType(pMap, IActiveView)
            pMxDoc.CurrentContentsView.Refresh(Nothing)
            pActiveView.Refresh()

            'Let the user know it completed successfully
            MsgBox("Complete")
            'Show the user how long it took to process
            Dim tElapsed As TimeSpan = DateTime.Now.Subtract(tStartTime)
            MsgBox(nCurRecNo.ToString + " records in: " + tElapsed.Hours.ToString + " hours " + tElapsed.Minutes.ToString + " minutes " + tElapsed.Seconds.ToString + " seconds.")
            m_pFLayer = Nothing

        Catch ex As Exception
            MsgBox(ex.StackTrace)
            MsgBox(ex.Message)

        End Try
    End Sub
    Function GetLargestAdjacent(ByVal pFeat As IFeature, ByVal getSecondLargest As Boolean, ByVal pSF As ISpatialFilter, ByVal pFC As IFeatureClass) As IFeature
        'MsgBox("in get largest adjacent")
        Try
            Dim pFCur As IFeatureCursor
            pSF.Geometry = pFeat.Shape
            pSF.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects

            'pFcur = pFC.Search(pSF, False)
            pFcur = pFC.Update(pSF, False)

            If pFC.FeatureCount(pSF) < 3 Then
                getSecondLargest = False
            End If

            Using comReleaser As ESRI.ArcGIS.ADF.ComReleaser = New ESRI.ArcGIS.ADF.ComReleaser()

                Dim pFeat2 As IFeature = Nothing, pLargestFeat As IFeature = Nothing
                comReleaser.ManageLifetime(pFeat2)
                comReleaser.ManageLifetime(pFcur)
                Dim dMaxArea As Double = 0
                pFeat2 = pFcur.NextFeature

                Do Until pFeat2 Is Nothing

                    If Not pFeat2 Is pFeat Then
                        If pLargestFeat Is Nothing Then
                            pLargestFeat = pFeat2

                            dMaxArea = GetArea(CType(pFeat2.Shape, IArea))
                            pFcur.Flush()
                            'Runtime.InteropServices.Marshal.FinalReleaseComObject(pLargestFeat)
                        Else
                            If GetArea(CType(pFeat2.Shape, IArea)) > dMaxArea Then
                                pLargestFeat = pFeat2
                                dMaxArea = GetArea(CType(pFeat2.Shape, IArea))
                            End If
                        End If
                    End If

                    pFeat2 = Nothing
                    pFCur.Flush()
                    pFeat2 = pFCur.NextFeature

                Loop

                Marshal.ReleaseComObject(pFcur)
                'comReleaser.Dispose()

                If getSecondLargest Then
                    'pFCur = pFC.Search(pSF, False)
                    'pFcur = m_pFLayer.FeatureClass.Search(pSF, False)
                    pFcur = m_pFLayer.FeatureClass.Update(pSF, False)
                    Dim pSecondLargestFeat As IFeature = Nothing
                    Dim dSecondMaxArea As Double = 0

                    pFeat2 = pFcur.NextFeature
                    Do Until pFeat2 Is Nothing
                        comReleaser.ManageLifetime(pFcur)
                        If Not pFeat2 Is pLargestFeat Then
                            If Not pFeat2 Is pFeat Then
                                If pSecondLargestFeat Is Nothing Then
                                    pSecondLargestFeat = pFeat2
                                    dSecondMaxArea = GetArea(CType(pFeat2.Shape, IArea))
                                Else
                                    If GetArea(CType(pFeat2.Shape, IArea)) > dSecondMaxArea Then
                                        pSecondLargestFeat = pFeat2
                                        dSecondMaxArea = GetArea(CType(pFeat2.Shape, IArea))
                                    End If
                                End If
                            End If
                        End If

                        pFeat2 = pFcur.NextFeature
                        pFcur.Flush()
                    Loop

                    pLargestFeat = pSecondLargestFeat

                End If

                Marshal.ReleaseComObject(pFcur)
                GetLargestAdjacent = pLargestFeat
                'comReleaser.Dispose()

            End Using




        Catch ex As Exception
            MsgBox(ex.Message, , "Ex routine")
            MsgBox(ex.StackTrace, , "Ex routine")
            GetLargestAdjacent = Nothing
        End Try


    End Function
    Private Sub updateFeature(ByVal fc As IFeatureClass, ByVal oid As Integer, ByVal newGeom As IGeometry)
        Dim queryFilter As IQueryFilter = New QueryFilter() With { _
          .WhereClause = Convert.ToString(fc.OIDFieldName) & " = " & oid.ToString() _
        }

        Dim featureCursor As IFeatureCursor = fc.Update(queryFilter, False)
        Dim featureToUpdate As IFeature = featureCursor.NextFeature()
        featureToUpdate.Shape = newGeom
        featureCursor.UpdateFeature(featureToUpdate)

        featureCursor.Flush()
        Marshal.FinalReleaseComObject(featureCursor)
        Marshal.FinalReleaseComObject(featureToUpdate)
        'Marshal.FinalReleaseComObject(fc)


    End Sub
    Function GetArea(ByVal pArea As IArea) As Double
        GetArea = pArea.Area
    End Function
    Protected Overrides Sub OnUpdate()
        Enabled = My.ArcMap.Application IsNot Nothing
    End Sub
End Class
0 Kudos
USFS_AGOLAdministrator
by
Deactivated User
‎03-09-2012 07:27 AM 
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports ESRI.ArcGIS.ADF.BaseClasses
Imports ESRI.ArcGIS.ADF.CATIDs
Imports ESRI.ArcGIS.Framework
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geoprocessing
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Editor
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Catalog
Imports System.Windows.Forms

Public Class RElimAddinPB
    Inherits ESRI.ArcGIS.Desktop.AddIns.Button

    Public Sub New()

    End Sub

    Protected Overrides Sub OnClick()
        Try
            
            'TODO: Add elimSmallest.OnClick implementation
            Dim pMxDoc As IMxDocument = My.ArcMap.Document
            Dim pFrm As frmSelectLayer = New frmSelectLayer
            Dim pFClass As IFeatureClass = Nothing
            Dim pMap As IMap = pMxDoc.FocusMap
            Dim pEnumLayer As IEnumLayer = pMap.Layers
            m_Success = False
            '-------------------------------------------
            'Get the selected layer and selection set from the selected layer's feature class
            '-----------------------------------------------
            Dim pLayer As ILayer = Nothing
            Dim pFLayer As IFeatureSelection = Nothing

            Dim pFCursor As IFeatureCursor = Nothing
            'gp.OverwriteOutput = True

            Dim uid As ESRI.ArcGIS.esriSystem.UID = Nothing
            uid = New UIDClass
            uid.Value = "esriEditor.Editor"
            Dim pEditor As IEditor = Nothing
            pEditor = CType(My.ArcMap.Application.FindExtensionByCLSID(uid), IEditor)

            'Add all the layers in the TOC to the form
            Try
                If pMap.LayerCount = 0 Then
                    Exit Sub
                End If

                pLayer = pEnumLayer.Next

                Do Until pLayer Is Nothing
                    pFrm.cboSelectLayer.Items.Add(pLayer.Name)
                    pLayer = pEnumLayer.Next
                Loop
            Catch ex As Exception
                MsgBox("Error: " & ex.StackTrace)
            End Try

            m_pFLayer = Nothing

            'show the dialog which will allow the user to select a layer
            pFrm.ShowDialog()

            If Not m_Success = True Then
                Exit Sub
            End If

            ' Dim pDS As IDataset
            Dim factoryType As Type = Type.GetTypeFromProgID("esriDataSourcesGDB.FileGDBWorkspaceFactory")
            Dim workspaceFactory As IWorkspaceFactory = CType(Activator.CreateInstance(factoryType), IWorkspaceFactory)
            Dim workspace As IWorkspace = workspaceFactory.OpenFromFile(m_gdbPath, 0) 'm_gdbpath was set in frmSelectLayer

            If workspace Is Nothing Then
                MsgBox("Workspace doesn't exist!", MsgBoxStyle.Information, "RElimAddinPB_OnClick")
                Exit Sub
            End If

            ' Use the IFeatureWorkspace interface to open a feature class.
            Dim featureWorkspace As IFeatureWorkspace = CType(workspace, IFeatureWorkspace)

            'Open the feature class of the copied layer
            Dim featureClass As IFeatureClass = featureWorkspace.OpenFeatureClass(m_strLayerName & "_alt_elim")

            If featureClass Is Nothing Then
                MsgBox(m_gdbPath & "\" & m_strLayerName & "_alt_elim doesn't exist!", MsgBoxStyle.Information, "RElimAddinPB_OnClick")
                Exit Sub
            End If

            'Create new layer of copied layer and add it to arcmap
            Dim pNewFLayer As IFeatureLayer = New FeatureLayer
            pNewFLayer.FeatureClass = featureClass
            pNewFLayer.Name = m_strLayerName & "_alt_elim"

            pMap.AddLayer(pNewFLayer)
            m_pFLayer = pNewFLayer
            pFClass = m_pFLayer.FeatureClass
            'Get a reference to the newly added layer
            pEnumLayer = pMap.Layers
            pLayer = Nothing
            pLayer = pEnumLayer.Next

            Do Until pLayer Is Nothing
                If pLayer.Name = pNewFLayer.Name Then
                    pNewFLayer = CType(pLayer, IFeatureLayer)
                    Exit Do
                End If
                pLayer = pEnumLayer.Next
            Loop

            If Not Right(pNewFLayer.Name, 9) = "_alt_elim" Then
                MsgBox("Alternative Elimination layer not yet created!", MsgBoxStyle.Information, "RElimAddinPB_OnClick")
                m_strLayerName = ""
                m_pFLayer = Nothing
                m_gdbPath = ""
                Exit Sub
            End If

            'do a spatial select to transfer the selection from the original layer to the copied layer
            'Set up the geoprocessor to copy the dataset
            Dim gp As IGeoProcessor = New GeoProcessor
            Dim strParam As IVariantArray = New VarArray
            gp.OverwriteOutput = True
            gp.SetEnvironmentValue("Workspace", m_gdbPath)

            'set the parameters for the copy tool
            strParam.Add(pNewFLayer.Name)
            strParam.Add("ARE_IDENTICAL_TO")
            strParam.Add(m_strLayerName)

            'execute the select by layer tool
            Dim results As IGeoProcessorResult = CType(gp.Execute("SelectLayerByLocation_Management", strParam, Nothing), IGeoProcessorResult)
            If results.Status <> ESRI.ArcGIS.esriSystem.esriJobStatus.esriJobSucceeded Then
                MsgBox("Failed to execute select by layer!", MsgBoxStyle.Information, "frmSelectLayer_btnRun_click")
                results = Nothing
                gp = Nothing
                Exit Sub
            End If
            gp = Nothing

            'My.ArcMap.Application.StatusBar.Message(0) = "Unselecting records from original layer."
            'Application.DoEvents()

            'Now unselect the features fromt the original layer
            Dim ppLayer As ILayer = Nothing
            Dim pFLayerSel As IFeatureSelection = Nothing
            Dim pNewerEnumLayer As IEnumLayer = Nothing
            pNewerEnumLayer = pMap.Layers
            ppLayer = pNewerEnumLayer.Next
            Do Until ppLayer Is Nothing
                If ppLayer.Name = m_strLayerName Then
                    If TypeOf ppLayer Is IFeatureLayer Then
                        pFLayerSel = CType(ppLayer, IFeatureSelection)

                        If pFLayerSel.SelectionSet.Count > 0 Then
                            pFLayerSel.Clear()
                        End If
                    End If
                End If
                ppLayer = pNewerEnumLayer.Next
            Loop

            'Make sure features are selected in the layer
            Dim pWorkspace As IWorkspace2 = Nothing
            Dim pFLDS As IDataset = Nothing

            pFLayer = CType(m_pFLayer, IFeatureSelection)
            If pFLayer.SelectionSet.Count = 0 Then
                MsgBox("No features selected!  Must select features before using this tool", MsgBoxStyle.Information, "RElimAddinPB_OnClick")
                m_strLayerName = ""
                m_pFLayer = Nothing
                m_gdbPath = ""
                Exit Sub
            End If

            pFLDS = CType(pFLayer, IDataset)
            pWorkspace = CType(pFLDS.Workspace, IWorkspace2)
            pEditor.StartEditing(CType(pWorkspace, IWorkspace))

            'Start editing the workspace
            If pEditor.EditState = esriEditState.esriStateNotEditing Then
                pEditor.StartEditing(CType(pWorkspace, IWorkspace))
            End If
            Dim n As Integer
            n = pFLayer.SelectionSet.Count
            Dim nCurRecNo As Integer = 0
            Dim tStartTime As DateTime = Now
0 Kudos