呂永杰

【摘? 要】VB語言可以實現(xiàn)應(yīng)用軟件的轉(zhuǎn)化也可以實現(xiàn)應(yīng)用軟件的批量改正，極大地提高了地籍測繪調(diào)查成果的轉(zhuǎn)化和改正效率，為大批量的數(shù)據(jù)應(yīng)用提供了可行的方法。

【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.

【關(guān)鍵詞】VB語言;地籍測繪;地籍調(diào)查

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

【中圖分類號】P272;TP312? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?【文獻(xiàn)標(biāo)志碼】A? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?【文章編號】1673-1069（2020）05-0191-03

1 引言

地籍測繪調(diào)查是不動產(chǎn)登記中最基礎(chǔ)的部分，是反映不動產(chǎn)的核心成果。VB語言可以實現(xiàn)在地籍測繪調(diào)查中宗地圖的批量修改、PDF輸出以及房屋的批量轉(zhuǎn)化。本文結(jié)合具體實例，介紹了VB語言在地籍測繪調(diào)查中的具體應(yīng)用，以期方便快捷地實現(xiàn)批量改正及轉(zhuǎn)化。

2 VB語言簡介

Visual Basic（以下簡稱VB）是一種通用的基于對象的程序設(shè)計語言，以結(jié)構(gòu)化的、模塊化的、面向?qū)ο蟮摹瑓f(xié)助開發(fā)環(huán)境的事件驅(qū)動為機制的可視化程序設(shè)計語言。

VB語言便于程序員使用，可以簡單建立應(yīng)用程序的GUI系統(tǒng)，同時，又可以開發(fā)相當(dāng)復(fù)雜的程序。VB語言具有以下幾個特點：可視化的設(shè)計平臺、事件驅(qū)動的編程機制、結(jié)構(gòu)化的程序設(shè)計語言、強大的數(shù)據(jù)庫功能。

3 VB語言在地籍測繪調(diào)查中的實例應(yīng)用

VB語言既可以實現(xiàn)應(yīng)用軟件的轉(zhuǎn)化又可以實現(xiàn)應(yīng)用軟件的批量改正。應(yīng)用轉(zhuǎn)化軟件可以通過VB語言實現(xiàn)多種軟件之間的轉(zhuǎn)化，如CAD圖形可以通過PDF轉(zhuǎn)化軟件實現(xiàn)轉(zhuǎn)換。VB語言也可以實現(xiàn)宗地圖的批量改正，可以極大地提高工作效率和質(zhì)量。下面通過實例來說明CAD圖形轉(zhuǎn)換為PDF、宗地圖的批量改正，具體分析VB語言在地籍測繪調(diào)查中的應(yīng)用。

①CAD圖形轉(zhuǎn)換為PDF，單宗輸出

Sub 單宗輸出PDF（）

Dim strPath As String

Dim Message， Title， Default As String

Message = "輸入宗地文件夾所在地址，僅保留個人宗地文件"

Title = "地址輸入框"? ? ' 設(shè)置標(biāo)題。

Default = "D：＼CADVBA＼SFDFAS"? ? ' 設(shè)置缺省值。

' 顯示信息、標(biāo)題及缺省值。

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（"請輸入文件路徑"， "改坐標(biāo)生成文件輸入框"， "路徑"）

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

''找到宗地文件夾及調(diào)查數(shù)據(jù)成果

Dim s， zongditupath As String

s = wenjianjialujing（cunwenjianjia， CStr（zongdihao））

zongditupath = s & "＼調(diào)查數(shù)據(jù)成果＼ZDT.dwg"

If zongdihao2 = "" Then ''第一張圖宗地號二等于""，不能關(guān)閉當(dāng)前圖形

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

''創(chuàng)建選擇集

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 結(jié)語

本文通過具體實例，驗證了VB程序的邏輯可行性，對實現(xiàn)大數(shù)據(jù)改正和應(yīng)用轉(zhuǎn)化作出了有益的探索。

【參考文獻(xiàn)】

【1】TD/T 1001—2012 地籍調(diào)查規(guī)程[S].

【2】何偉.實例學(xué)習(xí)VB條件語句[J].電腦編程技巧與維護，2016（2）：13.

【3】津政辦發(fā)〔2012〕66號.天津市農(nóng)村集體土地使用權(quán)及其地上房屋調(diào)查及確權(quán)登記發(fā)證工作實施細(xì)則[Z].