强奷漂亮的女邻居中文字幕,午夜理论片2019理论琪琪

Excel VBA 在工程測量上的應用

Excel 是大家很熟悉的辦公軟件，相信大家在工作中經常使用吧。在測量工作中，你是否感覺到有很不方便的時候？比如，計算一個角度的三角函數(shù)值，而角度的單位是 60 進制的，此時，你一定感到很無奈，因為， Excel 本身無法直接計算 60 進制的角度的三角函數(shù)！還有，如果你的工作表中有了點坐標值（二維或者三維），要在 CAD 中展繪出來，怎樣才能又快又直接？不然，就只有拐彎摸角了，很痛苦��！其實，只要對 Excel 進行一些挖掘，就可以發(fā)現(xiàn) Excel 的功能我們還沒有好好的利用呢。 Excel 本身提供了強大的二次開發(fā)功能，只要我們仔細的研究，沒有什么能難倒我們的。下面，好好筆者將帶你走近 Excel ，認識它的強大的二次開發(fā)環(huán)境 VBAIDE ，用它來解決上面所提到的問題，就非常容易了。

初識 VBAIDE ，首先，你必須懂得一些簡單的 VB 編程常識。如果不懂就只有通過其他的途徑去學習了。但用不著深入的研究，只要靜下心來，幾個小時就可以了。

打開 Excel ，按 Alt+F11 即進入 VBAIDE ，學過 VB 的人一看就知道那就是熟悉的 VB 界面。下面看看如何定義一個函數(shù)，然后利用它來解決 60 進制的???㈠?0角度的三角函數(shù)計算問題。在菜單上依次點擊 [ 插入 ]----->[ 模塊 ] ，然后輸入如下代碼

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 的函數(shù)，它的作用就是轉換 60 進制的角度為 Excel 認識的弧度。編輯完后按 Alt+Q 即返回 Excel ，再在某一單元格輸入 =sin(deg(A1))(A1 既可以是單元格的值 , 也可以是輸入的角度值 ), 回車，哈哈，怎么樣？結果出來了吧？你可以用計算器檢驗一下是否正確。如果出現(xiàn) #NA???㈠?0ME ？那就要設置一下安全設置。依次點 [ 工具 ]->[ 宏 ]->[ 安全性 ] ，在安全級選項卡上選擇“中”或者“低”，然后關閉后重新打開就可以了，以后只要是 60 進制的角度，就用它轉換，非常方便哦。

工程測量中，經常碰到導線的計算，如果手頭沒有平差計算程序就只有手工計算了，這時候你曾經想過編個小程序來計算？其實，這很簡單，筆者在宛坪（上海至武威）高速公路上做測量監(jiān)理，因為有大量的導線需要復核，故編寫了一個附合導線計算程序，代碼很簡單，但很實用。下面是該程序的代碼：

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???㈠?0) - 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 函數(shù)別忘記加進去。

如果自己定義一個名字叫“計算”的按鈕，指定此工具的宏為“單一附合導線計算”，那么，只要按下面的格式輸入原始數(shù)據(jù)（斜體是輸入的），點“計算”就可以得到計算結果了。所有的過程都是自動的，無須再手工填寫，是不是很方便？

下面我們就來解決上面提到的與 CAD 的連接和通訊問題。

進入 VBAIDE ，按 [ 工具 ]->[ 引用 ], 找到可使用的引用，在“ AutoCAD2000 類型庫”的左邊打鉤，點確定就行了。在模塊中輸入以下代碼：

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

???㈠?0 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 = CreateObject("AutoCAD.Application")

If Err Then

MsgBox Err.Description

On Error GoTo 0

Get_ACAD = False

Exit Function

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 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 ”

雙擊“展點”按鈕，輸入以下代碼：

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

Call Get_ACAD("")

Dim txt As AcadText

Dim la As AcadLayer

For Each Layer In acadDoc.ModelSpace

Next

Call Set_layer("zdh")

Set Sheet = ThisWorkbook.ActiveSheet

Dim i As Integer

Do 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 II

With Sheet

p1(0) = .Cells(i + 1, 3).Value

p1(1) = .Cells(i + 1, 4).Value

p1(2) = .Cells(i + 1, 5).Value

End With

p(0) = p1(0)

p(1) = p1(1)

Call Set_layer("ZDH")

Call Draw_Point(p1)

fontHight = TextBox5.Value

If Cells(i + 1, 2) = "" Then GoTo oo

Set txt = acadDoc.ModelSpace.AddText(Cells(i + 1, 2), p, fontHight)

txt.Color = acMagenta

oo:

If Cells(i + 1, 5) = "" Then GoTo II

Set_layer ("GCD")

p(1) = p1(1) - fontHight

Set txt = acadDoc.ModelSpace.AddText(Format(Cells(i + 1, 5), "00.0"), p, fontHight)

txt.Color = acMagenta

II:

i = i + 1

Loop

End Sub

當然，你在 Excel 上同樣可以再加個工具按鈕，比如叫“展點”，指定宏為“顯示對話框”，只要你的 Excel 有了 X,Y 或者 X,Y ， Z （格式如下表），點擊“展點” 就可以自動啟動 A utoCAD 展點啦！當然 , 如果 A utoCAD 已經啟動 , 就直接在已經打開的 A utoCAD 文檔中展點，展點完畢后，會顯示一個對話框，提示“展點完畢“，再切換到 A utoCAD 看看，你所要展的點是否已經出現(xiàn)了？如果沒有輸入錯誤，應該可以得到滿意的結果。如果有點號 , 還可以顯示點號，并且可以輸入字體的高度。

下面是坐標格式，其中第一列為點名，第二列為編碼（可以為空），第三列為 X ，第四列為 Y ，第五列為高程。注意， X ， Y 是 A utoCAD 的橫坐標和縱坐標，與測量坐標系不同。

Excel 的功能是非常強大的，如果有興趣，你還可以在 AutoCAD 中直接與 Excel 通訊，比如一條三維多段線的所有結點的三維坐標直接導入到 Excel ，比在 AutoCAD 中用列表的方法要方便的多，限于篇幅，無法在此詳細敘述了。如果讀者有興趣，可以深入的學習和探討。

Excel VBA在工程測量上的應用

微信掃碼關注公眾號