浅析VB语言在地籍测绘调查中的应用

吕永杰

【摘  要】VB语言可以实现应用软件的转化也可以实现应用软件的批量改正，极大地提高了地籍测绘调查成果的转化和改正效率，为大批量的数据应用提供了可行的方法。

【Abstract】VB language can realize the transformation of application software and batch correction of application software， which greatly improves the efficiency of transformation and correction of the results of cadastral surveying， mapping and investigation， and provides a feasible method for mass data application.

【关键词】VB语言;地籍测绘;地籍调查

【Keywords】VB language; cadastral surveying and mapping; cadastral investigation

【中图分类号】P272;TP312                               【文献标志码】A                                   【文章编号】1673-1069（2020）05-0191-03

1 引言

地籍测绘调查是不动产登记中最基础的部分，是反映不动产的核心成果。VB语言可以实现在地籍测绘调查中宗地图的批量修改、PDF输出以及房屋的批量转化。本文结合具体实例，介绍了VB语言在地籍测绘调查中的具体应用，以期方便快捷地实现批量改正及转化。

2 VB语言简介

Visual Basic（以下简称VB）是一种通用的基于对象的程序设计语言，以结构化的、模块化的、面向对象的、包含协助开发环境的事件驱动为机制的可视化程序设计语言。

VB语言便于程序员使用，可以简单建立应用程序的GUI系统，同时，又可以开发相当复杂的程序。VB语言具有以下几个特点：可视化的设计平台、事件驱动的编程机制、结构化的程序设计语言、强大的数据库功能。

3 VB语言在地籍测绘调查中的实例应用

VB語言既可以实现应用软件的转化又可以实现应用软件的批量改正。应用转化软件可以通过VB语言实现多种软件之间的转化，如CAD图形可以通过PDF转化软件实现转换。VB语言也可以实现宗地图的批量改正，可以极大地提高工作效率和质量。下面通过实例来说明CAD图形转换为PDF、宗地图的批量改正，具体分析VB语言在地籍测绘调查中的应用。

①CAD图形转换为PDF，单宗输出

Sub 单宗输出PDF（）

Dim strPath As String

Dim Message， Title， Default As String

Message = "输入宗地文件夹所在地址，仅保留个人宗地文件"

Title = "地址输入框"    ' 设置标题。

Default = "D：＼CADVBA＼SFDFAS"    ' 设置缺省值。

' 显示信息、标题及缺省值。

strPath = InputBox（Message， Title， Default）

Call FindPathdanzongPDF（strPath）

End Sub

②宗地图的批量改正

Sub 修改宗地图（）

Dim xuhao， ID， biaoshi， kong， jiushuju， xinshuju As String

Dim zongdihao， zongdihao2 As String

Dim y， x As Integer

Dim guding1， guding2 As AcadText

y = 0

x = 1

Dim returnObj As AcadObject

Dim wenjianming As String

wenjianming = InputBox（"请输入文件路径"， "改坐标生成文件输入框"， "路径"）

Close #1

Close #2

If wenjianming = "" Then

MsgBox "空文件"

End

Else

Open wenjianming + "＼1.csv" For Input As #1

End If

Open wenjianming + "＼2.txt" For Output As #2   ' 打开文件。

Dim cunwenjianjia As String

cunwenjianjia = InputBox（"路径"， "要修改宗地图文件夹"， "路径"）

Do While Not EOF（1）

Input #1， xuhao， ID， biaoshi， zongdihao， kong， jiushuju， xinshuju

If ID = "OID" Then GoTo line1

Debug.Print xuhao， ID， biaoshi， zongdihao， kong， jiushuju， xinshuju

If zongdihao2 <> CStr（zongdihao） Then

''找到宗地文件夹及调查数据成果

Dim s， zongditupath As String

s = wenjianjialujing（cunwenjianjia， CStr（zongdihao））

zongditupath = s & "＼调查数据成果＼ZDT.dwg"

If zongdihao2 = "" Then ''第一张图宗地号二等于""，不能关闭当前图形

ThisDrawing.Application.Documents.Open （zongditupath）

Else

ThisDrawing.Application.ActiveDocument.Save

'                 Print #2， x， CInt（xuhao） - 1， biaoshi， zongdihao2

'                 x = x + 1

ThisDrawing.Application.ActiveDocument.Close

