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

江苏省地质测绘院 姜法明

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

1. 面转线

1打开宗地图层

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

 

3

 

 

 

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

2.创建界址线图层

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

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

文件名：”888888JZX”

类型：esriGeometryPolyline

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

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

 

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

3.加载Shape文件

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

4.创建界址线要素

利用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 Then
    MsgBox ("打开记录集失败！！")
    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 Then
        Set mFeature = 宗地表.GetFeature(N)
        宗地号 = Left(mFeature.Value(3), 19)
    End If
    
    N = pFeature.Value(3)
    If N >= 0 Then
        Set mFeature = 宗地表.GetFeature(N)
        宗地号 = IIf(宗地号 = "", Left(mFeature.Value(3), 19), 宗地号 + "\" + Left(mFeature.Value(3), 19))
    End If
        
    Set pLine = pFeature.Shape
    Set pPointCol1 = pLine
    For N = 0 To pPointCol1.PointCount - 2
        Set pPoint1 = pPointCol1.point(N)
        Set pPoint2 = pPointCol1.point(N + 1)
        '定义并初始化一个线对象
        Dim PlyLine As IPolyline
        Set PlyLine = New Polyline
        Set pts = PlyLine    '点集合=线
        pts.AddPoint pPoint1
        pts.AddPoint pPoint2
        s = PlyLine.Length

        Dim 属性表(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",权属争议原由书,Varbin
        
        If s > 0.001 Then 记录编号 = AddFeature(界址线, PlyLine, 属性表)
    Next
    Set pFeature = pFeatureCursor.NextFeature
Loop
Call 停止编辑(界址线)
Debug.Print Now
Debug.Print 记录编号
MsgBox ("恭喜你，完成了！")
End Sub