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