呂永杰

【摘? 要】VB語(yǔ)言可以實(shí)現(xiàn)應(yīng)用軟件的轉(zhuǎn)化也可以實(shí)現(xiàn)應(yīng)用軟件的批量改正，極大地提高了地籍測(cè)繪調(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語(yǔ)言;地籍測(cè)繪;地籍調(diào)查

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

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

1 引言

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

2 VB語(yǔ)言簡(jiǎn)介

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

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

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

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

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

Sub 單宗輸出PDF（）

Dim strPath As String

Dim Message， Title， Default As String

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

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（"請(qǐng)輸入文件路徑"， "改坐標(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? ?' 打開(kāi)文件。

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 ''第一張圖宗地號(hào)二等于""，不能關(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é)語(yǔ)

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

【參考文獻(xiàn)】

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

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

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