ArcGIS 空间查询

Private Sub CB_Search_Click()
    
    '加宽FORM窗口
    If infofrm.Width = 185 Then
        infofrm.Width = 442
    End If
    
    Dim pMxDocument As IMxDocument
    Dim pMap As IMap
    Dim pActView As IActiveView
    
    Set pMxDocument = ThisDocument
    Set pMap = pMxDocument.FocusMap
    Set pActView = pMxDocument.ActiveView
    
    Dim pPointX As Double
    Dim pPointY As Double
    
    On Error GoTo ErrorHandler:

    pPointX = Right(lrtstoplist.List(12), Len(lrtstoplist.List(12)) - 12) / 1000000
    pPointY = Right(lrtstoplist.List(13), Len(lrtstoplist.List(13)) - 11) / 1000000
    Dim pPoint As IPoint
    Set pPoint = New Point
    pPoint.X = pPointX
    pPoint.Y = pPointY
    
    
    '定义矩形进行空间查询
    Dim player As ILayer
    Dim pflayer As IFeatureLayer
    Dim pFClass As IFeatureClass
    Dim pSpaFilter As ISpatialFilter
    Dim pFSelection As IFeatureSelection
    Dim pSelSet As ISelectionSet
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeature As IFeature
   
    '200米地理距离换算成像素距离
    Dim dDistance As Double
    Dim pUnitConverter  As IUnitConverter
    Set pUnitConverter = New UnitConverter
    dDistance = pUnitConverter.ConvertUnits(200, esriMeters, esriDecimalDegrees)
    
    'Dim CreateEnvXY As IEnvelope  '矩形
    '以鼠标单击点为中心，边长6像素 创建矩形
    'Set CreateEnvXY = New esriGeometry.Envelope
    'CreateEnvXY.PutCoords pPointX - dDistance, pPointY - dDistance, pPointX + dDistance, pPointY + dDistance
      
    '以pPoint为圆心，dDistance为半径画圆
    Dim pCreateCircle As IConstructCircularArc
    Dim pCArc As ICircularArc
    Set pCreateCircle = New CircularArc
    Set pCArc = pCreateCircle
    pCreateCircle.ConstructCircle pPoint, dDistance, True
    
    Dim pSeg As ISegment
    Dim pSegcoll As ISegmentCollection
    Dim pring As IRing
    Dim pGeomColl As IGeometryCollection
      
    Set pSeg = pCArc
    Set pSegcoll = New Ring
    pSegcoll.AddSegment pSeg
    Set pring = pSegcoll
    Set pGeomColl = New Polygon
    pGeomColl.AddGeometry pring
  
    '空间查询
    Set player = pMap.Layer(2)
    Set pflayer = player       'QI
    Set pFSelection = pflayer
    Set pFClass = pflayer.FeatureClass
    Set pSpaFilter = New SpatialFilter
    Set pSpaFilter.Geometry = pGeomColl
        pSpaFilter.SpatialRel = esriSpatialRelContains
        pFSelection.SelectFeatures pSpaFilter, esriSelectionResultNew, False
    Set pSelSet = pFSelection.SelectionSet
        
    '显示查询的公交车站信息
    infofrm.gongjiaolistbox.Clear  '清空ListBox数据
    infofrm.gongjiaolistbox.ForeColor = &H80000012
    If pSelSet.Count < 1 Then
        infofrm.gongjiaolistbox.AddItem ""
        infofrm.gongjiaolistbox.AddItem "没有符合条件的公交站点！"
        infofrm.gongjiaolistbox.ForeColor = &HFF&
        Exit Sub
    End If
    
    Dim pfields As IFields
    Set pfields = pFClass.Fields
    Dim i As Integer
    Dim selindex As Integer
    Dim pfield As IField
    pSelSet.Search Nothing, False, pFeatureCursor
    Set pFeature = pFeatureCursor.NextFeature

    For selindex = 1 To pSelSet.Count
        For i = 0 To pfields.FieldCount - 1
            Set pfield = pfields.Field(i)
            If pfield.Type <> esriFieldTypeGeometry And pfield.Type <> esriFieldTypeBlob Then
                infofrm.gongjiaolistbox.AddItem pfield.Name & "—>" & pFeature.Value(i)
            End If
        Next
        infofrm.gongjiaolistbox.AddItem "================================"
        Set pFeature = pFeatureCursor.NextFeature
    Next
    
    pActView.Refresh
    
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
    
End Sub