利用VBA程序语言绘制公路纵断面图1Word格式.docx
《利用VBA程序语言绘制公路纵断面图1Word格式.docx》由会员分享，可在线阅读，更多相关《利用VBA程序语言绘制公路纵断面图1Word格式.docx（10页珍藏版）》请在冰豆网上搜索。
VisualBasicforApplication（VBA）是Microsoft面向最终用户的应用软件编程语言。
它最早出现于Microsoft的Excel和Project中，如今VBA已成为VB和所有Office产品的组件。
常用的绘图软件AutoCAD也已支持VBA作为二次开发工具。
VBA最大特点和最大优点是利用面向对象（OOP）的ActiveXAutomation技术，使语言的引擎在技术上与开发环境分离。
它的功能在很大程度上依赖于它的客户显露的Automation接口。
同时，由于VBA是基于ActiveXAutomation技术，它可以使用任何Automation技术的应用程序共同工作。
基于AutoCAD的VBA应用程序就是高级程序语言的计算功能与AutoCAD的绘图功能结合，使用VBA程序语句来控制对AutoCAD图形的操作。
VBA作为一个集成的开发环境，它提供了高质量的用户化编程能力，能够使AutoCAD数据与其它的VBA应用程序，如MicrosoftExcel软件，直接共享，实现无缝连接，交换数据非常方便。
3工作机理分析
在MicrosoftExcel中，与表对应的对象是工作表（Sheet或Worksheet），与每一个表格方格对应的对象是单元格区域（range），它可以仅包括一个单元格（cell），也可以由多个单元格合并而成。
工作表对象中的cells属性，在单元格的选择方面可以达到与range相同的效果，它是以行（row）和列（gol）作为参数的，对于行和列的选择可以采用变量的形式。
在本例中，可设定工作表（Worksheet）的每一行第一列（cells（i,1））为中桩桩号，每一行第二列（cells（i,2））为对应的地面高程。
在AutoCAD中，没有与表对应的对象，但可以根据表中前后桩号定义水平距离，根据地面高程定义垂直距离，将表中数据理解为线条与文字对象的集合。
这样，通过读取MicrosoftExcel文件中的最小对象—单元格区域（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
选择“工具”“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“MicrosoftExcel8.0ObjectLibrary”项；
4.1.3
单击“确定”按钮；
4.1.4
接下来使用下列代码可创建完整的应用程序对象实例：
DimExcelAsExcel.Application
'
激活要与之通信的Excel应用程序
OnErrorResumeNext
SetExcel=GetObject（,"
Excel.Application"
）
IfErr<
>
0Then
SetExcel=CreateObject（"
EndIf
4.2
读入坐标点画地面线
4.2.1
设定工作表（Worksheet）的每一行第一列（cells（i,1））为中桩桩号，每一行第二列（cells（i,2））为对应的地面高程。
由于公路路线纵断面图水平方向比例为1:
2000，垂直方向比例为1:
200，故读入时，y坐标应乘以10倍。
4.2.2
以（0，0，0）为原点，以桩号里程为x坐标，以10倍所对应的地面高程为y坐标，0为z坐标，定义某一桩号对应的地面点坐标；
然后循环读取各里程桩号数据信息，定义各桩号所对应的地面点坐标；
最后以直线段连接各地面点坐标，则为地面线。
4.2.3
下述代码可读入Excel数据信息画地面线
DimiAsInteger
DimlineobjAsAcadLine
DimsPnt（0To2）AsDouble
DimePnt（0To2）AsDouble
‘读入坐标画地面线
Worksheets（"
sheet1"
）.Activate
i=3
‘由第三行起
DoUntilcells（i,1）.Value="
"
Ifcells（i1,1）=0Then
ExitDo
sPnt（0）=cells（i,1）.Value
sPnt
（1）=10*cells（i,2）.Value
sPnt
（2）=0
ePnt（0）=cells（i1,1）.Value
ePnt
（1）=10*cells（i1,2）.Value
ePnt
（2）=0
Setlineobj=ThisDrawing.ModelSpace.AddLine（sPnt,ePnt）
i=i1
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编辑器（命令：
5.3
创建成下面的过程及代码，并运行之：
SubZDM（）
DimExcelSheetAsObject
DimExcelWorkbookAsObject
DimklineobjAsAcadLine
DimkPnt（0To2）AsDouble
DimhPnt（0To2）AsDouble
DimksPnt（0To2）AsDouble
DimkePnt（0To2）AsDouble
DimdmPnt（0To2）AsDouble
DimtextObjAsAcadText
DimtxtStrAsString
DiminsPntAsVariant
DimtxtHeightAsDouble
DimlayObjAsAcadLayer
DimnewLayerAsAcadLayer
SetlayObj=ThisDrawing.Layers.Add（"
标注"
地面线"
网格线"
DimatTxtobjAsAcadTextStyle
SetatTxtobj=ThisDrawing.ActiveTextStyle
atTxtobj.fontFile="
c:
windowsfontssimfang.ttf"
创建Excel应用程序
0Then
打开Excel表
ExcelName=InputBox（"
路径：
Excel.Workbooks.OpenExcelName
表格不可见
Excel.Visible=False
i=3
SetnewLayer=ThisDrawing.Layers（"
ThisDrawing.ActiveLayer=newLayer
newLayer.Color=acWhite
Ifcells（i,2）="
Thenlineobj.Delete
画辅助网格线及插入数据
画辅助网格线
ksPnt（0）=cells（i,1）.Value:
ksPnt
（1）=0:
ksPnt
（2）=0
kePnt（0）=cells（i,1）.Value:
kePnt
（1）=10*cells（i,2）.Value:
kePnt
（2）=0
dmPnt（0）=cells（i,1）.Value:
dmPnt
（1）=48:
dmPnt
（2）=0
newLayer.Color=acGreen
Setklineobj=ThisDrawing.ModelSpace.AddLine（ksPnt,kePnt）
插入桩号
newLayer.Color=acCyan
a=cells（i,1）.Value
b=Int（a/1000）
c=Format（（a-b*1000）,"
000.000"
d=a-Int（a）
E="
"
Format（c,"
Ifc=0ThenE="
K"
LTrim（Str（b））
txtStr=E
txtHeight=4
textObj.Rotation=3.14159/2
insPnt=ksPnt
SettextObj=ThisDrawing.ModelSpace.AddText（txtStr,insPnt,txtHeight）
ThentextObj.Delete
插入地面高程
txtStr=Format（cells（i,2）.Value,"
###0.##0"
insPnt=dmPnt
ZoomAll
该语句用来等待查看显示结果
MsgBox"
按‘确定’键将关闭Excel的运行！
保存传过来的数据
ExcelWorkbook.Close
ExcelWorkbook.Save
关闭Excel应用程序
Excel.Application.Quit
删除Excel应用程序实例
SetExcel=Nothing
升级会员 