基于ArcGIS VBA的宗地四至生成法2.doc

'基本思想:求取地块中心点,以中心点向正南正北正西正东发送射线,求取与四条线相交的四个地块即为四至地块
Private mandButton1_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 =
Set pFeaLayer = (0)
Set pFeaClass =
Set pQueryF1 = New QueryFilter
Set pQueryF2 = New QueryFilter
= "村组<>'" + "110'"
'Set pFeaCursor1 = (pQ