基于ArcGISVBA的宗地四至生成法2.docVIP

基本思想：求取地块中心点，以中心点向正南正北正西正东发送射线，求取与四条线相交的四个地块即为四至地块 Private Sub CommandButton1_Click() Dim pMxDoc As IMxDocument 代表本文档数据 Dim pMap As IMap 代表激活的地图 Dim pFeaLayer As IFeatureLayer 代表地图中的图层，这里仅有一个 Dim pFeaClass As IFeatureClass 代表图层中的要素类数据 Dim pQueryF1 As IQueryFilter 查询条件1 Dim pQueryF2 As IQueryFilter 查询条件2 Dim pFeaCursor1 As IFeatureCursor 要素游标1，提取要素数据使用 Dim pFeaCursor2 As IFeatureCursor 要素游标2，提取要素数据使用 Dim pFeature1 As IFeature 要素1对应变量 Dim pFeature2 As IFeature 要素2对应变量 Dim pRelation As IRelationalOperator 空间关系分析使用 Dim pTopo As ITopologicalOperator 求交空间分析使用 Dim pPoint As IPoint 存储对象中心点 Dim pArea As IArea 求取中心点辅助变量 Dim pIntersectGeo As IGeometry Dim pPoColl As IPointCollection Dim pDLine As IPolyline 东至水平线 Dim pXLine As IPolyline 西至水平线 Dim pNLine As IPolyline 南至水平线 Dim pBLine As IPolyline 北至水平线 Dim pTempLine As IPolyline ------------------- Dim pDPoint As IPoint 东至交点 Dim pXPoint As IPoint 西至交点 Dim pNPoint As IPoint 南至交点 Dim pBPoint As IPoint 北至交点 Dim Sizhi(4) As String 存储宗地四至信息 Sizhi(0) = 暂无 Sizhi(1) = 暂无 Sizhi(2) = 暂无 Sizhi(3) = 暂无 On Error GoTo ErrorHandler: Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap Set pFeaLayer = pMap.Layer(0) Set pFeaClass = pFeaLayer.FeatureClass Set pQueryF1 = New QueryFilter Set pQueryF2 = New QueryFilter pQueryF1.WhereClause = 村组 + 110 Set pFeaCursor1 = pFeaClass.Search(pQueryF1, False)此为检索 Set pFeaCursor1 = pFeaClass.Update(pQueryF1, False) 此为更新 Set pFeature1 = pFeaCursor1.NextFeature Set pPoint = New Point 中心点对象实例化 Set pDPoint = New Point 交点对象实例化 Set pXPoint = New Point 交点对象实例化 Set pNPoint = New Point 交点对象实例化 Set pBPoint = New Point 交点对象实例化 Set pDLine = New Polyline