VBA和Excel在工程测量中的应用

摘要：本文讨论了VBA和Excel在工程测量上的应用，通过导线计算和角度转换的例子，详细介绍了VBA在 Excel中如何实现的原理，并通过一个简单的例子来详细的描述其实现过程。

关键词：VBA 、Excel、宏、二次开发功能、工程测量 、导线、CAD与Excel。

中图分类号：E271文献标识码： A

引言

各行各业使用计算机工作就更离不开Excel工作表的计算功能，而且Excel的二次开发功能非常强大，它通过VBA语言开发程序分发很容易，只要电脑中有Excel，基本不需要在其它的文件，简简单单的复制与粘贴，就完成了文件的分发。VBA功能非常实用，合理有效的开发利用可以大大的提高生产效率。

一、了解Excel 和VBA

（一）Excel 和 VBA的基本知识C

VBA是以VB语言为基础，经过修改并运行在Microsoft Office的应用程序，如Excel，Word中，它是不能像VB一样能生成可执行程序的。VBA的语言是相对容易学的语言，很容易上手，如果你熟悉VB，那你发现它们在语言方面是相通的，而如果你对Excel比较了解，那你也就很容易理解Excel的各种服务对象了。利用Excel和VBA为平台，开发出来的电子数据表即称Excel应用程序。

二、Excel 和VBA可以解决测量中的哪些问题

（一）Excel的功能

Excel在测量工作中是用的比较多的，遗憾的是，它计算三角函数采用的是弧度或者是十进制的角度，而我们测量上的角度却是60进制的，更要命的是Excel也没有弧度与60进制的角度的转换函数。在许多工程测量外业工作中通常要现场作导线闭合差计算，用我们的Excel和VBA功能就可以轻松完成。2．CAD与Excel连接。如果你的工作表中有了点坐标值（二维或者三维），要在CAD中展绘出来，怎样才能直接调用CAD将它展绘出来？不然，就只有借助第三方软件来实现了。就目前我们常用的软件中有一款CASS软件，是南方公司在CAD平台上开发的绘图软件，但这也要先把Excel表格坐标转化为CASS格式的dat文件格式，然后才能用CASS的绘图工具中“展野外测点点号”的命令完成图上展点。如果你手头又找不到CASS软件，这就很麻烦！这时我们用Excel和VBA功能便可以轻松完成。再者，现在的工程测量中用国外的全站仪比较多，好多国外生产全站仪输入已知放样坐标数据时都是用excel格式，数据过多时，就不能手动输入，那样太耽误时间而且容易出错，这时我们自己编写的Excel程序就可以实现数据自动传输。

（二）了解Excel应该从哪里入手

1．首先，你必须懂得一些简单的VB编程常识。如果不懂就只有通过其他的途径去学习了。但用不着深入的研究，只要静下心来，简单的常用语句几个小时就可以学会了。

2．多看Excel中的帮助系统，那里有非常丰富的例子，相信只要有电脑的用户，都知道该怎样查找和学习的，这里不再赘述。

三、如何使用Excel及例子

（一）如何使用Excel

打开Excel，按Alt+F11即进入VBAIDE，学过VB的人一看就知道VBAIDE界面和VB界面是非常相似的。下面看看如何定义一个函数，然后利用它来解决60进制的角度的三角函数计算问题。在菜单上依次点击[插入] ->[模块]，然后输入如下代码：

Public Const pi = 3.14159265359

Public Function DEG(n As Double)

Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, KA As Double

D = Abs(n) + 0.000000000000001

F = Sgn(n)

A = Int(D)

B = Int((D - A) * 100)

C = D - A - B / 100

DEG = F * (A + B / 60 + C / 0.36) * pi / 180

End Function

这样，就定义了一个名字叫DEG的函数，它的作用就是转换60进制的角度为Excel认识的弧度。编辑完后按Alt+Q即返回Excel，再在某一单元格输入=sin(deg(A1))(A1既可以是单元格的值,也可以是手工输入的角度值),回车，哈哈，怎么样？结果出来了吧？你可以用计算器检验一下是否正确。如果出现#NAME？那就要设置一下安全设置。依次点[工具]->[宏]->[安全性]，在安全级选项卡上选择“中”或者“低”，然后关闭后重新打开就可以了，以后只要是60进制的角度，就用它转换，非常方便哦。

（二）EXCEL现场编程使用示例及与CAD的通讯

工程测量中，经常碰到导线的现场平差计算，如果手头没有平差计算程序就只有手工计算了，这时候你可曾想过编个小程序来计算？其实，这很简单，下面是该程序的代码:

Sub附合导线计算()

Dim m As Integer, n As Integer, ms As Double, gg As Double, sht As Object, xx As Double, yy As Double, S As Double

Set sht = ThisWorkbook.ActiveSheet

Do While sht.Cells(m + 3, 4) ""

m = m + 1

Loop

For n = 3 To m + 2

ms = DEG(ms) + DEG(sht.Cells(n, 4))

ms = RAD(ms)

S = S + sht.Cells(n, 3)

Next

ms = DEG(ms)

gg = RAD(DEG(sht.Cells(3, 5)) + ms - DEG(sht.Cells(3 + m, 5)) - pi * m)

xx = 0: yy = 0

For n = 4 To m + 2

'方位角

sht.Cells(n, 5) = RAD(DEG(sht.Cells(n - 1, 5)) + DEG(sht.Cells(n - 1, 4)) - pi - DEG(gg) / m)

'坐标增量

sht.Cells(n, 6) = Format(sht.Cells(n - 1, 3) * Cos(DEG(sht.Cells(n, 5))), "#####.####")

sht.Cells(n, 7) = Format(sht.Cells(n - 1, 3) * Sin(DEG(sht.Cells(n, 5))), "#####.####")

