ArcGIS 空间查询

来源:互联网 时间:1970-01-01

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 SubErrorHandler: MsgBox Err.Description End Sub


相关阅读:
Top