EXCEL-VBA结合CAD自动实现线路展点

张仕林

(中铁大桥局集团第二工程有限公司，江苏南京　210015)

Using the Combining of EXCEL-VBA and CAD to realize automatic points drawing

ZHANG Shi-lin

EXCEL-VBA结合CAD自动实现线路展点

张仕林

(中铁大桥局集团第二工程有限公司，江苏南京210015)

Using the Combining of EXCEL-VBA and CAD to realize automatic points drawing

ZHANG Shi-lin

摘要Excel VBA是寄生于运用广泛的微软软件Microsoft Office中执行通用自动化程序的编程语言，有强大的数据处理能力，集统计、计算等功能与一身，能够提供与其他软件交互的接口，具有友好的交互功能。介绍如何运用EXCEL中的宏语言(即VBA)编写程序来计算线路坐标并自动在不同版本的autoCAD软件中展绘点位。该方法可以避免在CAD中逐个绘制点位时可能的错误输入，亦可批量展绘线路计算点，提高测绘工作的准确性和工作效率。

关键词EXCEL VBAautoCAD线路自动展点

在公路、铁路、水运、管道等线路工程测绘工作中，往往需要将大量的线路点位数据通过各种方式进行计算并在CAD中展绘成形象且直观的平面图形，为后续施工做好数据准备。测量是一项系统、复杂，而又相对单调、繁琐的工作，高强度的重复手工计算、输入数据往往会造成错误，进而影响施工质量，甚至造成不可估量的损失。需要一种精确、高效的数据计算和成图方法来避免因测量数据错误而造成的损失。EXCEL是当前运用十分广泛的办公软件之一，不仅具有十分强大的表格函数，而且具有良好的二次开发功能。CAD亦是工程领域运用十分广泛的成图软件，使用CAD绘制的平面图形具有形象直观的特点，方便查询与检核各工程结构的相对位置关系。

本文所阐述的快速展点方法，是利用excel电子表格与测量平面坐标(二维)相适应的特性，利用积木法计算线路的设计中(边)桩坐标，然后利用excel VBA打开或新建CAD文件，并且根据提示选取绘图所需的原始数据区域，并对点的样式、颜色等特性进行设置，实现快速绘制点位图。该方法在windows操作系统下的excel2007及CAD2004及CAD2008中验证通过。

1基本思路与方法

对设计单位提供的原始线路设计数据进行核实与录入excel表格，并利用积木法计算出所需里程对应的中桩点(中桩点计算完成后也可以不同边距边桩点的计算)，然后在交互界面中根据用户选择新建或者利用已有CAD图形文件来实现展点绘图。

将新建工作簿的工作表Sheet1重命名为“平面数据”，并在对应的单元格中录入设计单位提供的线路设计参数，录入完成后的效果如表1所示。

表1　设计参数录入

录入数据时需要注意的是，线路转角(偏角)左转时为负值，右转时为正值。

2坐标计算

将工作簿的工作表Sheet2重命名为“积木元素”，制作如表2所示。

特征点计算完成以后，新建一张工作表，命名为“坐标高程计算”，需要完成后续任一点里程坐标及方位角的计算。计算时，利用excel电子表格现有的二维平面数组，利用数组公式，计算并存储中间变量，任意里程的坐标值计算源码如下：

表2　积木元素特征点计算

Option Explicit

Public Sub CentCordCal2()’线路中心坐标计算主程序

Dim V， R

Dim CalLCsz， Startlcsz， Endlcsz’定义里程数组

Dim Startqlsz， Endqlsz， StartDFwjsz， StartFwjsz， QLcsz’定义曲率，方位角数组

Dim StartXYsz

Dim Calxysz

Dim MaxlcAs Double， Minlc As Double

Dim SjlcnumAs Long， Callcnum As Long

Dim NumAs Long， Calnum As Long

Dim iAs Long， j As Long， k As Byte

Dim LCc， LS

Dim Calqlsz， CalFwjsz

Dim SumX， SumY

On Error Resume Next

V=Array(0.046910077， 0.2307653449， 0.5， 0.7692346551， 0.953089923)

R=Array(0.1184634425， 0.2393143352， 0.2844444444， 0.2393143352， 0.1184634425) ’常量数组赋值

Worksheets("积木元素").Activate

With Worksheets("积木元素")

Num=.Range("B" &Rows.Count).End(xlUp).Row’获取交点个数

ReDimStartlcsz(1 To Num)

ReDimEndlcsz(1 To Num)

ReDimStartqlsz(1 To Num)

