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

1基本思想：求取地块屮心点，以屮心点14正南正北正西正东发送射线，求取与四条线相交 的四个地块即为四至地块 Private Sub CommandButtonl_Click() Dim pMxDoc As IMxDocument Dim pMap As IMap Dim pFeaLayer As IFeatureLayer Dim pFeaClass As IFeatureClass ’代表本文档数据 *代表激活的地图 1代表地阁屮的阁层，这里仅有一个 ’代表图层中的要素类数据 Dim pQueryFl As IQueryFilter Dim pQueryF2 As IQueryFilter ?查询条件1 ?查询条件2 Dim pFeaCursorl As IFeatureCursor Dim pFeaCursor2 As IFeatureCursor Dim pFeaturel As IFeature Dim pFeature2 As IFeature 1要素游标1，提取要素数据使用 1要素游标2,提取要素数据使用 ’要素1对应变量 1要素2对应变量 Dim pRelation As IRelationalOperator ?空间关系分析使用 Dim pTopo As ITopologicalOperator 求交空间分析使川 Dim pPoint As IPoint Dim pArea As lArea Dim plntersectGeo 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 ’ ’东至水平线 1两至水平线 1南至水平线 1北至水平线 Dim pDPoint As IPoint Dim pXPoint As IPoint Dim pNPoint As IPoint Dim pBPoint As IPoint 东至交点 ?西至交点 南至交点 1北至交点 Dim Sizhi(4) As String Sizhi(O) = ■■暂无，. Sizhi(l) = 暂无 Sizhi(2 = 暂无 Sizhi(3) = 暂无n 1存储宗地叫至信息 On Error GoTo ErrorHandler Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap Set pFeaLayer = pMap.Layer(O) Set pFeaClass = pFeaLayer.FeatureClass Set pQueryFl = New QueryFilter Set pQueryF2 = New QueryFilter pQueryFl.WhereClause =村组 ■ + 110 … Set pFeaCursorl = pFeaClass.Search(pQueryFlz False)?此为检索 Set pFeaCursorl = pFeaClass.Update(pQueryFl, False)1 此为更新 中心点对象实例化交点对象实例化 交点对象实例化 1 中心点对象实例化 交点对象实例化 交点对象实例化 1交点对象实例化 交点对象实例化 交线对象实例化 交线对象实例化 *交线对象实例化 1交线对象实例化 Set 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 Polyline Do While Not pFeaturel Is Nothing 1求取中点 Set pArea = pFeaturel.Shape pArea.QueryCentroid pPoint 1延长线 pDPoint.PutCoords pPoint.X + 10000, pPoint.Y pXPoint.PutCoords pPoint.X ? 10000, pPoint.Y pNPoint.PutCoords pPoint.X, pPoint.Y -100