ExcelVBA在工程测量上的应用

1、ExcelVBA在工程测量上的应用 Excel是大家很熟识的办公软件，信任大家在工作中常常使用吧。在测量工作中，你是否感觉到有很不便利的时候？比如，计算一个角度的三角函数值，而角度的单位是60进制的，此时，你一定感到很无奈，由于，Excel本身无法直接计算60进制的角度的三角函数！还有，倘若你的工作表中有了点坐标值（二维或者三维），要在CAD中展绘出来，怎样才干又快又直接？不然，就惟独拐弯摸角了，很疼痛啊！其实，只要对 Excel举行一些挖掘，就可以发觉Excel的功能我们还没有好好的利用呢。Excel本身供应了强大的二次开辟功能，只要我们认真的研究，没有什么能难倒我们的。下面，好好笔者将带你

2、走近Excel，认识它的强大的二次开辟环境VBAIDE，用它来解决上面所提到的问题，就十分简单了。 Excel是大家很熟识的办公软件，信任大家在工作中常常使用吧。在测量工作中，你是否感觉到有很不便利的时候？比如，计算一个角度的三角函数值，而角度的单位是60进制的，此时，你一定感到很无奈，由于，Excel本身无法直接计算60进制的角度的三角函数！还有，倘若你的工作表中有了点坐标值（二维或者三维），要在CAD中展绘出来，怎样才干又快又直接？不然，就惟独拐弯摸角了，很疼痛啊！其实，只要对 Excel举行一些挖掘，就可以发觉Excel的功能我们还没有好好的利用呢。Excel本身供应了强大的二次开辟功能

3、，只要我们认真的研究，没有什么能难倒我们的。下面，好好笔者将带你走近Excel，认识它的强大的二次开辟环境VBAIDE，用它来解决上面所提到的问题，就十分简单了。 初识VBAIDE，首先，你务必懂得一些容易的VB编程常识。倘若不懂就惟独通过其他的途径去学习了。但用不着深化的研究，只要静下心来，几个小时就可以了。 打开Excel，按Alt F11即进入VBAIDE，学过VB的人一看就知道那就是熟识的VB界面。下面看看如何定义一个函数，然后利用它来解决60进制的角度的三角函数计算问题。在菜单上依次点击插入-模块，然后输入如下代码 Public Const pi = 3Pu

4、blic 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 这样，就定义了一个名字叫DE

5、G的函数，它的作用就是转换60进制的角度为Excel认识的弧度。编辑完后按Alt Q即返回Excel，再在某一单元格输入=sin(deg(A1)(A1既可以是单元格的值,也可以是输入的角度值),回车，哈哈，怎么样？结果出来了吧？你可以用计算器检验一下是否正确。倘若消失#NAME？那就要设置一下平安设置。依次点工具-宏-平安性，在平安级选项卡上抉择中或者低，然后关闭后重新打开就可以了，以后只要是60进制的角度，就用它转换，十分便利哦。 工程测量中，常常遇到导线的计算，倘若手头没有平差计算程序就惟独手工计算了，这时候你曾经想过编个小程序来计算？其实，这很容易，笔者在宛坪（上海至武威）高速大路上做测

6、量监理，由于有大量的导线需要复核，故编写了一个附合导线计算程序，代码很容易，但很有用。下面是该程序的代码： 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(

7、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)

8、 * 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, #.#) s

9、ht.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

10、- 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

11、.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 RA

12、D = (C A B / 100) * F End Function 值得留意的是，前面提到的DEG函数别遗忘加进去。 倘若自己定义一个名字叫计算的按钮，指定此工具的宏为单一附合导线计算，那么，只要按下面的格式输入原始数据（斜体是输入的），点计算就可以得到计算结果了。全部的过程都是自动的，无须再手工填写，是不是很便利？ 下面我们就来解决上面提到的与CAD的衔接和通讯问题。 进入VBAIDE，按工具-引用,找到可使用的引用，在AutoCAD2000类型库的左边打钩，点决定就行了。在模块中输入以下代码： Global Sheet As Object, acadmtext As acadmtext,

13、 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 t

14、ext1 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 Get_ACAD(Dwt As String) As Boolean Dim YER As Integer On Error Resume Next Set acadApp = GetObject(, AutoCAD.Application) If Err Then Err.Clear Set acadApp = Crea

15、teObject(AutoCAD.Application) If Err Then MsgBox Err.Description On Error GoTo 0 Get_ACAD = False Exit Function End If End If On Error GoTo 0 Set acadDoc = acadApp.ActiveDocument acadApp.Visible = True Get_ACAD = True Dim typeFace As String Dim Bold As Boolean Dim Italic As Boolean Dim charSet As Long Dim PitchandFamily As Long acadDoc.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily acadDoc.ActiveTextStyle.SetFont 宋体, Bold, Italic, charSet, PitchandFamily End Function Sub 显示对话框() Form1.Show (0) End Sub Public Function Draw_Point(Point() As Double) As acadPoint Set D