ReDimEndqlsz(1 To Num)

ReDimStartDFwjsz(1 To Num)

ReDimStartFwjsz(1 To Num)

ReDimQLcsz(1 To Num)

ReDimStartXYsz(1 To 2， 1 To Num) ’重新定义各个已知数据数组，并指定数组的维数

Startlcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 3)， Cells(Num， 3)))

Startqlsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 4)， Cells(Num， 4)))

StartDFwjsz=Application.WorksheetFunction.Transpose(.Range(Cells(4，5)，Cells(Num， 5)))

StartXYsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 6)， Cells(Num， 7)))

Endlcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 9)， Cells(Num， 9)))

Endqlsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 10)， Cells(Num， 10)))

QLcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 11)， Cells(Num， 11)))

Maxlc=Application.WorksheetFunction.Max(.Range(Cells(4， 3)， Cells(Num， 3)))

Minlc=Application.WorksheetFunction.Min(.Range(Cells(4， 9)， Cells(Num， 9)))

’已知参数数组赋值

End With

Worksheets("坐标高程计算").Activate

For i=1 To UBound(Startlcsz)

StartFwjsz(i)=Application.WorksheetFunction.Radians(StartDFwjsz(i)) ’角度转换

Next

With Worksheets("坐标高程计算")

.Range(Cells(5， 2)， Cells(Rows.Count， 4)).ClearContents’清除区域内容

Calnum=.Range("A" &Rows.Count).End(xlUp).Row

If Calnum<=4 Then

MsgBox "缺少计算里程!"

Exit Sub

ElseIfCalnum=5 Then

ReDimCalLCsz(1 To 2)

CalLCsz(1)=.Range("A5")

CalLCsz(2)="--"

Else

ReDimCalLCsz(1 To Calnum-4)

CalLCsz=Application.WorksheetFunction.Transpose(.Range(Cells(5，1)， Cells(Calnum， 1)))

End If

ReDimCalxysz(1 To 2， 1 To UBound(CalLCsz))

ReDimCalqlsz(1 To UBound(CalLCsz))

ReDimCalFwjsz(1 To UBound(CalLCsz))

For i=1 To UBound(CalLCsz) ’循环判断计算的里程是否是有效数值

If IsNumeric(CalLCsz(i))=False Or Len(CalLCsz(i))=0 Or CalLCsz(i) >Maxlc Or CalLCsz(i)

Calxysz(1， i)="--"

Calxysz(2， i)="--"

CalFwjsz(i)="--"

Else

For j=1 To UBound(Startlcsz)

If CalLCsz(i) >Startlcsz(j) And CalLCsz(i) <=Endlcsz(j) Then

LCc=CalLCsz(i)-Startlcsz(j)

LS=Endlcsz(j)-Startlcsz(j)

SumX=0

SumY=0

For k=0 To 4’计算总的ΔX，ΔY

SumX=SumX+LCc * R(k) * Cos(StartFwjsz(j)+(Startqlsz(j) * V(k) * LCc+QLcsz(j) * V(k) ^ 2 * LCc ^ 2 / (2 * LS)))

SumY=SumY+LCc * R(k) * Sin(StartFwjsz(j)+(Startqlsz(j) * V(k) * LCc+QLcsz(j) * V(k) ^ 2 * LCc ^ 2 / (2 * LS)))

Next

Calxysz(1， i)=StartXYsz(1， j)+SumX

Calxysz(2， i)=StartXYsz(2， j)+SumY

CalFwjsz(i)=Application.WorksheetFunction.Degrees(StartFwjsz(j)+(Startqlsz(j)+QLcsz(j) * LCc / LS+Startqlsz(j)) * LCc / 2)

Exit For

ElseIfCalLCsz(i)=Startlcsz(j) Then

Calxysz(1， i)=StartXYsz(1， j)

Calxysz(2， i)=StartXYsz(2， j)

CalFwjsz(i)=StartDFwjsz(j)

Else

Calxysz(1， i)="--"

Calxysz(2， i)="--"

CalFwjsz(i)="--"

End If

Next

End If

Next

Application.ScreenUpdating=False

.Range(Cells(5，2)，Cells(UBound(CalLCsz)+4，3))=Application.WorksheetFunction.Transpose(Calxysz)

.Range(Cells(5，4)，Cells(UBound(CalLCsz)+4，4))=Application.WorksheetFunction.Transpose(CalFwjsz) ’计算结果显示在指定区域

End With

Application.ScreenUpdating=True

End Sub

