基于arcgis8.x的代码,使用方法:在vba里面使用

	
Option Explicit

		Sub Test()

		    Dim pMxDoc As IMxDocument

		    Set pMxDoc = ThisDocument

		    

		    SelectPoints pMxDoc.FocusMap.Layer(0)

		    

		    ' refresh the selection screen cache

		    Dim pAV As IActiveView

		    Set pAV = pMxDoc.FocusMap

		    Dim lCacheID As Long

		    lCacheID = pAV.ScreenCacheID(esriViewGeoSelection, Nothing)

		    pAV.ScreenDisplay.Invalidate Nothing, True, lCacheID

		

		End Sub

		

		Sub SelectPoints(pFLayer As IFeatureLayer)

		    Dim lOIDs() As Long, lCount As Long

		    QueryPoints pFLayer.FeatureClass, lOIDs, lCount

		    

		    Dim pFSel As IFeatureSelection

		    Set pFSel = pFLayer

		    pFSel.Clear

		    If lCount > 0 Then

		        pFSel.SelectionSet.AddList lCount, lOIDs(0)

		    End If

		End Sub

		

		Sub QueryPoints(pFC As IFeatureClass, lOIDs() As Long, _

		                ByRef lCount As Long)

		    '

		    ' sets an array of OID's with features that are intersected

		    ' by a feature in the same featureclass with a smaller OID

		    '

		    Dim pFI2 As IFeatureIndex2

		    Set pFI2 = New FeatureIndex

		    

		    Set pFI2.FeatureClass = pFC

		    Dim pGDS As IGeoDataset

		    Set pGDS = pFC

		    pFI2.Index Nothing, pGDS.Extent

		    Debug.Print "index built"

		    Dim pIQ2 As IIndexQuery2

		    Set pIQ2 = pFI2

		    

		    Dim pFCur As IFeatureCursor

		    Set pFCur = pFC.Search(Nothing, False)

		    

		    Dim pDict As Scripting.Dictionary

		    Set pDict = New Scripting.Dictionary

		    

		    Dim pFeat As IFeature, l As Long, vOID As Variant, sMsg As String

		    Set pFeat = pFCur.NextFeature

		    Dim vIntersects As Variant

		    Do Until pFeat Is Nothing

		        pIQ2.IntersectedFeatures pFeat.Shape, vIntersects

		        If UBound(vIntersects) > 0 Then

		            For Each vOID In vIntersects

		                If vOID > pFeat.OID Then

		                    If Not pDict.Exists(CStr(vOID)) Then

		                        pDict.Add CStr(vOID), 0

		                    End If

		                End If

		            Next vOID

		        End If

		        Set pFeat = pFCur.NextFeature

		        l = l + 1

		        If l Mod 100 = 0 Then

		            sMsg = l & " rows processed, pointcount: " & pDict.Count

		            Application.StatusBar.Message(0) = sMsg

		            Debug.Print sMsg

		        End If

		    Loop

		    

		    ' load the array

		    l = 0

		    If pDict.Count > 0 Then

		        ReDim lOIDs(pDict.Count - 1)

		        For Each vOID In pDict.Keys

		            lOIDs(l) = CLng(vOID)

		            l = l + 1

		        Next vOID

		    End If

		    lCount = pDict.Count

		End Sub