'坐标增量和

xx = xx + sht.Cells(n, 6)

yy = yy + sht.Cells(n, 7)

Next

xx = xx + sht.Cells(3, 10) - sht.Cells(m + 2, 10)

yy = yy + sht.Cells(3, 11) - sht.Cells(m + 2, 11)

sht.Cells(m + 4, 5) = "α=" & Format(gg, "###.######")

sht.Cells(m + 4, 6) = "X=" & Format(xx, "###.###")

sht.Cells(m + 4, 7) = "Y=" & Format(yy, "###.###")

sht.Cells(m + 4, 3) = "∑S=" & Format(S, "###.###")

sht.Cells(m + 4, 9) = "S=" & Format(Sqr(xx * xx + yy * yy), "###.###")

sht.Cells(m + 4, 10) = "相对精度 1/" & Format(S / Sqr(xx * xx + yy * yy), "######")

For n = 4 To m + 2

sht.Cells(n, 8) = Format(xx / S * sht.Cells(n - 1, 3), "###.####")

sht.Cells(n, 9) = Format(yy / S * sht.Cells(n - 1, 3), "###.####")

Next

For n = 4 To m + 1

sht.Cells(n, 10) = sht.Cells(n - 1, 10) + sht.Cells(n, 6) - sht.Cells(n, 8)

sht.Cells(n, 11) = sht.Cells(n - 1, 11) + sht.Cells(n, 7) - sht.Cells(n, 9)

Next

Columns("F:K").Select

Selection.NumberFormatLocal = "0.000_ "

End Sub

Public Function RAD(Nu As Double) As Double

Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, p As Double

D = Abs(Nu)

F = Sgn(Nu)

p = 180# / pi

G = p * 60#

A = Int(D * p)

B = Int((D - A / p) * G)

W = B

C = (D - A / p - B / G) * 20.62648062

RAD = (C + A + B / 100) * F

End Function

值得注意的是，前面提到的DEG（）函数别忘记加进去。

如果自己定义一个名字叫“导线计算”的按钮，指定此工具的宏为“单一附合导线计算”，那么，只要按下面的格式输入原始数据（斜体是输入的），点“计算”就可以得到计算结果了。所有的过程都是自动的，无须再手工填写，是不是很方便？

下面我们就来解决excel与CAD的连接和通讯问题。

进入VBAIDE，按[工具]->[引用],找到可使用的引用，在“AutoCAD2000类型库”的左边打钩，点确定就行了。在模块中输入以下代码，主要是一些需要用到的变量定义：

Dim p0(2) As Double, p1(2) As Double, p2(2) As Double

Dim T1 As Double, T2 As Double, T3 As Double, T4 As Double

Public ne As Integer, sp As Single, cz As Single

Global Sheet As Object, acadmtext As acadmtext, fontHight As Double

Global xlBook As Excel.Workbook

Global p0(2) As Double, p1(2) As Double, p2(2) As Double

Global acadApp As AcadApplication

Global acadDoc As AcadDocument

Global acadPoint As acadPoint

Global number As Integer

Public Type pt

n As Integer

pt(2) As Double

Global pt() As pt

Global text1 As AcadText

Global CAD As Object

Global p(2) As Double, i As Integer, j As Integer

Global h As Integer, l As Integer

Public Function Draw_Point(Point() As Double) As acadPoint

Set Draw_Point = acadDoc.ModelSpace.AddPoint(Point)

Draw_Point.Update

End Function

Public Sub Set_layer(s As String)

Dim layerObj As AcadLayer

Set layerObj = acadDoc.Layers.Add(s)

acadDoc.ActiveLayer = layerObj

End Sub

再做个对话框：窗体的名字就叫“Form1”

文本框的名称改为TextBox，CAPTIONS属性改为”展点”

按钮的名称改为ZD，text属性改为3.

当然，你在Excel上同样可以再加个工具按钮，比如叫“展点”，指定宏为“显示对话框”，只要你的Excel有了X,Y或者X,Y，Z（格式如下表），点击“展点” 就可以自动启动A utoCAD展点啦！如果A utoCAD已经启动,就直接在已经打开的A utoCAD文档中展点，展点完毕后，会显示一个对话框，提示“展点完毕“，再切换到A utoCAD看看，你所要展的点是否已经出现了？如果有点号,还可以显示点号，并且可以输入字体的高度。

坐标格式，其中第一列为点名，第二列为编码（可以为空），第三列为X，第四列为Y，第五列为高程。注意，X，Y是A utoCAD的横坐标和纵坐标，与测量坐标系是正好相反的。

四、结束语

Excel的功能是非常强大的，如果有兴趣，你还可以在A utoCAD中直接与Excel通讯，比如一条三维多段线的所有结点的三维坐标直接导入到Excel，比在A utoCAD中用列表的方法要方便的多，将上述代码稍加修改，把他移植到CADIDE中去，可以直接在CAD中调用活动的Excel文档数据进行展点。其实，只要对 Excel进行一些挖掘，就可以发现Excel的功能我们还没有好好的利用呢。Excel本身提供了强大的二次开发功能，只要我们仔细的研究，我们在工作中遇到的许多问题都是可以很容易解决的。

参考文献

[1] 曾洪飞，张帆，卢择临，《AutoCAD VBA & 开发基础与实例教程》 （中国电力出版社,2008年02月）

[2] 佟彪,《VB语言与测量程序设计》（中国电力出版社,2007年08月）

[3] 杨晓亮 ,《 Word VBA高效排版范例应用》（ 电子工业出版社,2006年08月）

[4] 伍云辉,《完全手册--Excel VBA办公应用开发详解》（电子工业出版社2008年01