AutoCAD VBA在大沙河河道断面绘制中的应用

2016-09-01蒋云杰张丽萍陆文君

治淮 2016年2期

蒋云杰　董　雷　张丽萍　张　磊　杨　宁　陆文君

蒋云杰董雷张丽萍张磊杨宁陆文君

大沙河是古黄河进入江苏省境内的第一条分洪道，大沙河两岸均为黄河冲积的粉砂土，地势高亢，河道宽浅弯曲，汛期行洪不畅，经常决口，灌溉期又严重缺水，干旱和洪涝灾害频发。根据《全国重点中小河流治理实施方案》（2013-2015年），丰县大沙河治理总长度8.47km。根据河道规划方案，河底宽从50～250m不等，边坡为1∶4。结合大沙河的工程实际，利用VBA对AutoCAD进行二次开发，绘制大沙河河道设计断面。

一、启动VBA程序

AutoCAD VBA程序代码的集合叫做宏。该宏不能直接独立运行，需要借助于其他应用程序的调用。点击AutoCAD软件菜单栏中的“工具”选项，在下拉列表框中选择“宏”。然后点击“加载工程”可以加载已经编译好的VBA工程，也可以点击“Visual Basic编辑器”进行新工程的编译。

二、与Excel程序的交互接口

Excel软件是微软办公软件中的重要组成部分，可以进行各种数据的处理、统计分析和辅助决策等，广泛应用于各个领域。AutoCAD可以通过ActiveX访问Excel数据表，并实现数据资源的共享。将规划设计好的各河道断面数据按照表1的顺序依次列入Excel数据表中。

表1　　河道断面数据数据表样表

首先声明某个量为Excel.Applica -tion，其次声明某个量为工作表，然后获取需要调用的Excel的路径。在该程序中，Excel的路径和编译好的VBA工程放在同一个文件夹中，并且将文件命名为Excel.xls。调用Excel程序的命令如下：

Dimxlapp As Excel.Application

Dimxlbook As Excel.Workbook'定义工作簿

DimxlsheetAsExcel.Worksheet'定义工作表

'获得当前工程的路径

DimstrFile As String

strFile=ThisDrawing.Application. VBE.ActiveVBProject.FileName

'创建Excel应用程序实例

Set xlapp=CreateObject（"Excel. Application"）

xlapp.Visible=True

'指定打开Excel的位置

（strFile，Len（strFile）-Len（"Excel to line.dvb"））&"Excel.xls"

'指定Excel文件为当前活动的文件

三、调用Excel数据表中的数据

应用VBA程序查询Excel数据表中所具有的数据的组数，并赋值给循环变量“i”，以便为相应的数组申请空间。由于Excel数据表中的数据已按照一定的格式列于数据表中，故可以将Excel数据表中的数据直接分配给申请好空间的数组。可用如下程序代码实现：

ReDim L（i+10）As Double'导线到中心线距离数组

ReDim px（i+10）As Double'基点x坐标数组

ReDim py（i+10）As Double'基点y坐标数组

ReDim JG（i+10）As Double'基点高程数组

ReDimDG（i+10）As Double'河底高程数组

ReDim DB（i+10）As Double'断面的宽度数组

ReDim m（i+10）As Double'边坡系数数组

ReDim TG（i+10）As Double'滩面高程数组

ReDim TB（i+10）As Double'滩面宽度数组

ReDimZBD（i+10）As Double'坐标图最高点坐标数组

四、绘制河道断面图

将河道中心线设置为点划线，河道边线设置为实线。因此在VBA中声明objLayer1和objLayer2为AutoCAD的图层属性，分别表示河道中心线层和河道边线层，并根据绘图习惯设置线宽，本文中设置河道中心线线宽为0.3mm，河道边线线宽为0.7mm。由于中心线是点划线，初始AutoCAD中是没有点划线的，需要自己手动加载才可以。本文首先采用判断语句判断打开的AutoCAD文件中是否已经加载了点划线的样式，如果已加载则直接使用，否则通过VBA语句加载。在本文中应用以下语句自动加载点划线，并设置点划线为红色：

Dim T As AcadLineType'CAD线型，用于遍历已加载的线型

Dim BB As Boolean'用于标记检查已加载线型的结果

DimobjLayer1 As AcadLayer

DimobjLayer2 As AcadLayer

Set objLayer1=ThisDrawing.Layers. Add（"中心线"）

Set objLayer2=ThisDrawing.Layers. Add（"边线"）

For Each TIn ThisDrawing.Linetyp -es'检查是否已加载中心线的线型

If BB=False Then ThisDrawing. Linetypes.Load"ACAD_ISO10W100"，"acad.lin"'在要求的线型未找到时加载该线型

objLayer1.Linetype="ACAD_ISO 10W100"'按要求定义中心线线型

objLayer1.color=acRed

objLayer1.Lineweight=acLnWt030

objLayer2.Lineweight=acLnWt070

在图层及线型设置完成之后，根据Excel数据表中的数据，按照几何关系列出计算河道断面几个特征点坐标的表达式，调用AutoCADVBA程序中的画直线命令，根据两点连线命令绘制河道断面，并设置中心线的线型比例为0.2。由于各断面河道现状滩面线形状各不相同，因此在本文中将河道滩面以上的边线按照边坡比例绘制到坐标网格的最顶端，然后利用河道现状滩面线，手动将河道线截断，就可以形成设计的河道断面图。通过以下语句完成以上目的：

Call ThisDrawing.ModelSpace. AddLine（p1，p2）'调用划直线命令绘制中心线左侧河底线

Call ThisDrawing.ModelSpace. AddLine（p2，p3）'调用划直线命令绘制中心线左侧边坡线

CallThisDrawing.ModelSpace. AddLine（p3，p4）'调用划直线命令绘制中心线左侧滩面线

CallThisDrawing.ModelSpace. AddLine（p4，p5）'调用划直线命令绘制中心线左侧边坡线

CallThisDrawing.ModelSpace. AddLine（p1，p6）'调用划直线命令绘制中心线右侧河底线

CallThisDrawing.ModelSpace. AddLine（p6，p7）'调用划直线命令绘制中心线右侧边坡线

CallThisDrawing.ModelSpace. AddLine（p7，p8）'调用划直线命令绘制中心线右侧滩面线

CallThisDrawing.ModelSpace. AddLine（p8，p9）'调用划直线命令绘制中心线右侧边坡线

Set ML=ThisDrawing.Model Space.AddLine（p10，p11）'调用划直线命令绘制中心线

图1　　绘制完成的大沙河某两个河道断面图

五、实例应用

以大沙河河道断面绘制为例，在平面图上绘制河道中心线，并采集每个断面导线至中心线的距离，存入河道数据表中，记为A列（基点距中心线距离），采用另外的程序在断面图中采集导线基点坐标存入河道数据表中，记为B列（基点x坐标）、C列（基点y坐标）。利用VBA打开河道数据表，根据B列和C列数据找到河道断面基点，再结合A列数据可以得到河底中线位置坐标，根据Excel数据表中的数据按照计算式计算各特征点的坐标，绘制河道边线和中心线。绘制完成的河道断面如图1所示。