| 标题 | 浅析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]. |
| 随便看 |
|
科学优质学术资源、百科知识分享平台，免费提供知识科普、生活经验分享、中外学术论文、各类范文、学术文献、教学资料、学术期刊、会议、报纸、杂志、工具书等各类资源检索、在线阅读和软件app下载服务。