利用VBA程序语言绘制公路纵断面图

1、利用VBA程序语言绘制公路纵断面图摘要：VBA作为一个集成的开发环境，能够使AutAD数据与其它的VBA应用程序，如irsftExel软件，直接共享，实现无缝连接，交换数据。本文介绍如何利用VBA编程建立AutAD2000与Exel2000的通信，实现数据交换，快速绘制公路纵断面地面线。关键词：公路纵断面设计地面线VBAAutAD与Exel的通信前言纵断面设计图是道路纵断面设计的主要成果，也是道路设计的重要技术文件之一。在纵断面设计图上有两条主要的线：一条是地面线，它是根据中线上各桩点的高程而点绘的一条不规则的折线，反映了沿着中线地面的起伏变化；另一条是设计线，它是经过技术上、经济上以及美学上

2、等多方面比较后定出的一条规则形状的几何线。公路设计中，在没有专业设计软件辅助的情况下，绘制公路纵断面图是很繁琐的事，需要进行大量的、重复的操作，既劳神，又容易出错。特别在公路外业勘测阶段，需要在短时间内将所测量的中桩高程转化成纵断面图上的地面线，才可以进行路线纵坡设计，分析测量成果（选线）是否合理。如何快速绘制公路纵断面地面线呢？答案是：利用irsftExel、AutAD都提供的VBA功能，编制程序进行绘制，即把irsftExel表格中的桩号、地面高程等信息读取出来，在AutAD文件里以文字、线条的方式写出来，就可绘出中桩地面线。2、VBA简介VisualBasifrAppliatin（VBA

3、）是irsft面向最终用户的应用软件编程语言。它最早出现于irsft的Exel和Prjet中，如今VBA已成为VB和所有ffie产品的组件。常用的绘图软件AutAD也已支持VBA作为二次开发工具。VBA最大特点和最大优点是利用面向对象（P）的AtiveXAutatin技术，使语言的引擎在技术上与开发环境分离。它的功能在很大程度上依赖于它的客户显露的Autatin接口。同时，由于VBA是基于AtiveXAutatin技术，它可以使用任何Autatin技术的应用程序共同工作。基于AutAD的VBA应用程序就是高级程序语言的计算功能与AutAD的绘图功能结合，使用VBA程序语句来控制对AutAD图形

4、的操作。VBA作为一个集成的开发环境，它提供了高质量的用户化编程能力，能够使AutAD数据与其它的VBA应用程序，如irsftExel软件，直接共享，实现无缝连接，交换数据非常方便。3、工作机理分析在irsftExel中，与表对应的对象是工作表（Sheet或rksheet），与每一个表格方格对应的对象是单元格区域（range），它可以仅包括一个单元格（ell），也可以由多个单元格合并而成。工作表对象中的ells属性，在单元格的选择方面可以达到与range相同的效果，它是以行（r）和列（gl）作为参数的，对于行和列的选择可以采用变量的形式。在本例中，可设定工作表（rksheet）的每一行第一列（

5、ells（i,1）为中桩桩号，每一行第二列（ells（i,2）为对应的地面高程。在AutAD中，没有与表对应的对象，但可以根据表中前后桩号定义水平距离，根据地面高程定义垂直距离，将表中数据理解为线条与文字对象的集合。这样，通过读取irsftExel文件中的最小对象单元格区域（ells（i,j）的主要信息，利用VBA建立AutAD与Exel的通信，然后在AutAD文件里指定的图层、位置画线条，书写文字。通过循环，遍历所有单元格区域（ells（i,j），边读边写，最终完成纵断面地面线的绘制及桩号、地面高程的书写。4、具体实现方法4.1在AutAD中创建Exel应用程序要编写存取Exel的应用程序，

6、必须通过VBA将Exel中的对象能够让用户使用，这就需要参考Exel对象的数据库。其步骤如下：4.1.1打开AutAD的VBA编辑器（命令：VBAIDE）；4.1.2选择“工具”“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“irsftExel8.0bjetLibrary”项；4.1.3单击“确定”按钮；4.1.4接下来使用下列代码可创建完整的应用程序对象实例：DiExelAsExel.Appliatin激活要与之通信的Exel应用程序nErrrResueNextSetExel=Getbjet(,Exel.Appliatin)IfErr0ThenSetExel=reateb

7、jet(Exel.Appliatin)EndIf4.2读入坐标点画地面线4.2.1设定工作表（rksheet）的每一行第一列（ells（i,1）为中桩桩号，每一行第二列（ells（i,2）为对应的地面高程。由于公路路线纵断面图水平方向比例为1:2000，垂直方向比例为1:200，故读入时，y坐标应乘以10倍。4.2.2以（0，0，0）为原点，以桩号里程为x坐标，以10倍所对应的地面高程为y坐标，0为z坐标，定义某一桩号对应的地面点坐标；然后循环读取各里程桩号数据信息，定义各桩号所对应的地面点坐标；最后以直线段连接各地面点坐标，则为地面线。4.2.3下述代码可读入Exel数据信息画地面线DiiA

