基于ArcGISVBA的宗地四至生成法3.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 pPoint As IPoint 存储对象中心点 Dim pArea As IArea 求取中心点辅助变量 Dim pPoint2 As IPoint 求取对象2的中心点 Dim pArea2 As IArea 求取对象2的中心点 Dim pLineFea1 As IPolyline Dim pLine As IPolyline Dim pPoly As IPolygon Dim pPoColl As IPointCollection Dim sSizhi(4) As String 存储宗地四至信息 sSizhi(0) = 荒地 东至 sSizhi(1) = 荒地 西 sSizhi(2) = 荒地 南 sSizhi(3) = 荒地 北 Dim dSizhi(4) As Double 存储宗地四至坐标 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 = 权利人= + 黄永和 重置一次循环对象集，实验 Set pFeaCursor1 = pFeaClass.Search(pQueryF1, False) Set pFeaCursor1 = pFeaClass.Update(pQueryF1, False) Set pFeaCursor1 = pFeaClass.Update(Nothing, False) Set pFeature1 = pFeaCursor1.NextFeature Set pPoint = New Point 中心点对象实例化 Set pPoint2 = New Point 中心点2对象实例化 Set pLineFea1 = New Polyline Set pLine = New Polyline ----------------------------------------------------------------------------------------------- Dim lNumFeat As Long lNumFeat = pFeaClass.FeatureCount(Nothing) Dim lNumNow As Long lNumNow = 0 -------