ArcObjects VBA. Error 0x80040239 : Using the intersect method of ItopologicalOperator

0

I have an issue when using a "itopologicaloperator.intersect" method in a "loop for" with many iterations. It seems that GC don't delete the local variables and the program crash with

"Run Time Error -2147220935(80040239) Automation Error".

This is the Function that Crash at intersect method when is called a lot of times in a "loop for"

Public Function Ley_Atenuacion4(centroid_x As Variant, centroid_y As Variant, vector_Zones1() As IFeature, numberOfFeatures_Zone1 As Long) As Double

Dim pila_log_aceleracion_cero As Double
Dim pila_Coef_r_d As Double
Dim pila_Coef_h_d As Double
Dim distancia As Double

Dim Zonej As Long

Dim P1 As IPoint
Dim P2 As IPoint
Dim Edificio As IPoint
Dim Epicentro As IPoint

Set P1 = New point
Set P2 = New point
Set Edificio = New point
Set Epicentro = New point

Epicentro.PutCoords SISMO_x, SISMO_y
Edificio.PutCoords centroid_x, centroid_y

Dim pilaZone_Feature As IFeature

Dim pRelOperator As IRelationalOperator
Dim pLine As IPointCollection
Set pLine = New polyline
Dim pLine2 As iPolyline
pLine.AddPoint Epicentro
pLine.AddPoint Edificio
Set pLine2 = pLine

Dim distancia_Epi As Double
distancia_Epi = pLine2.Length / 1000 

Dim pTopologicalOperator As ITopologicalOperator4
Dim pGeometryCollection As IGeometryCollection
Dim pPointCollection As IPointCollection

For j = 0 To numberOfFeatures_Zone1 - 1
    Set pilaZone_Feature = vector_Zones1(j)
    Zonej = pilaZone_Feature.OID
    Set pRelOperator = pilaZone_Feature.ShapeCopy

    Set pTopologicalOperator = pilaZone_Feature.ShapeCopy
    Set pGeometryCollection = pTopologicalOperator.Intersect(pLine2, esriGeometry1Dimension)

    If pGeometryCollection.GeometryCount = 0 Then
        GoTo nextZone
    End If

    For i = 0 To pGeometryCollection.GeometryCount - 1
        Set pPointCollection = pGeometryCollection.Geometry(i)

        Set P1 = pPointCollection.point(0)
        Set P2 = pPointCollection.point(1)

        If pRelOperator.Relation(Epicentro, "dim(g1,g2)!=null") Then 
            pila_log_aceleracion_cero = log_aceleracion_cero(Zonej)
        End If

        distancia = Sqr((P1.x - P2.x) ^ 2 + (P1.y - P2.y) ^ 2) / 1000 
        pila_Coef_r_d = pila_Coef_r_d + Coef_r_d(distancia, Zonej)
        pila_Coef_h_d = pila_Coef_h_d + Coef_h_d(distancia, Zonej)

    Next i
nextZone:
Next j

Dim r As Double
r = Sqr(distancia_Epi ^ 2 + (pila_Coef_h_d / distancia_Epi) ^ 2)

Ley_Atenuacion4 = pila_log_aceleracion_cero + pila_Coef_r_d / distancia_Epi * Log(r) / Log(10) + Log(980) / Log(10) 


End Function

It looks like Garbage Collector don't release the local variables of this function due to its very busy in the "loop for". The "loop for" that calls the function its a raster editing.

I think that there is no circular reference in the code. How can I solve this memory leak? Thanks

vba
asked on Stack Overflow Aug 21, 2017 by Fernando Lopez • edited Aug 21, 2017 by Saurabh Bhandari

0 Answers

Nobody has answered this question yet.


User contributions licensed under CC BY-SA 3.0