Thursday, May 21, 2009

IProximity Interface Example code

Private Sub GetNearestPoint()
Dim pPoint As IPoint
Dim pProximity As IProximityOperator
Dim pGeom As IGeometry
Dim pFeature As IFeature, pTestFeature As IFeature, pPointFeature As IFeature
Dim tempDist As Double, searchDist As Double, testDistance As Double, pointTestDistance As Double
Dim pFeatureClass As IFeatureClass
Dim pQueryFilter As IQueryFilter
Dim pFeatureCursor As IFeatureCursor
Dim iCount As Integer
Dim iDescription As Long, iOID As Long
Dim sClosest As String

On Error GoTo ErrorHandler
sClosest = "Nothing Found"
pointTestDistance = -1
testDistance = -1
searchDist = 500
iCount = 0

Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass("ALL_CITIES")
Set pQueryFilter = New QueryFilter
'Get the search point
pQueryFilter.WhereClause = "WHERE OBJECTID = 23746"
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
iDescription = pFeatureCursor.FindField("LOC_DESC")
iOID = pFeatureCursor.FindField("OBJECTID")

Set pTestFeature = pFeatureCursor.NextFeature
Debug.Print "?" & pTestFeature.Value(iOID) & " " & pTestFeature.Value(iDescription)
Set pPoint = pTestFeature.Shape
Set pProximity = pPoint

'Get the search data
pQueryFilter.WhereClause = "WHERE CNTRY = 'XX' and OBJECTID <> 23746"
Set pFeatureCursor = Nothing
Set pTestFeature = Nothing
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
Set pTestFeature = pFeatureCursor.NextFeature

Debug.Print "START****" & Time
Do While (Not pTestFeature Is Nothing)
Set pGeom = pTestFeature.Shape
tempDist = pProximity.ReturnDistance(pGeom)
If (tempDist < searchDist) Then
If (pointTestDistance < 0) Then pointTestDistance = tempDist + 1
If (tempDist < pointTestDistance Or pointTestDistance = -1) Then
sClosest = pTestFeature.Value(iOID) & " " & pTestFeature.Value(iDescription) & " " & " [" & tempDist & "]"
Debug.Print sClosest
pointTestDistance = tempDist
Set pPointFeature = pTestFeature
End If
End If
iCount = iCount + 1
Set pTestFeature = pFeatureCursor.NextFeature
Loop
Debug.Print "END****" & Time
Debug.Print "Records parsed: " & iCount
Debug.Print "Closest Point: " & sClosest
Debug.Print "===================================================="
Exit Sub
ErrorHandler:
MsgBox "An unexpected error has occured in GetNearestPoint." & vbCr & vbCr & _
"Details : " & Err.Description, vbExclamation + vbOKOnly, "Error"
End Sub

No comments:

Post a Comment