ThisDrawing.Application.Documents.Open （zongditupath）

End If

''创建选择集

Dim tucengSS As AcadSelectionSet

Dim wenziSS As AcadSelectionSet

''图层选择集

'           Set tucengSS = ThisDrawing.SelectionSets.Add（"tucengSS"）

'           If Err Then Set tucengSS = ThisDrawing.SelectionSets.Add（"tucengSS"）

'           tucengSS.Clear

''文字选择集

Set wenziSS = ThisDrawing.SelectionSets.Add（"wenziSS"）

If Err Then Set wenziSS = ThisDrawing.SelectionSets.Add（"wenziSS"）

wenziSS.Clear

On Error Resume Next

Dim gpCode（0） As Integer

Dim dataValue（0） As Variant

gpCode（0） = 0

dataValue（0） = "Text"

Dim groupCode As Variant， dataCode As Variant

groupCode = gpCode

dataCode = dataValue

wenziSS.Select acSelectionSetAll， ， ， groupCode， dataCode

'文字替換

Dim tihuan As AcadText

If biaoshi = "ZD" Then

For Each tihuan In wenziSS

With tihuan

If InStr（.TextString， jiushuju） Then

.TextString = Replace（.TextString， jiushuju， xinshuju）

Print #2， CInt（xuhao）， biaoshi， zongdihao

Exit For

End If

End With

Next tihuan

ElseIf biaoshi = "JZX" Then

For Each tihuan In wenziSS

If tihuan.TextString = jiushuju Then

y = y + 1

Set guding1 = tihuan

End If

Next tihuan

If y = 1 Then

guding1.TextString = xinshuju

Print #2， CInt（xuhao）， biaoshi， zongdihao

y = 0

ElseIf y > 1 Then

ThisDrawing.Application.ZoomExtents

MsgBox "修改" & jiushuju

ThisDrawing.Utility.GetEntity returnObj， basePnt，

If returnObj.EntityName = "AcDbText" Then

Set guding2 = returnObj

guding2.TextString = xinshuju

Print #2， CInt（xuhao）， biaoshi， zongdihao

'                      ThisDrawing.Application.ActiveDocument.Saved

End If

y = 0

End If

End If

'         Dim zongditupath2 As String

zongditupath2 = zongditupath

zongdihao2 = zongdihao

Else

If biaoshi = "ZD" Then

For Each tihuan In wenziSS

With tihuan

If InStr（.TextString， jiushuju） Then

.TextString = Replace（.TextString， jiushuju， xinshuju）

Print #2， CInt（xuhao）， biaoshi， zongdihao

Exit For

End If

End With

Next tihuan

ElseIf biaoshi = "JZX" Then

For Each tihuan In wenziSS

If tihuan.TextString = jiushuju Then

y = y + 1

Set guding1 = tihuan

End If

Next tihuan

If y = 1 Then

guding1.TextString = xinshuju

Print #2， CInt（xuhao）， biaoshi， zongdihao

y = 0

ElseIf y > 1 Then

ThisDrawing.Application.ZoomExtents

MsgBox "修改" & jiushuju

ThisDrawing.Utility.GetEntity returnObj， basePnt，

If returnObj.EntityName = "AcDbText" Then

Set guding2 = returnObj

guding2.TextString = xinshuju

Print #2， CInt（xuhao）， biaoshi， zongdihao

'                      ThisDrawing.Application.ActiveDocument.Save

End If

y = 0

End If

End If

End If

line1：

'    Print #2， CInt（xuhao） - 1， biaoshi， zongdihao

Loop

ThisDrawing.Application.ActiveDocument.Save

ThisDrawing.Application.ActiveDocument.Close

'      Print #2， x + 1， CInt（xuhao） - 1， biaoshi， zongdihao

Print #2， CInt（xuhao）， biaoshi， zongdihao

Close #1

Close #2

End Sub

4 結语

本文通过具体实例，验证了VB程序的逻辑可行性，对实现大数据改正和应用转化作出了有益的探索。

【参考文献】

【1】TD/T 1001—2012 地籍调查规程[S].

【2】何伟.实例学习VB条件语句[J].电脑编程技巧与维护，2016（2）：13.

【3】津政办发〔2012〕66号.天津市农村集体土地使用权及其地上房屋调查及确权登记发证工作实施细则[Z].