计算结果如表3所示，出现“--”符号表示计算里程超出设计范围或者里程输入有误。

表3　坐标计算结果

3坐标展点

当线路设计中桩计算完成后，可以进行任意距离的边桩计算，并打开cad，自动展点。按ALT+F11打开VBE界面，点击“插入-模块”，将以下代码复制并黏贴到模块中，点击运行。

Option Explicit

Sub CadDraw()’利用cad画点主程序

Dim acadApp As Object’定义cad对象

Dim acadDoc As Object

Dim Drawxy

Dim Selrng As Range’定义需要绘图的表格区域

Dim Sopenfilename

Dim cell As Range

Dim Points(1 To 3) As Double’定义三维点

Dim i As Long

Dim AddNewfile As String

On Error Resume Next’忽略错误

Set acadApp=GetObject(， "AutoCAD.Application")’获取cad对象

If Err Then

Err.Clear

Set acadApp=CreateObject("AutoCAD.Application")’如果获取cad对象失败，则创建

If Err Then End

End If

AddNewfile=MsgBox("是否打开已有文件绘图？"， vbYesNo+vbQuestion+vbDefaultButton2， "选择操作")

If AddNewfile=vbYes Then

Sopenfilename=Application.GetOpenFilename("Dwg格式文件(*.dwg)，*.dwg"，， "请选择需要绘图的(*.dwg)格式文件"， MultiSelect:=False) ’打开已有dwg格式的文件

Set acadDoc=acadApp.Documents.Open(Sopenfilename) ’给cad对象赋值

Else

Set acadDoc=acadApp.Documents.Add’创建新的cad对象

End If

Set acadDoc=acadApp.ActiveDocument

acadApp.Visible=True

Do While Selrng.Columns.Count <> 2 Or Selrng.Rows.Count < 2 '循环选择绘图的数据区域，直至选择出正确区域为止

Set Selrng=Application.InputBox("选择XY的区域，X在前，Y在后"， "Select range"，，，，，，8)

If Selrng.Columns.Count <> 2 Or Selrng.Rows.Count < 2 Then

MsgBox "选择区域不对，请重新选择!" & Chr(13) & "注意选择的区域必须为两列(至少两行)，且X在前，Y在后!"

End If

Loop

For Each cell In Selrng

If IsNumeric(cell)=False Then’循环判断选择的单元格的值是否有效

MsgBox "选择的区域含有非法字符，不能绘图，请重试!"

Exit Sub

End If

Next cell

ReDim Drawxy(1 To 2， 1 To Selrng.Rows.Count)

Drawxy=Application.WorksheetFunction.Transpose(Selrng) ’绘图坐标数组赋值

For i=1 To UBound(Drawxy， 2)

Points(1)=Drawxy(2， i)

Points(2)=Drawxy(1， i)

Points(3)=0

acadDoc.ModelSpace.AddPoint Points’cad展点关键的代码

Next

acadDoc.Application.Update’cad界面更新

acadDoc.Save’保存cad文件

End Sub

代码首先预定义acadApp为对象，再利用后期绑定的方法定义为cad对象，便于利用cad的库进行后续的绘图，且可以利用程序对点的颜色、大小、形状以及图层等诸多特性进行设置，此处未展示源代码。由以上程序可见，只要实现录入设计图纸提供的线路参数，运行以上两个主程序，就可以准确、快速实现线路的坐标展点。

4结束语

随着Excel不断发展，其数据处理能力愈加强大，VBA也伴随着其一同发展，其良好的数据处理能力和用户交互界面将更大程度解决繁琐的数据计算。同时，CAD内置VBA，同样可以进行良好的运用，两者的有机结合和集成开发，其交互能力、数据处理能力将愈发强大，作用也会更为明显。

参考文献

[1]张正禄，等.工程测量学[M].武汉：武汉大学出版社，2005

[2]狄钢.AutoCAD VBA在工程测量中的应用[J].铁道勘察,2006(6)

[3]王建国,吴美容.运用ACAD VBA语言设计批量绘制隧道横断面软件[J].铁道勘察,2010(4)

[4]张帆，等.AutoCAD VBA二次开发教程[M].北京:清华大学出版社，2006

[5]罗刚君.Excel VBA程序开发自学宝典：第2版[M].北京：电子工业出版社，2009

中图分类号：P283.7

文献标识码：B

文章编号：1672-7479(2015)01-0036-04

作者简介：张仕林(1987—)，男，2010年毕业于长安大学测绘工程专业，助理工程师。

收稿日期：2014-11-15