8、sIntegerDilinebjAsAadLineDisPnt(0T2)AsDubleDiePnt(0T2)AsDuble读入坐标画地面线rksheets(sheet1).Ativatei=3由第三行起DUntilells(i,1).Value=Ifells(i+1,1)=0ThenExitDEndIfsPnt(0)=ells(i,1).ValuesPnt(1)=10*ells(i,2).ValuesPnt(2)=0ePnt(0)=ells(i+1,1).ValueePnt(1)=10*ells(i+1,2).ValueePnt(2)=0Setlinebj=ThisDraing.delSpae

9、.AddLine(sPnt,ePnt)i=i+1Lp4.3桩号及高程的写入4.3.1定义文字的插入位置以桩号里程为x坐标，0为y坐标，0为z坐标，确定文字的插入点。4.3.2以单行文字形式创建桩号及高程文字，定义文字的格式、字体、高度、倾斜角度。插入后的文字应逆时针旋转90度。4.4辅助网格线的绘制4.4.1辅助网格线能较为直观地表示桩号及地面高程的对应关系，有助于纵坡设计；4.4.2以桩号里程为x坐标，0为y坐标，0为z坐标，确定网格线第一点；以桩号里程为x坐标，10倍所对应的地面高程为y坐标，0为z坐标，确定网格线第二点；两点连线，则为网格线。5实例5.1运行AutAD2000程序；5.2

10、打开AutAD的VBA编辑器（命令：VBAIDE）；5.3创建成下面的过程及代码，并运行之：SubZD()DiExelAsExel.AppliatinDiExelSheetAsbjetDiExelrkbkAsbjetDiiAsIntegerDilinebjAsAadLineDiklinebjAsAadLineDisPnt(0T2)AsDubleDiePnt(0T2)AsDubleDikPnt(0T2)AsDubleDihPnt(0T2)AsDubleDiksPnt(0T2)AsDubleDikePnt(0T2)AsDubleDidPnt(0T2)AsDubleDitextbjAsAadText

11、DitxtStrAsStringDiinsPntAsVariantDitxtHEightAsDubleDilaybjAsAadLayerDineLayerAsAadLayerSetlaybj=ThisDraing.Layers.Add(标注)Setlaybj=ThisDraing.Layers.Add(地面线)Setlaybj=ThisDraing.Layers.Add(网格线)DiatTxtbjAsAadTextStyleSetatTxtbj=ThisDraing.AtiveTextStyleatTxtbj.fntFile=:indsfntssifang.ttf创建Exel应用程序nErrr

12、ResueNextSetExel=Getbjet(,Exel.Appliatin)IfErr0ThenSetExel=reatebjet(Exel.Appliatin)EndIf打开Exel表ExelNae=InputBx(路径：)Exel.rkbks.penExelNae表格不可见Exel.Visible=False读入坐标点画地面线rksheets(sheet1).Ativatei=3DUntilells(i,1).Value=Ifells(i+1,1)=0ThenExitDEndIfsPnt(0)=ells(i,1).ValuesPnt(1)=10*ells(i,2).ValuesPnt

13、(2)=0ePnt(0)=ells(i+1,1).ValueePnt(1)=10*ells(i+1,2).ValueePnt(2)=0SetneLayer=ThisDraing.Layers(地面线)ThisDraing.AtiveLayer=neLayerneLayer.lr=ahiteSetlinebj=ThisDraing.delSpae.AddLine(sPnt,ePnt)Ifells(i,2)=Thenlinebj.Deletei=i+1Lp画辅助网格线及插入数据i=3DUntilells(i,1).Value=画辅助网格线ksPnt(0)=ells(i,1).Value:ksPnt

14、(1)=0:ksPnt(2)=0kePnt(0)=ells(i,1).Value:kePnt(1)=10*ells(i,2).Value:kePnt(2)=0dPnt(0)=ells(i,1).Value:dPnt(1)=48:dPnt(2)=0SetneLayer=ThisDraing.Layers(网格线)ThisDraing.AtiveLayer=neLayerneLayer.lr=aGreenSetklinebj=ThisDraing.delSpae.AddLine(ksPnt,kePnt)插入桩号SetneLayer=ThisDraing.Layers(标注)ThisDraing.A

15、tiveLayer=neLayerneLayer.lr=ayana=ells(i,1).Valueb=Int(a/1000)=Frat(a-b*1000),000.000)d=a-Int(a)E=+Frat(,000.000)If=0ThenE=K+LTri(Str(b)txtStr=EtxtHeight=4textbj.Rtatin=3.14159/2insPnt=ksPntSettextbj=ThisDraing.delSpae.AddText(txtStr,insPnt,txtHeight)Ifells(i,2)=Thentextbj.Delete插入地面高程txtStr=Frat(el

16、ls(i,2).Value,#0.#0)txtHeight=4textbj.Rtatin=3.14159/2insPnt=dPntSettextbj=ThisDraing.delSpae.AddText(txtStr,insPnt,txtHeight)i=i+1LpZAll该语句用来等待查看显示结果sgBx按确定键将关闭Exel的运行！保存传过来的数据Exelrkbk.lseExelrkbk.Save关闭Exel应用程序Exel.Appliatin.Quit删除Exel应用程序实例SetExel=NthingEndSub5.4运行上述代码后，将会弹出窗口，提示输入Exel文件的路径；输入后回车，就可以生