GIS VBA 结合ArcMap工具创建界址线

江苏省地质测绘院 姜法明

本文介绍ArcMap VBA二次开发创建界址线的方法，宗地图层（面要素）有6426个宗地（要素），通过面转线得到权属线23006条，利用二次开发程序把权属线转为界址线，生成界址线 397722 条。

1打开宗地图层

2【ArcToolbok】-【数据管理工具】-【要素】-【面转线】

3

权属线是二个宗地的公共部份，私下条权属线中包含多条界址线。如上图所示，生成的权属线的属性表中，有左、右宗地的FID号，通过FID号，可以获取面要素的宗地号。

利用IFeatureWorkspace接口的CreateFeatureClass方法创建界址点Shape文件需要5个参数：

目录：利用IWorkspace接口 的PathName属性获取宗地图层的路径。

文件名：”888888JZX”

类型：esriGeometryPolyline

空间参考：利用ISpatialReference接口获取宗地图层的空间参考

字段清单：准备好的文本文件，文件内容如下：

每一行数据分别是：序号、字段名、字段类型、字段长度、字段精度（小数位数）。

利用IMxDocument接口的IMaps的AddLayer方法加载新建的界址线图层。

利用IFeatureCursor接口的Insertfeature方法创建界址点要素 。

附：核心源代码

'权属线 23006 条，生成界址线 397722 条，运行36分钟。
Public Sub 权属线To界址线()
'访问数据集的变量
Dim 权属线  As IFeatureClass, 权属线表名 As String
Dim 界址线  As IFeatureClass, 界址线表名 As String
Dim 宗地表  As IFeatureClass, 宗地表名 As String
Dim pFeatureCursor As IFeatureCursor       '记录集
Dim pFeature As IFeature                   '记录
Dim mFeature As IFeature                   '记录
'创建线要素的变量
Dim pLine As IPolyline                     '线对象
Dim pPointCol1 As IPointCollection         '点的集合
Dim pts        As IPointCollection
Dim pPoint1    As IPoint                   'Path 的 Point（组成路线的点）
Dim pPoint2    As IPoint                   'Path 的 Point（组成路线的点）
Dim 记录编号 As Long, N As Long
Dim 左宗地 As String, 右宗地 As String, 宗地号 As String
Dim s As Double
On Error Resume Next
权属线表名 = "340523QSX"
界址线表名 = "340523JZX"
宗地表名 = "340523NewZD"
Set 权属线 = 表名打开图层(权属线表名)
Set 界址线 = 表名打开图层(界址线表名)
Set 宗地表 = 表名打开图层(宗地表名)
If 权属线 Is Nothing Or 界址线 Is Nothing Or 宗地表 Is Nothing ThenMsgBox ("打开记录集失败！！")Exit Sub
End If
Debug.Print Now
Call 开始编辑(界址线)Set pFeatureCursor = Nothing
Set pFeatureCursor = 权属线.Update(Nothing, False)
Set pFeature = pFeatureCursor.NextFeature
Do While Not pFeature Is Nothing宗地号 = ""N = pFeature.Value(2)If N >= 0 ThenSet mFeature = 宗地表.GetFeature(N)宗地号 = Left(mFeature.Value(3), 19)End IfN = pFeature.Value(3)If N >= 0 ThenSet mFeature = 宗地表.GetFeature(N)宗地号 = IIf(宗地号 = "", Left(mFeature.Value(3), 19), 宗地号 + "\" + Left(mFeature.Value(3), 19))End IfSet pLine = pFeature.ShapeSet pPointCol1 = pLineFor N = 0 To pPointCol1.PointCount - 2Set pPoint1 = pPointCol1.point(N)Set pPoint2 = pPointCol1.point(N + 1)'定义并初始化一个线对象Dim PlyLine As IPolylineSet PlyLine = New PolylineSet pts = PlyLine    '点集合=线pts.AddPoint pPoint1pts.AddPoint pPoint2s = PlyLine.LengthDim 属性表(12) As Variant属性表(2) = 1                                                '2,"BSM",标设码,int,10(>0)属性表(3) = 宗地号                                           '3,"ZDZHDM",宗地代码,Varchar(50位)属性表(4) = "3001060000"                                     '4,"YSDM",要素代码,Char,10(6011060000)属性表(5) = s                                                '5,"JZXCD",界址线长度,Float,15,2(>0)属性表(6) = "7"                                              '6,"JZXLB",界址线类别,Char ,2(7:两点边线)属性表(7) = "2"                                              '7,"JZXWZ",界址线位置,Char,1(2:中)属性表(8) = "600001"                                         '8,"JXXZ",界结性质,Char,6(600001:已定界)属性表(9) = "321456789gfhtt"                                 '9,"QSJXXYSBH",权属界线协议书编号,Char,30属性表(10) = "gfhni987562fgmif999ht"                         '10,"QSJXXYS",权属界线协议书,Varbin'属性表(11) = 0                                             '11,"QSZYYYSBH",权属争议原由书编号,Char,30'属性表(12) = 0                                             '12,"QSZYYYS",权属争议原由书,VarbinIf s > 0.001 Then 记录编号 = AddFeature(界址线, PlyLine, 属性表)NextSet pFeature = pFeatureCursor.NextFeature
Loop
Call 停止编辑(界址线)
Debug.Print Now
Debug.Print 记录编号
MsgBox ("恭喜你，完成了！")
End Sub