运用VBA实现地籍调查表与图形编辑的自动化.doc

测绘信息网运用VBA实现地籍调查表与图形编辑的自动化罗石坚，曹明，吴根姣江西核工业测绘院 330038摘要： 本文介绍了一种用VBA编译出来的主要针对在地籍测量（内业）工作中文档的编辑及文档与图形的整合的过程而设计出的一个办公自动化程序，该程序操作简单、使用方便，具有较高的实用价值，可大大提高工作效率，增进产出。测绘信息网关键词： VBA 地籍调查表 自动化一、 引言 随着计算机技术的日益发展和时下正提倡的办公自动化，各企业、单位也在不断的针对在工作中能够增产增效而引进或自主研发出有效的方法。为针对在地籍调查测量工作中文档的编辑及文档与图形的整合的过程中一些繁琐而重复的工作，而此介绍的正是一种基于VBA而编译出来的一个自动化程序，以减少对完成这一庞大而重复的工作的耗时。 VBA是指Visual Basic for Application。它是在Office中使用的宏语言，并基于Basic计算机语言，主要为了增强Word、Excel等软件的自动化能力。二、 程序设计和编辑测绘信息网 预安装Microsoft Office Excel 2003。运行软件，根据宗地数量适量的建立多份空白表格和写入宗地属性及界址点数据的相应表格。完成后进入VBA的编译环境开始编辑程序。打开工具栏 宏 Visual Basic编辑器，示意图宗地坐标数据表头运用VBA编译的地籍调查测量工作中文本与图形编辑自动化程序中的主要工作有：（1）建立Excel工作表设置样式并编辑完成宗地调查成果表表头属性；（2）将由基于AutoCAD的南方Cass制图软件导出的qs文件（权属文件）导入Excel工作表中并完成界址点的坐标及其相关数据在相应的宗地调查成果表中写入；（3）依据宗地调查成果表属性，在工作表中查找出其界址点属性数据并调用VBA中的方法，再依据根据界址点坐标绘制宗地示意图。我们将宗地调查成果表表格的编辑分为三部分：表头-显示宗地属性数据、坐标-显示宗地界址点坐标数据、示意图-宗地图。（如上图所示）三、设计本程序中数据的逻辑结构：1、宗地属性数据如下表测绘信息网编号变量名称数据结构说明ZDHString宗地号TFHString图幅号TDSYZString土地使用者TDZLString土地座落TDYTVarchar(10)土地用途QSXZVarchar(10)权属性质7SYQLXVarchar(10)使用权类型8TDDJVarchar(10)土地等级9YTDZHString原土地证号10ZDMJSingle宗地面积11JZMJSingle建筑面积12JZZDMJSingle建筑占地面积13RJLSingle容积率14JZMDSingle建筑密度15SYQXDatetime使用期限2、界址点属性数据及过程中变量如下表编号变量名称数据结构说明X（）StringX坐标的数组Y（）StringY坐标的数组Zx()SingleXi相对X(i-1)坐标增量ZY()SingleYi相对Y(i-1)坐标增量Kx()Single转换坐标系后X坐标Ky()Single转换坐标系后Y坐标7KSingle转换坐标的比例系数8IInteger坐标计数器9IiInteger工作表计数器10MSingle无定义变量11CxInteger目标单元格所在行12CyInteger目标单元格所在列13XmaxStringX()数组最大值14XminStringX()数组最小值15YmaxStringY()数组最大值16YminStringY()数组最小值17EaSingle横向偏移系数18EbSingle纵向偏移系数19KxmaxStringKx()数组最大值20KxminStringKx()数组最小值21KymaxStringKy()数组最大值22KyminStringKy()数组最小值23Kx0Single坐标系原点24Ky0Single坐标系原点Sub main()导入宗地属性数据导入宗地坐标数据将宗地数据代入ZDH、TFH、DTZL等变量中依据ZDH变量值查找出此宗地坐标数据在工作表中的位置返回值Cx、Cy，Cx为单元格所在列，Cy为单元格所在行运用一个Do Loop循环控制语句将坐标数据代入X()、Y()动态数组当Cells(Cx,Cy)”END”X(i)=Cells(Cx+1,Cy+1)、Y(i)=Cells(Cx+2,Cy+1)，Cy=Cy+1,i=i+1结束Do Loop循环，运用Select Case语句依坐标点的个数归类选择表格NY第一种表格，当1 i = 20第二种表格，当20 i = 60第三种表格，当60 i = 100YYY在表格中写入X()、Y()数据将X()、Y()换算为Kx()、Ky()，运用For Next语句 M=1 To i-1推算出X()、Y()的最大值和最小值，Xmax,Xmin,Ymax,Ymin计算系数k的值计算出坐标增量Zx()、Zy()，运用For Next语句 M=1To i-1Kx(M + 1) = Kx(M) - k * Zy(M)，Ky(M + 1) = Ky(M) + k * Zx(M)Zx(M) = X(M) - X(M + 1),Zy(M) = Y(M) - Y(M + 1)依据数据Kx()+Ea，Ky()+Eb的坐标值绘制图形、界址点修饰圆圈，标注点号等推算出Kxmax,Kxmin,Kymax,Kymin根据图形显示位置的坐标原点Ky0,Kx0计算出偏移系数Ea,EbEa = Ky0 - (Kymin + (Kymax - Kymin) / 2)，Eb = Kx0 - (Kxmin + (Kxmax - Kxmin) / 2)结束四、设计流程图：五、部分主要代码的编写：定义变量测绘信息网Dim Cx, Cy, M As Integer ：Dim X(), Y() As String ：Dim Zx(), Zy() As Single ：Dim Xmax, Xmin, Ymax, Ymin As String ：Dim Kxmax, Kxmin, Kymax, Kymin As String ：Dim Kx(), Ky(), k As Single ：Dim i ，ii As Integer ：Dim Ea, Eb As Single宗地属性数据写在名为ZDSX工作表中的第ii行，现将第ii行的数据写入第ii份工作表中Sheets(ii).Range(C5:E5) = Sheets(ZDSX).Range(A & ii).ValueSheets(ii).Range(H5:J5) = Sheets(ZDSX).Range(B & ii).ValueSheets(ii).Range(C6:G6) = Sheets(ZDSX).Range(C & ii).Value依据ZDH变量值在工作表JZD中查找出此宗地坐标数据在工作表中的位置，返回值Cx、Cy，Cx为单元格所在列，Cy为单元格所在行 Sheets(JZD).Select Columns(A:A).Select Selection.Find(What:=Sheets(ZDSX).Range(A & ii).Value, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate Cx = ActiveCell.Row Cy = ActiveCell.Column运用一个Do Loop循环控制语句将坐标数据代入X()、Y()动态数组，因为坐标数据存在于宗地号字段与END字段纵向排列的数据之间，则我们以宗地号字段的单元格为起点开始记录当遇到END字段单元格时结束循环。ReDim X(1 To 1) 调用动态数组ReDim Y(1 To 1) 调用动态数组i = 1Do While Sheets(JZD).Range(A & Cx) ENDX(i) = Sheets(JZD).Range(B & Cx)Y(i) = Sheets(JZD).Range(C & Cx)i = i + 1 : ReDim Preserve X(1 To i), Y(1 To i) : Cx = Cx + 1Loop测绘信息网运用Select Case语句依坐标点的个数归类选择表格，我们在此将其分为20个坐标点、60个坐标点、100个坐标点等，每40个点一增的取值Select Case iCase i 3 And i 20 And i 60 And i Xmax Then Xmax = X(k) Else: End If If X(k) Ymax Then Ymax = Y(k) Else: End If If Y(k) Ymin Then Ymin = Y(k) Else: End IfNext k测绘信息网计算出坐标增量Zx()、Zy()，注：因增量为X(M) - X(M + 1)，则Zx()、Zy()数组个数小于i 否则将出现X() , Y() 数据溢出ReDim Zx(0 To i - 1) 调用动态数组ReDim Zy(0 To i - 1)For M = 1 To i - 1Zx(M) = X(M) - X(M + 1)Zy(M) = Y(M) - Y(M + 1)Next M计算系数k的值，在这M表示显示图形的区域大小k = M / (Xmax - Xmin)将X()、Y()换算为Kx()、Ky() ，公式的推理见下一页。For M = 1 To i - 1Kx(M + 1) = Kx(M) - k * Zy(M)Ky(M + 1) = Ky(M) + k * Zx(M)Next MXOYKxAKyP由P(X,Y)值换算为P(Kx,Ky)计算公式为：（见右图）Kx = Ax - k * (cos-sin)* KyKy = Ay + k * (sin+cos)* Kx推算出Kxmax,Kxmin,Kymax,Kymin根据图形显示位置的坐标原点Ky0,Kx0计算出偏移系数Ea,Eb测绘信息网Ea = Ky0 - (Kymin + (Kymax - Kymin) / 2)Eb = Kx0 - (Kxmin + (Kxmax - Kxmin) / 2)再依据数据Kx()+Ea，Ky()+Eb的坐标值绘制