水电十四局

[摘要]本文介绍应用AutoCAD的VBA开发功能，从CAD中访问Excel电子表格的测量断面数据，并自动绘制测量断面图的方法。
[关键词]VBA Excel CAD 测量断面 绘图
水利水电工程施工中，测量断面的绘制是测量内业处理的主要工作。九十年代以前，测量断面都是在米厘纸上手工绘制，其工作量之大是可想而知的，且往往因为数据繁杂而出现差错。特别是断面面积的计算，无论是图解法还是用求积仪测量，都存在速度慢、误差大的弊端。随着AutoCAD辅助设计软件的普及应用，断面图绘制及工程量计算方法已经进入到一个新的阶段，许多工作可以借助CAD的命令功能完成。但一般的绘图方法还是需要许多人工干预操作，主要是坐标系定义、点坐标输入等，应用VBA的开发功能可以实现直接访问数据，自动成图。
VBA是VisualBasicforApplication的缩写，微软系列软件与AutoCAD都集成了这种开发工具，这就为应用VBA程序实现EXCEL到CAD之间的数据通讯成为可能，下面详细阐述用VBA编写测量断面绘制程序的方法。
一、程序设计思路
测量的断面数据传输到电脑后，将其转换为Excel电子表格的数据格式,假设断面数据最终成果的格式如下图所示：

