Excel VBA在工程測(cè)量上的應(yīng)用摘要：Excel是大家很熟悉的辦公軟件，相信大家在工作中經(jīng)常使用吧。在測(cè)量工作中，你是否感覺(jué)到有很不方便的時(shí)候？比如，計(jì)算一個(gè)角度的三角函數(shù)值，而角度的單位是60進(jìn)制的，此時(shí)，你一定感到很無(wú)奈，因?yàn)?，Excel本身無(wú)法直接計(jì)算60進(jìn)制的角度的三角函數(shù)！還有，如果你的工作表中有了點(diǎn)坐標(biāo)值（二維或者三維），要在CAD中展繪出來(lái)，怎樣才能又快又直接？不然，就只有拐彎摸角了，很痛苦??！其實(shí)，只要對(duì) Excel進(jìn)行一些挖掘，就可以發(fā)現(xiàn)Excel的功能我們還沒(méi)有好好的利用呢。Excel本身提供了強(qiáng)大的二次開(kāi)發(fā)功能，只要我們仔細(xì)的研究，沒(méi)有什么能難倒我們的。下面，好好筆者將帶你走近Excel，認(rèn)識(shí)它的強(qiáng)大的二次開(kāi)發(fā)環(huán)境VBAIDE，用它來(lái)解決上面所提到的問(wèn)題，就非常容易了。 關(guān)鍵詞：Excel VBA 工程測(cè)量 Excel是大家很熟悉的辦公軟件，相信大家在工作中經(jīng)常使用吧。在測(cè)量工作中，你是否感覺(jué)到有很不方便的時(shí)候？比如，計(jì)算一個(gè)角度的三角函數(shù)值，而角度的單位是60進(jìn)制的，此時(shí)，你一定感到很無(wú)奈，因?yàn)椋珽xcel本身無(wú)法直接計(jì)算60進(jìn)制的角度的三角函數(shù)！還有，如果你的工作表中有了點(diǎn)坐標(biāo)值（二維或者三維），要在CAD中展繪出來(lái)，怎樣才能又快又直接？不然，就只有拐彎摸角了，很痛苦??！其實(shí)，只要對(duì) Excel進(jìn)行一些挖掘，就可以發(fā)現(xiàn)Excel的功能我們還沒(méi)有好好的利用呢。Excel本身提供了強(qiáng)大的二次開(kāi)發(fā)功能，只要我們仔細(xì)的研究，沒(méi)有什么能難倒我們的。下面，好好筆者將帶你走近Excel，認(rèn)識(shí)它的強(qiáng)大的二次開(kāi)發(fā)環(huán)境VBAIDE，用它來(lái)解決上面所提到的問(wèn)題，就非常容易了。初識(shí)VBAIDE，首先，你必須懂得一些簡(jiǎn)單的VB編程常識(shí)。如果不懂就只有通過(guò)其他的途徑去學(xué)習(xí)了。但用不著深入的研究，只要靜下心來(lái)，幾個(gè)小時(shí)就可以了。打開(kāi)Excel，按Alt+F11即進(jìn)入VBAIDE，學(xué)過(guò)VB的人一看就知道那就是熟悉的VB界面。下面看看如何定義一個(gè)函數(shù)，然后利用它來(lái)解決60進(jìn)制的角度的三角函數(shù)計(jì)算問(wèn)題。在菜單上依次點(diǎn)擊插入­­­­->模塊，然后輸入如下代碼Public Const pi = 3ublic 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 DoubleD = Abs(n) + 0.000000000000001F = Sgn(n)A = Int(D)B = Int(D - A) * 100)C = D - A - B / 100DEG = F * (A + B / 60 + C / 0.36) * pi / 180End Function這樣，就定義了一個(gè)名字叫DEG的函數(shù)，它的作用就是轉(zhuǎn)換60進(jìn)制的角度為Excel認(rèn)識(shí)的弧度。編輯完后按Alt+Q即返回Excel，再在某一單元格輸入=sin(deg(A1)(A1既可以是單元格的值,也可以是輸入的角度值),回車，哈哈，怎么樣？結(jié)果出來(lái)了吧？你可以用計(jì)算器檢驗(yàn)一下是否正確。如果出現(xiàn)#NAME？那就要設(shè)置一下安全設(shè)置。依次點(diǎn)工具->宏->安全性，在安全級(jí)選項(xiàng)卡上選擇“中”或者“低”，然后關(guān)閉后重新打開(kāi)就可以了，以后只要是60進(jìn)制的角度，就用它轉(zhuǎn)換，非常方便哦。工程測(cè)量中，經(jīng)常碰到導(dǎo)線的計(jì)算，如果手頭沒(méi)有平差計(jì)算程序就只有手工計(jì)算了，這時(shí)候你曾經(jīng)想過(guò)編個(gè)小程序來(lái)計(jì)算？其實(shí)，這很簡(jiǎn)單，筆者在宛坪（上海至武威）高速公路上做測(cè)量監(jiān)理，因?yàn)橛写罅康膶?dǎo)線需要復(fù)核，故編寫(xiě)了一個(gè)附合導(dǎo)線計(jì)算程序，代碼很簡(jiǎn)單，但很實(shí)用。下面是該程序的代碼：Sub附合導(dǎo)線計(jì)算()Dim m As Integer, n As Integer, ms As Double, gg As Double, sht As Object, xx As Double, yy As Double, S As DoubleSet sht = ThisWorkbook.ActiveSheetDo While sht.Cells(m + 3, 4) <> m = m + 1LoopFor n = 3 To m + 2ms = DEG(ms) + DEG(sht.Cells(n, 4)ms = RAD(ms)S = S + sht.Cells(n, 3)Nextms = DEG(ms)gg = RAD(DEG(sht.Cells(3, 5) + ms - DEG(sht.Cells(3 + m, 5) - pi * m)xx = 0: yy = 0For 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)坐標(biāo)增量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), #.#)坐標(biāo)增量和xx = xx + sht.Cells(n, 6)yy = yy + sht.Cells(n, 7)Nextxx = 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) = 相對(duì)精度 1/ & Format(S / Sqr(xx * xx + yy * yy), #)For n = 4 To m + 2sht.Cells(n, 8) = Format(xx / S * sht.Cells(n - 1, 3), #.#)sht.Cells(n, 9) = Format(yy / S * sht.Cells(n - 1, 3), #.#)NextFor n = 4 To m + 1sht.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 SubPublic Function RAD(Nu As Double) As DoubleDim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double, p As DoubleD = Abs(Nu)F = Sgn(Nu)p = 180# / piG = p * 60#A = Int(D * p)B = Int(D - A / p) * G)W = BC = (D - A / p - B / G) * 20.62648062RAD = (C + A + B / 100) * FEnd Function值得注意的是，前面提到的DEG函數(shù)別忘記加進(jìn)去。如果自己定義一個(gè)名字叫“計(jì)算”的按鈕，指定此工具的宏為“單一附合導(dǎo)線計(jì)算”，那么，只要按下面的格式輸入原始數(shù)據(jù)（斜體是輸入的），點(diǎn)“計(jì)算”就可以得到計(jì)算結(jié)果了。所有的過(guò)程都是自動(dòng)的，無(wú)須再手工填寫(xiě)，是不是很方便？下面我們就來(lái)解決上面提到的與CAD的連接和通訊問(wèn)題。進(jìn)入VBAIDE，按工具->引用,找到可使用的引用，在“AutoCAD2000類型庫(kù)”的左邊打鉤，點(diǎn)確定就行了。在模塊中輸入以下代碼：Global Sheet As Object, acadmtext As acadmtext, fontHight As DoubleGlobal xlBook As Excel.WorkbookGlobal p0(2) As Double, p1(2) As Double, p2(2) As DoubleGlobal acadApp As AcadApplicationGlobal acadDoc As AcadDocumentGlobal acadPoint As acadPointGlobal number As IntegerPublic Type ptn As Integerpt(2) As DoubleGlobal pt() As ptGlobal text1 As AcadText Global CAD As Object Global p(2) As Double, i As Integer, j As Integer Global h As Integer, l As IntegerPublic Function Get_ACAD(Dwt As String) As BooleanDim YER As Integer On Error Resume Next Set acadApp = GetObject(, AutoCAD.Application) If Err Then Err.Clear Set acadApp = CreateObject(AutoCAD.Application) If Err Then MsgBox Err.Description On Error GoTo 0 Get_ACAD = False Exit Function End If End If On Error GoTo 0Set 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, PitchandFamilyacadDoc.ActiveTextStyle.SetFont 宋體, Bold, Italic, charSet, PitchandFamilyEnd FunctionSub 顯示對(duì)話框()Form1.Show (0)End SubPublic Function Draw_Point(Point() As Double) As acadPoint Set Draw_Point = acadDoc.ModelSpace.AddPoint(Point) Draw_Point.UpdateEnd FunctionPublic Sub Set_layer(s As String) Dim layerObj As AcadLayer Set layerObj = acadDoc.Layers.Add(s) acadDoc.ActiveLayer = layerObjEnd Sub再按以下模式做個(gè)對(duì)話框：窗體的名字就叫“Form1”雙擊“展點(diǎn)”按鈕，輸入以下代碼：Dim p0(2) As Double, p1(2) As Double, p2(2) As DoubleDim T1 As Double, T2 As Double, T3 As Double, T4 As DoublePublic ne As Integer, sp As Single, cz As SingleCall Get_ACAD()Dim txt As AcadTextDim la As AcadLayerFor Each Layer In acadDoc.ModelSpaceNextCall Set_layer(zdh)Set Sheet = ThisWorkbook.ActiveSheetDim i As IntegerDo While Sheet.Cells(i + 1, 3) <> Or Sheet.Cells(i + 1, 1) <> If Sheet.Cells(i + 1, 3) = Or Sheet.Cells(i + 1, 4) = Then GoTo IIWith Sheetp1(0) = .Cells(i + 1, 3).Valuep1(1) = .Cells(i + 1, 4).Valuep1(2) = .Cells(i + 1, 5).ValueEnd Withp(0) = p1(0)p(1) = p1(1)Call Set_layer(ZDH)Call Draw_Point(p1)fontHight = TextBox5.ValueIf Cells(i + 1, 2) = Then GoTo ooSet txt = acadDoc.ModelSpace.AddText(Cells(i + 1, 2), p, fontHight)txt.Color = acMag