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

AutoCAD数据与其它的VBA应用程序，如Microsoft Excel软件，直接共享，实现无缝连接，交换数据。本文介绍如何利用VBA编程建立AutoCAD2000与Excel2000的通信，实现数据交换，快速绘制公路纵断面地面线。 关键词公路纵断面设计 地面线 VBA AutoCAD与Excel的通信 1 前言 纵断面设计图是道路纵断面设计的主要成果，也是道路设计的重要技术文件之一。在纵断面设计图上有两条主要的线一条是地面线，它是根据中线上各桩点的高程而点绘的一条不规则的折线，反映了沿着中线地面的起伏变化；另一条是设计线，它是经过技术上、经济上以及美学上等多方面比较后定出的一条规则形状的几何线。 公路设计中，在没有专业设计软件辅助的情况下，绘制公路纵断面图是很繁琐的事，需要进行大量的、重复的操作，既劳神，又容易出错。特别在公路外业勘测阶段，需要在短时间内将所测量的中桩高程转化成纵断面图上的地面线，才可以进行路线纵坡设计，分析测量成果（选线）是否合理。 如何快速绘制公路纵断面地面线呢答案是利用Microsoft Excel、AutoCAD都提供的VBA功能，编制程序进行绘制，即把Microsoft Excel表格中的桩号、地面高程等信息读取出来，在AutoCAD文件里以文字、线条的方式写出来，就可绘出中桩地面线。 2 VBA简介 Visual Basic for Application（VBA）是Microsoft面向最终用户的应用软件编程语言。它最早出现于Microsoft的Excel和Project中，如今VBA已成为VB和所有Office产品的组件。常用的绘图软件AutoCAD也已支持VBA作为二次开发工具。 VBA最大特点和最大优点是利用面向对象（OOP）的ActiveX Automation技术，使语言的引擎在技术上与开发环境分离。它的功能在很大程度上依赖于它的客户显露的Automation接口。同时，由于VBA是基于ActiveX Automation技术，它可以使用任何Automation技术的应用程序共同工作。 基于AutoCAD的VBA应用程序就是高级程序语言的计算功能与AutoCAD的绘图功能结合，使用VBA程序语句来控制对AutoCAD图形的操作。 VBA作为一个集成的开发环境，它提供了高质量的用户化编程能力，能够使AutoCAD数据与其它的VBA应用程序，如Microsoft Excel软件，直接共享，实现无缝连接，交换数据非常方便。 3 工作机理分析 在Microsoft Excel中，与表对应的对象是工作表（Sheet或Worksheet），与每一个表格方格对应的对象是单元格区域（range），它可以仅包括一个单元格（cell），也可以由多个单元格合并而成。工作表对象中的cells属性，在单元格的选择方面可以达到与range相同的效果，它是以行（row）和列（gol）作为参数的，对于行和列的选择可以采用变量的形式。在本例中，可设定工作表（Worksheet）的每一行第一列（cells（i,1））为中桩桩号，每一行第二列（cells（i,2））为对应的地面高程。 在AutoCAD中，没有与表对应的对象，但可以根据表中前后桩号定义水平距离，根据地面高程定义垂直距离，将表中数据理解为线条与文字对象的集合。这样，通过读取Microsoft Excel文件中的最小对象单元格区域（cells（i,j））的主要信息，利用VBA建立AutoCAD与Excel的通信，然后在AutoCAD文件里指定的图层、位置画线条，书写文字。通过循环，遍历所有单元格区域（cells（i,j）），边读边写，最终完成纵断面地面线的绘制及桩号、地面高程的书写。 4 具体实现方法 4.1 在AutoCAD中创建Excel应用程序 要编写存取Excel的应用程序，必须通过VBA将Excel中的对象能够让用户使用，这就需要参考 Excel对象的数据库。其步骤如下 4.1.1 打开AutoCAD的VBA编辑器（命令VBAIDE）； 4.1.2 选择“工具”\“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“Microsoft Excel 8.0 Object Library”项； 4.1.3 单击“确定”按钮； 4.1.4 接下来使用下列代码可创建完整的应用程序对象实例 Dim Excel As Excel.Application 激活要与之通信的Excel应用程序 On Error Resume Next Set Excel GetObject, “Excel.Application“ If Err 0Then Set Excel CreateObject“Excel.Application“ End If 4.2 读入坐标点画地面线 4.2.1 设定工作表（Worksheet）的每一行第一列（cells（i,1））为中桩桩号，每一行第二列（cells（i,2））为对应的地面高程。由于公路路线纵断面图水平方向比例为12000，垂直方向比例为1200，故读入时，y坐标应乘以10倍。 4.2.2 以（0，0，0）为原点，以桩号里程为x坐标，以10倍所对应的地面高程为y坐标，0为z坐标，定义某一桩号对应的地面点坐标；然后循环读取各里程桩号数据信息，定义各桩号所对应的地面点坐标；最后以直线段连接各地面点坐标，则为地面线。 4.2.3 下述代码可读入Excel数据信息画地面线 Dim i As Integer Dim lineobj As AcadLine Dim sPnt0 To 2 As Double Dim ePnt0 To 2 As Double ‘读入坐标画地面线 Worksheets“sheet1“.Activate i 3 ‘由第三行起 Do Until cellsi, 1.Value ““ If cellsi 1, 1 0 Then Exit Do End If sPnt0 cellsi, 1.Value sPnt1 10 * cellsi, 2.Value sPnt2 0 ePnt0 cellsi 1, 1.Value ePnt1 10 * cellsi 1, 2.Value ePnt2 0 Set lineobj ThisDrawing.ModelSpace.AddLinesPnt, ePnt i i 1 Loop 4.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 运行AutoCAD2000程序； 5.2 打开AutoCAD的VBA编辑器（命令VBAIDE）； 5.3 创建成下面的过程及代码，并运行之 Sub ZDM Dim Excel As Excel.Application Dim ExcelSheet As Object Dim ExcelWorkbook As Object Dim i As Integer Dim lineobj As AcadLine Dim klineobj As AcadLine Dim sPnt0 To 2 As Double Dim ePnt0 To 2 As Double Dim kPnt0 To 2 As Double Dim hPnt0 To 2 As Double Dim ksPnt0 To 2 As Double Dim kePnt0 To 2 As Double Dim dmPnt0 To 2 As Double Dim textObj As AcadText Dim txtStr As String Dim insPnt As Variant Dim txtHeight As Double Dim layObj As AcadLayer Dim newLayer As AcadLayer Set layObj ThisDrawing.Layers.Add“标注“ Set layObj ThisDrawing.Layers.Add“地面线“ Set layObj ThisDrawing.Layers.Add“网格线“ Dim atTxtobj As AcadTextStyle Set atTxtobj ThisDrawing.ActiveTextStyle atTxtobj.fontFile “c\windows\fonts\simfang.ttf“ 创建Excel应用程序 On Error Resume Next Set Excel GetObject, “Excel.Application“ If Err 0 Then Set Excel CreateObject“Excel.Application“ End If 打开Excel表 ExcelName Box“路径“ Excel.Workbooks.Open ExcelName 表格不可见 Excel.Visible False 读入坐标点画地面线 Worksheets“sheet1“.Activate i 3 Do Until cellsi, 1.Value ““ If cellsi 1, 1 0 Then Exit Do End If sPnt0 cellsi, 1.Value sPnt1 10 * cellsi, 2.Value sPnt2 0 ePnt0 cellsi 1, 1.Value ePnt1 10 * cellsi 1, 2.Value ePnt2 0 Set newLayer ThisDrawing.Layers“地面线“ ThisDrawing.ActiveLayer newLayer newLayer.Color acWhite Set lineobj ThisDrawing.ModelSpace.AddLinesPnt, ePnt If cellsi, 2 ““ Then lineobj.Delete i i 1 Loop 画辅助网格线及插入数据 i 3 Do Until cellsi, 1.Value ““ 画辅助网格线 ksPnt0 cellsi, 1.Value ksPnt1 0 ksPnt2 0 kePnt0 cellsi, 1.Value kePnt1 10 * cellsi, 2.Value kePnt2 0 dmPnt0 cellsi, 1.Value dmPnt1 48 dmPnt2 0 Set newLayer ThisDrawing.Layers“网格线“ ThisDrawing.ActiveLayer newLayer newLayer.Color acGreen Set klineobj ThisDrawing.ModelSpace.AddLineksPnt, kePnt 插入桩号 Set newLayer ThisDrawing.Layers“标注“ ThisDr awing.ActiveLayer newLayer newLayer.Color acCyan a cellsi, 1.Value b Inta / 1000