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

基本思想：求取地块中心点，以中心点向正南正北正西正东发送射线，求取与四条线相交的四个地块即为四至地块Private Sub CommandButton1_Click()Dim pMxDoc As IMxDocument 代表本文档数据Dim pMap As IMap 代表激活的地图Dim pFeaLayer As IFeatureLayer 代表地图中的图层，这里仅有一个Dim pFeaClass As IFeatureClass 代表图层中的要素类数据Dim pQueryF1 As IQueryFilter 查询条件1Dim pQueryF2 As IQueryFilter 查询条件2Dim 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 IGeometryDim pPoColl As IPointCollectionDim 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 = ThisDocumentSet pMap = pMxDoc.FocusMapSet pFeaLayer = /doc/7548681027d3240c8447efb6.html yer(0)Set pFeaClass = pFeaLayer.FeatureClassSet pQueryF1 = New QueryFilterSet pQueryF2 = New QueryFilterpQueryF1.WhereClause = 村组 + 110Set pFeaCursor1 = pFeaClass.Search(pQueryF1, False)此为检索 Set pFeaCursor1 = pFeaClass.Update(pQueryF1, False) 此为更新Set pFeature1 = pFeaCursor1.NextFeatureSet pPoint = New Point 中心点对象实例化Set pDPoint = New Point 交点对象实例化 Set pXPoint = New Point 交点对象实例化 Set pNPoint = New Point 交点对象实例化 Set pBPoint = New Point 交点对象实例化Set pDLine = New Polyline 交线对象实例化 Set pXLine = New Polyline 交线对象实例化 Set pNLine = New Polyline 交线对象实例化 Set pBLine = New Polyline 交线对象实例化 Set pTempLine = New PolylineDo While Not pFeature1 Is Nothing求取中点Set pArea = pFeature1.ShapepArea.QueryCentroid pPoint延长线pDPoint.PutCoords pPoint