(见附图1)
按上图格式，每个断面n个数据点。首先，程序要判断一个断面数据的开始和结束行号，根据以上数据特征，选择C列的点号作为判断条件，程序从第3行访问EXCEL数据表格的C列，如内容为“1”，则判断为一个新的断面数据起始行，同时读取此行的B列数据作为判断设计开挖线体形的参数，A列数据作为标注桩号的文本内容。并根据判断的断面体形，依次读取B列以下几行作为绘制设计开挖线的绘图参数，圆形断面的参数为圆心高程、半径，城门形断面的参数为底板高程、顶拱半径、洞宽及洞高。然后读取C列、D列实测数据，用于实测断面线的绘制。程序循环执行，并连续访问C列，为“1”则开始一个新断面，为空则认为没有数据，结束运行。每个断面图绘制设计线、实测线、断面中心线，并注释出桩号、高程、及实测断面的面积，以便用于工程量的计算。
根据以上分析，本程序的流程图如下：
（见附图2）
二、程序代码编写
1．主要功能实现
（1）、对EXCEL单元格数据的引用
对EXCEL单元格数据引用，包括以只读方式打开文件、读取指定工作表单元格的数据、完成后关闭文件等步骤，代码如下：
DimExcelAppAsNewExcel.Application
ExcelApp.Workbooks.Open“文件路径/文件名.xls”,,ReadOnly
WithExcelApp.ActiveWorkbook.Worksheets("sheet1")
……
.range(“列标”&行号)
……
EndWith
ExcelApp.Workbooks.Close
ExcelApp.Quit
引用EXCEL文件前，先要进行设置，打开VB编辑器“工具”菜单下的“引用”子菜单窗口，在“可使用的引用”中勾选“MicrosoftExcel11.0ObjectLibrary”（根据EXCEL的版本可能略有不同）一项。对单元格数据的引用采用.range(“列标”&行号)的格式，如对C列3行单元格C3的数据引用格式为“.range(“C”&3)”，行号可以以变量表示，可以通过改变变量的值来实现访问不同的行。
（2）、实测断面线的绘制
实测断面线绘制采用CAD中多段线绘制的方法：
Set　线段名＝ThisDrawing.ModelSpace.AddLightWeightPolyline(数组名)
线段名与数组名均要先定义，数组为一维数组，用于存储断面测量数据，其下标值与调用关系如下：设定义数组为pt1(0~k),则生成多段线时，第一点X、Y的坐标取pt1(0)、pt1(1)，第二点X、Y的坐标取pt1(2)、pt1(3)，以此类推，当要求断面封闭时，还应多定义两个数，并使最终两个数的值与起始两个数的值相同，即pt1(k-1)=pt1(0),pt1(k)=pt1(1)。由此可知，断面测点数为n时，定义数组下标值应为2n+1。由于事先不知道每个断面的点数，数组初始定义成动态数组，并增加判断点数的代码，获取下标值后重新定义。另外，坐标数据在EXCEL电子表格中的位置是D列和E列，给数组赋值时，先把D列的X坐标赋值给数组（下标从0开始）,数组下标加1,再把E列的Y坐标赋值给数组,数组下标加1,行号加1,同样方法进行下一行数据赋值。
（3）、其它
城门形设计线由分别绘制一条多段线和一段弧线组成，绘制弧线的参数有圆心坐标值、半径、起始方位角、终边方位角(角度单位采用弧度)，可以通过计算获得。
面积标注直接引用多段线的Area属性作为文本内容，桩号与高程直接从EXCEL工作表单元格数据中获取作为文本内容，文本的位置由相对关系计算得到。
另外，程序中变量i用来标识当前行号，增加判断断面点数代码时，必须暂存i值(用变量p,即为p=i)，在代码结束后恢复i值（i=p）。
各断面图中心X坐标用变量X表示，断面间间距取15，每绘制完成一个断面，均计算X=X+15，使下一断面中心X坐标增加15。
点的坐标直接在赋值时，根据断面中心点坐标进行修正，省去坐标转换的步骤。
2．全部程序清单如下
Sub DMCT()
Dim ExcelApp As New Excel.Application
ExcelApp.Workbooks.Open " 路径\断面测量数据文件名.xls", , ReadOnly
Dim i As Integer
Const pi = 3.1415926
Dim p As Integer
p = 3
Dim mytxt As AcadTextStyle
Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
mytxt.fontFile = "c:\windows\fonts\simfang.ttf"
ThisDrawing.ActiveTextStyle = mytxt
With ExcelApp.ActiveWorkbook.Worksheets("sheet1")
Dim X As Integer
X = 0
Do
i = p
If .Range("c" & i) = 1 Then
Dim line1 As AcadLine
Dim line2 As AcadLine
Dim line1start(2) As Double
Dim line1end(2) As Double
Dim line2start(2) As Double
Dim line2end(2) As Double
Dim insertpoint1(2) As Double
Dim insertpoint2(2) As Double
Dim center(0 To 2) As Double
Dim radiu As Double
Dim text1 As AcadText
Dim textstring1 As String
Dim height1 As Double: height1 = 1
Dim text2 As AcadText
Dim textstring2 As String
Dim height2 As Double: height2 = 0.5
Dim text3 As AcadText
Dim textstring3 As String
Dim insertpoint3(2) As Double
textstring1 = .Range("A" & i)
textstring3 = "EL" & .Range("b" & (i + 1))
If .Range("b" & i) = "圆" Then
Dim circle1 As AcadCircle
center(0) = X
center(1) = 0
radiu = .Range("b" & (i + 2))
h = .Range("b" & (i + 1))
hei = 2 * radiu
h1 = center(1)
Set circle1 = ThisDrawing.ModelSpace.AddCircle(center, radiu)
End If
If .Range("b" & i) = "城门形" Then
radiu = .Range("b" & (i + 2))
hei = .Range("b" & (i + 4))
h = .Range("b" & (i + 1)) + hei / 2
w = .Range("b" & (i + 3))
hei2 = radiu - hei / 2
Dim arc1 As AcadArc
Dim pt2(7) As Double
Dim pl1 As AcadLWPolyline
Dim starta As Double
Dim enda As Double
pt2(0) = X - w / 2
pt2(1) = Sqr(radiu * radiu - (w / 2) * (w / 2)) - hei2
pt2(2) = X - w / 2
pt2(3) = -(hei - radiu + hei2)
pt2(4) = X + w / 2
pt2(5) = -(hei - radiu + hei2)
pt2(6) = X + w / 2
pt2(7) = pt2(1)
h1 = pt2(3)
Set pl1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt2)
center(0) = X
center(1) = -hei2
T = (w / 2) / radiu
starta = Atn(-T / Sqr(-T * T + 1)) + 2 * Atn(1)
enda = pi - starta
Set arc1 = ThisDrawing.ModelSpace.AddArc(center, radiu, starta, enda)
End If
line1start(0) = center(0) - radiu / 10
line1start(1) = center(1)
line1end(0) = center(0) + radiu / 10
line1end(1) = center(1)
line2start(0) = center(0)
line2start(1) = -hei / 4 * 3
line2end(0) = center(0)
line2end(1) = hei / 4 * 3
insertpoint1(0) = line2start(0) - height2 * 3
insertpoint1(1) = line2start(1) - height2 * 2
insertpoint2(0) = line2end(0) + radiu / 2
insertpoint2(1) = line2end(1) - radiu / 3
insertpoint3(0) = center(0) + height2 / 2
insertpoint3(1) = h1
Set line1 = ThisDrawing.ModelSpace.AddLine(line1start, line1end)
line1.Linetype = "center"
Set line2 = ThisDrawing.ModelSpace.AddLine(line2start, line2end)
line2.Linetype = "center"
End If
j = 1
k = i
Dim plineobj As AcadLWPolyline
Dim pt1() As Double
Do
If .Range("c" & i + 1) = "" Or .Range("c" & (i + 1)) = 1 Then
ReDim pt1(j + 2)
Exit Do
End If
i = i + 1
j = j + 2
Loop
i = k
k = 0
Do
pt1(k) = .Range("D" & i) + X
k = k + 1
pt1(k) = .Range("E" & i) - h
k = k + 1
i = i + 1
p = i
If .Range("c" & i) = "" Or .Range("c" & i) = 1 Then Exit Do
Loop
pt1(k) = pt1(0)
pt1(k + 1) = pt1(1)
Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt1)
plineobj.Linetype = "dashed"
textstring2 = "实际开挖面积" & Round(plineobj.Area, 3) & "m2"
Set text1 = ThisDrawing.ModelSpace.AddText(textstring1, insertpoint1, height1)
Set text2 = ThisDrawing.ModelSpace.AddText(textstring2, insertpoint2, height2)
Set text3 = ThisDrawing.ModelSpace.AddText(textstring3, insertpoint3, height2)
X = X + 20
If .Range("c" & i) = "" Then Exit Do
Loop
End With
ExcelApp.Workbooks.Close
ExcelApp.Quit
ThisDrawing.Application.Update
ZoomAll
End Sub
三、程序运行
根据以上程序代码及断面数据文件（断面数据以圆形和城门形各一个为例），程序运行后得到以下断面成果图：

( 见附图三）
需要注意的是，在运行程序前，当前文本样式需设置为一种含中文字体的样式，并手动加载名为“center”和“dashed”的线型，否则在运行过程中，会出现找不到线型的错误，或者结果中汉字以乱码显示；另外还包括其它未完善的地方，如尺寸标注、各类注释、工程量计算表等等。这些不足之处，都可以用程序代码得到解决，让程序自动生成符合出图要求的测量断面图，因篇幅有限，在此不再赘述,有兴趣的读者可以自己补充完善。

结束语
按照以往的工作经验，不含整理数据的时间，在CAD中绘制十个断面图大概要一天的时间，而用程序功能，这一过程可在一分钟内完成。而且程序一旦调试正确，工作过程完全由电脑执行，避免了人工操作可能带来的错误，相应减少了资料审核、检查的时间。可见，应用VBA功能，开发针对于断面绘图的程序，能大大降低测量内业处理的劳动强度、提高工作效率，并保证了成果资料的质量。同时也要认识到，VBA的开发，可应用于其它更广阔的领域。

[ 本帖最后由 huerfei008 于 2009-9-22 11:36 编辑 ]