生成道路測量中的縱橫斷面數(shù)據(jù)表版2

1、AUTOCAD VBA 輔助制作道路測量中的縱橫斷面數(shù)據(jù)表中國有色金屬工業(yè)長沙勘察設(shè)計研究院珠海分院 蘇偉AUTOCAD集成的VBA為AUTOCAD二次開發(fā)提了一個便捷途徑，通過VBA可實現(xiàn)AUTOCAD與其它應(yīng)用軟件進(jìn)行通信，實現(xiàn)數(shù)據(jù)交換，本文介紹如何利用AUTOCAD VBA編程建立與Excel通信（本文中所使用的為AUTOCAD2004及EXCEL2007），方便快捷的生成道路縱橫斷面數(shù)據(jù)表。關(guān)鍵詞：AUTOCAD VBA與EXCEL通信 縱橫斷面數(shù)據(jù)表一 前言 在道路測量中，為滿足設(shè)計方要求，不但需要AUTOCAD電子地形圖，還需要能夠反映道路設(shè)計線上地表起伏狀況的電子縱橫斷面數(shù)據(jù)表，

2、縱橫面數(shù)據(jù)表為反映設(shè)計中線上地表起伏狀況，橫面數(shù)據(jù)表為反映與設(shè)計線垂直的截面地表起伏狀況。縱橫斷面數(shù)據(jù)表為能夠批量形成縱橫斷面圖，需要有固定格式，一般格式：如圖1 圖2 所示：在沒有輔助軟件情況下，利用現(xiàn)有電子地形圖制作縱橫數(shù)據(jù)表，需要進(jìn)行大量繁瑣的工作，即勞神，又易出錯，本文介紹利用AUTOCAD VBA編程實現(xiàn)只在AUTOCAD中操作，完成在EXCEL中形成縱橫斷面數(shù)據(jù)表。圖1圖2二 工作機(jī)理1.VBA簡介：VISUAL BASIC FOR APPLICATION (VBA)是MICROSEFT面向最終用戶應(yīng)用軟件編程語言，基于AUTOCAD的VBA應(yīng)用程序是高級程序語言的計算功能與AUT

3、OCAD的繪圖功能的結(jié)合，通過AUTOCAD VBA編程，能夠使AUTOCAD數(shù)據(jù)與EXCEL等聯(lián)合工作。2.機(jī)理分析：在MICRASOFT EXCEL 中與表對應(yīng)的對象是工作表(sheet或worksheet)與每一個單元格對應(yīng)的對象是單元格式(CELL).工作表對象中的CELLS屬性。它是以行（ROW）和列(GOLUMN）作為參數(shù)，對于行和列選擇可采用變量形式，在本文中可設(shè)定工作表(WORKSHEET）的每個單元格CELL（i j ）來操作工作表，（ i 表示行數(shù)，j 表示列數(shù)，i ,j 都要為正整數(shù)）。三 具體實現(xiàn)方法1.1 AUTOCAD VBA 程序與EXCEL建立聯(lián)接，并創(chuàng)建新EX

4、CEL表。 要在AUTOCAD中操作EXCEL,就必須利用VBA將EXCEL中的對象能讓用戶使用，就需要讓AUTOCAD VBA引用EXEEL對象庫操作步驟如下： 步驟1：在AUTOCAD（AUTOCAD2004以上版本）中打開VBA管理器，創(chuàng)建一個工程將其保存為“制表”。 步驟2：進(jìn)入VBA集成開發(fā)環(huán)境，雙擊“工程資源管理器”窗口中的THISDRAWING圖標(biāo)，打開代碼窗口，選擇“工具/引用”菜單項，打開如圖3所示對話框，選中MICROSOFT EXCEL 12.0 OBJECT LIBRARY (EXCEL對象庫，其版本與計算機(jī)上安裝的OFFICE 版本有關(guān)，12.0是OFFICE2007

5、對應(yīng)的版本號)，引用類型庫實際上是向編譯器表示本程序要使用一個已注冊的組件，引用對象庫后就可以在對象瀏覽器中觀察對象庫中的對象，方法和屬性。步驟3：完成對EXCEL對象庫引用后，就可在程序中隨時調(diào)用EXCEL中的對象?？砂慈缦麓a來創(chuàng)建完整的EXCEL對象引用實例：Public excelapp As Excel.Application 定義EXCEL對象變量Public excelworkbook As Excel.Workbook 定義工作簿對象變量Public excelsheet As Excel.Worksheet 定義工作表對象變量Public Sub linkexcel() On

6、 Error Resume Next Set excelapp = GetObject(, "excel.application") If Err Then Err.Clear Set excelapp = CreateObject("excel.application") If Err Then Err.Clear MsgBox "請檢查EXCEL" Exit Sub End If End If 創(chuàng)建新工作簿 Set excelsheet = excelworkbook.Worksheets("sheet1")

7、excelapp.WindowState = xlMinimized EXCEL程序窗口最小化 End Sub圖31.2通過在AUTOCAD中提示用戶進(jìn)行鼠標(biāo)和鍵盤的操作獲得距離和高程數(shù)據(jù)，并將數(shù)據(jù)寫入創(chuàng)建的EXCEL表中的指定單元格。由于縱橫斷面數(shù)據(jù)表格式不同，所以要分別用兩個獨立程序過程來完成。制作縱斷面數(shù)據(jù)表的程序步驟可分為以下幾步：步驟1：程序運行，提示用戶用鼠標(biāo)確定縱斷面起點心(或第一點)并記錄點位。步驟2：提示用戶鼠標(biāo)確定斷面點(或第二點)。用戶輸入斷面點后，程序計算與起點間平距并提示用戶鼠標(biāo)捕捉的點位高程是否正確，然后將平離和高程寫入EXCEL指定單元格中。步驟3：循環(huán)步驟2；如

8、用戶需要直接輸入高程和距離，則輸入對應(yīng)關(guān)鍵字后(程序中為”a”)，程序開始接受用戶輸入；如道路有拐點，用戶可輸入對應(yīng)關(guān)鍵字，程序提示用戶鼠標(biāo)確定拐點(插入拐點后，程序跳至步驟1開始運行)。步驟4：制作縱斷面數(shù)據(jù)表完成，用戶輸入關(guān)鍵字(程序中為”e”)，程序結(jié)束，并提示用戶保存EXCEL文件。制作縱斷面數(shù)據(jù)表程序代碼：Public Sub getzdm()Dim pt1 As Variant 定義點位變量Dim pt2 As Variant 定義點位變量Dim h As Variant 定義斷面點高程變量Dim s As Single 定義斷面點間距變量Dim strinput As Strin

9、g 定義用戶輸入高程和距離變量數(shù)組Dim strinput1 As Variant 定義用戶輸入高程和距離變量數(shù)組Dim i, j As Integer 定義引用EXCEL單元格的行列號變量Dim biaoji As AcadCircle '定義一個圓，標(biāo)記鼠標(biāo)捕捉的點位Dim bases As Single bases = 0 i = 1: j = 1Call linkexcel '調(diào)用linkexcel過程連接并創(chuàng)建EXCEL文件 On Error Resume Next '設(shè)置錯誤陷阱，如有錯誤執(zhí)行下一行'選取第一點(縱斷面起點)coledata1:Dim

10、 keywordlist2 As String keywordlist2 = "A E" '定義用戶輸入關(guān)鍵字rInput 128, keywordlist2 pt1 = ThisDrawing.Utility.GetPoint(, "輸入起點輸入距離高程(A)/完成(E):")判斷用戶輸入的關(guān)鍵字,確定不同的運行方法 If Err Then If StrComp(Err.Description, "用戶輸入的是關(guān)鍵字", 1) = 0 Then 獲得用戶輸入的關(guān)鍵字 If StrComp(strinput, "a&

11、quot;, 1) = 0 Then strinput1 = ThisDrawing.Utility.GetPoint(, "輸入距中樁距離高程:") excelsheet.Cells(i, j) = strinput1(0) EXCEL中寫入里程 excelsheet.Cells(i, j + 1) = strinput1(1) EXCEL中寫入高程 i = i + 1 EXCEL換行 Err.Clear 錯誤信息清除 GoTo coledata1 程序跳至coledata1運行 ElseIf StrComp(strinput, "e", 1) = 0

12、 Then MsgBox "斷面數(shù)據(jù)已形成，請保存:-）" excelapp.Visible = True Set excelsheet = Nothing '釋放對象變量 Set excelapp = Nothing '釋放對象變量 Exit Sub End If End If End If '選取第二點(斷面點)及輸入高程Colsecond:Dim keywordlist5 As String keywordlist5 = "I E A" '定義用戶輸入關(guān)鍵字 ThisDrawing.Utility.Initializ

13、eUserInput 128, keywordlist5 pt2 = ThisDrawing.Utility.GetPoint(pt1, "輸入第二點/插入拐點(I)/輸入距離高程(A)/完成(E):") '判斷用戶輸入的關(guān)鍵字,確定不同的運行方法 If Err Then If StrComp(Err.Description, "用戶輸入的是關(guān)鍵字", 1) = 0 Then If StrComp(strinput, "I", 1) = 0 Then '插入道路拐點的方法 bases = excelsheet.Cell

14、s(i - 1, j) Err.Clear GoTo coledata1 程序跳至coledata1運行 ElseIf StrComp(strinput, "e", 1) = 0 Then Err.Clear MsgBox "斷面數(shù)據(jù)已形成，請保存:-）" excelapp.Visible = True Set excelsheet = Nothing '釋放對象變量 Set excelapp = Nothing '釋放對象變量 Exit Sub ElseIf StrComp(strinput, "A", 1) = 0

15、 Then strinput1 = ThisDrawing.Utility.GetPoint(, "輸入距中樁距離高程:") excelsheet.Cells(i, j) = strinput1(0) excelsheet.Cells(i, j + 1) = strinput1(1) i = i + 1 Err.Clear GoTo Colsecond 程序跳至Colsecond運行 End If End If End If 當(dāng)用戶沒有輸入關(guān)鍵字時的程序運行方法biaoji.Delete '刪除上一點的圓圈標(biāo)記 Set biaoji = ThisDrawing.Mo

16、delSpace._AddCircle(pt2, 0.5) '用圓圈標(biāo)記鼠標(biāo)捕捉的點位 s = Hs(pt1, pt2) 調(diào)用自定義函數(shù)計算平距 h = pt2(2) 獲得鼠標(biāo)捕捉的高程 獲得用戶輸入的高程 strinput = ThisDrawing.Utility.GetString(False, "點位高程為" & h & ":") If strinput = "" Then excelsheet.Cells(i, j) = Round (s,2) + bases EXCEL中寫入里程 excelshee

17、t.Cells(i, j + 1) = h EXCEL中寫入高程 i = i + 1 GoTo Colsecond 程序跳至Colsecond運行 Else h = strinput excelsheet.Cells(i, j) = Round(s,2) + bases excelsheet.Cells(i, j + 1) = h i = i + 1 GoTo Colsecond 程序跳至Colsecond運行 End If If Err Then Err.Clear End IfEnd Su由于在制作數(shù)據(jù)表過程中，一般情況下可用鼠標(biāo)來捕捉圖形中的點位來獲得距離和高程，但有時需要直接輸入距離和

18、高程而不需要鼠標(biāo)在圖形中捕捉獲得。為此，程序在提示用戶輸入點位時，加入了一些關(guān)鍵字(如：”e”,”i” 等)的提示操作，輸入不同關(guān)鍵字，可讓程序能靈活的應(yīng)對用戶的工作習(xí)慣,更好提高效率。Round()和Hs()分別為內(nèi)部函數(shù)和自定義函數(shù),本文后面作簡單介紹。制作橫斷面數(shù)據(jù)表的程序步驟可分為以下幾步：步驟1：提示用戶輸入樁號(橫斷面編號)及樁高程，將用戶輸入的樁號和樁高程寫入EXCEL的指定單元格中。步驟2：提示用戶鼠標(biāo)確定橫斷面起點(或第一點；程序默認(rèn)橫斷面起點為橫斷面與道路中線交點，并且先進(jìn)行左側(cè)斷面數(shù)據(jù)的錄入，然后再進(jìn)行右斷面數(shù)據(jù)錄入。)，程序記錄點位。步驟3：開始左斷面數(shù)據(jù)的錄入，提示用

19、戶鼠標(biāo)確定斷面點(或第二點)；用戶輸入斷面點后，程序計算與起點間的平距并提示用戶鼠標(biāo)捕捉的點位高程是否正確，然后將平離和高程寫入EXCEL指定單元格中；如用戶需要直接輸入高程和距離，則輸入對應(yīng)關(guān)鍵字后(程序中為”a”)，程序開始接受用戶輸入。步驟4：在左斷面數(shù)據(jù)錄入中，用戶可根據(jù)提示輸入關(guān)鍵字(程序中為”t”)完成左數(shù)據(jù)錄入開始右斷面數(shù)據(jù)錄入，程序提示用戶鼠標(biāo)確定斷面點(或第二點)；用戶輸入斷面點后，程序計算與起點間的平距并提示用戶鼠標(biāo)捕捉的點位高程是否正確，然后將平離和高程寫入EXCEL指定單元格中；如用戶需要直接輸入高程和距離，則輸入對應(yīng)關(guān)鍵字后(程序中為”a”)，程序開始接受用戶輸入。步

20、驟5：斷面數(shù)據(jù)錄入過程中，用戶可輸入對應(yīng)關(guān)鍵字(程序中為”n”)完成該橫斷面數(shù)據(jù)的錄入并開始下一斷面數(shù)據(jù)的錄入；程序跳至步驟1運行。步驟6：制作橫斷面數(shù)據(jù)表完成，用戶輸入關(guān)鍵字(程序中為”e”)，程序結(jié)束，并提示用戶保存EXCEL文件。制作橫斷面數(shù)據(jù)表的代碼：Public Sub gethdm()Dim pt1 As Variant 定義點位變量Dim pt2 As Variant 定義點位變量Dim pt3 As Variant 定義點位變量Dim biaoji As AcadCircle '定義一個圓，標(biāo)記鼠標(biāo)捕捉的點位Dim h As Variant '斷面點高程Dim

21、s As Single '斷面點間距Dim strinput As Variant 獲取用戶輸入字符的變量Dim i, j As Integer EXCEL行列號的變量 i = 1: j = 1'創(chuàng)建數(shù)據(jù)文件 Call linkexcel '調(diào)用linkexcel過程連接并創(chuàng)建EXCEL文件 On Error Resume Next '設(shè)置錯誤陷阱，如有錯誤執(zhí)行下一行'獲取樁號及樁高程的代碼getnum:Dim Zhnum As StringZhnum = ThisDrawing.Utility.GetString(False, "輸入樁號,樁

22、高/完成E:") If Zhnum = "e" Then 若用戶輸入e，則程序結(jié)束 MsgBox "斷面數(shù)據(jù)已形成，請保存:-）" excelapp.Visible = True Set excelsheet = Nothing '釋放對象變量 Set excelapp = Nothing '釋放對象變量 Exit Sub Else excelsheet.Cells(i, j) = convert1(Zhnum) excelsheet.Cells(i + 1, j) = convert2(Zhnum) j = j + 1 End

23、 If'選取橫斷面中心點coledata: Dim keywordlist2 As String '定義用戶輸入的關(guān)鍵字keywordlist2 = "A N E T"ThisDrawing.Utility.InitializeUserInput 128, keywordlist2 pt1 = ThisDrawing.Utility.GetPoint(, "輸入中心點輸入距離高程(A)/下一斷面(N)/換向(T)完成(E):")'判斷用戶輸入的關(guān)鍵字,確定不同的運行方法 If Err Then If StrComp(Err.Des

24、cription, "用戶輸入的是關(guān)鍵字", 1) = 0 Then '若用戶輸入a,則用戶直接輸入偏距和高程 If StrComp(strinput, "a", 1) = 0 Then pt3 = ThisDrawing.Utility.GetPoint(, "輸入距中樁距離高程:") excelsheet.Cells(i, j) = pt3(0) 用戶輸入的距離寫入EXCEL excelsheet.Cells(i, j + 1) = pt3(1) 用戶輸入的高程寫入EXCEL j = j + 2 Err.Clear GoT

25、o coledata 程序轉(zhuǎn)至coledata運行'若用戶輸入t，開始右斷面數(shù)據(jù)錄入，EXCEL換行 ElseIf StrComp(strinput, "T", 1) = 0 Then Err.Clear i = i + 1 j = 3 GoTo coledata 程序轉(zhuǎn)至coledata運行 若用戶輸入e，程序結(jié)束運行 ElseIf StrComp(strinput, "E", 1) = 0 Then MsgBox "斷面數(shù)據(jù)已形成，請保存:-）" excelapp.Visible = True biaoji = Nothi

26、ng '釋放對象變量 Set excelsheet=Nothing '釋放對象變量 Set excelapp = Nothing '釋放對象變量 Exit Sub 程序結(jié)束 若用戶輸入n，進(jìn)行下一橫斷面數(shù)據(jù)錄入 ElseIf StrComp(strinput, "N", 1) = 0 Then Err.Clear i = i + 1 j = 1 GoTo getnum 程序轉(zhuǎn)至coledata運行 End If End If End If '選取第二點(斷面點)及輸入高程coledata2:Dim keywordlist3 As String

27、 '定義關(guān)鍵字keywordlist3 = "A N E T"ThisDrawing.Utility.InitializeUserInput 128, pt2 = ThisDrawing.Utility.GetPoint(pt1, "輸入未點輸入距離高程(A)/下一斷面(N)/換向(T)完成(E):") '判斷用戶輸入的關(guān)鍵字,確定不同的運行方法 If Err Then If StrComp(Err.Description, "用戶輸入的是關(guān)鍵字", 1) = 0 Then '若用戶輸入a,則用戶直接輸入偏距和

28、高程 If StrComp(strinput, "a", 1) = 0 Then pt3 = ThisDrawing.Utility.GetPoint(, "輸入距中樁距離高程:") excelsheet.Cells(i, j) = pt3(0) excelsheet.Cells(i, j + 1) = pt3(1) j = j + 2 Err.Clear GoTo coledata2 '若用戶輸入t，開始右斷面數(shù)據(jù)錄入，EXCEL換行 ElseIf StrComp(strinput, "T", 1) = 0 Then Err

29、.Clear i = i + 1 j = 3 GoTo coledata2 若用戶輸入e，程序結(jié)束運行 ElseIf StrComp(strinput, "e", 1) = 0 Then MsgBox "斷面數(shù)據(jù)已形成，請保存:-）" excelapp.Visible = True biaoji = Nothing Set excelsheet = Nothing Set excelapp = Nothing Exit Sub 若用戶輸入n，進(jìn)行下一橫斷面數(shù)據(jù)錄入 ElseIf StrComp(strinput, "N", 1) =

30、0 Then Err.Clear i = i + 1 j = 1 GoTo getnum End If End If Elsebiaoji.Delete '刪除上一點的圓圈標(biāo)記 Set biaoji = ThisDrawing.ModelSpace.AddCircle(pt2, 0.5) '用圓圈標(biāo)記鼠標(biāo)捕捉的點位 s = Hs(pt1, pt2) 計算用戶輸入兩點平距h = pt2(2) 用戶鼠標(biāo)捕捉的高程用戶確定是否要重新輸入高程 pt3 = ThisDrawing.Utility.GetString(False, "點位高程為" & h &am

31、p; ":") 若用戶輸入空格或回車，則將鼠標(biāo)捕捉的高程寫入EXCEL If pt3 = "" Then excelsheet.Cells(i, j) = s 偏距寫入EXCEL excelsheet.Cells(i, j + 1) = h 高程寫入EXCEL j = j + 2 Else h = pt3 excelsheet.Cells(i, j) = s 偏距寫入EXCEL excelsheet.Cells(i, j + 1) = h 用戶輸入的高程寫入EXCEL j = j + 2 End If End If If Err Then Err.Cle

32、ar End If GoTo coledata2 程序轉(zhuǎn)至coledata2運行End Sub1.3 函數(shù)是完成一些特定功能的獨立運算過程，內(nèi)部函數(shù)為VBA自帶的函數(shù)，而自定義函數(shù)為編程者為自已編寫的一些函數(shù)過程，自定義函數(shù)不但可使整段代碼簡潔，還可供其它程序過程隨時調(diào)用。下面列出了本程序中使用的幾個自定義函數(shù)。'從用戶輸入的”樁號,高程”中，提取出樁號字符串的自定義函數(shù)Private Function convert1(s As Variant) Dim k As Integer k = InStr(s, ",") convert1 = Left(s, InStr

33、(s, ",") - 1)End Function'從用戶輸入的”樁號,高程”中，提取出高程字符串的自定義函數(shù)Private Function convert2(s As Variant)Dim k As Integerk = InStr(s, ",")convert2 = Right(s, Len(s) - InStr(s, ",")End Function'計算用戶鼠標(biāo)捕捉的兩個點位之間的平距的自定義函數(shù)Private Function Hs(pta As Variant, ptb As Variant) As S

34、ingleDim a, b As Singlea = pta(0) - ptb(0)b = pta(1) - ptb(1)Hs = Round(Sqr(a * a + b * b), 2)End Function 到此，一個簡單的AUTOCAD VBA 輔助制作道路測量中的縱橫斷面數(shù)據(jù)表的程序已經(jīng)完成。接下來就要進(jìn)行菜單制作。四 形成菜單程序雖然編寫完成，但是目前還只能在AUTOCAD VBA集成開發(fā)環(huán)境中運行，我們在制作縱橫斷面數(shù)據(jù)表時，需要程序在AUTOCAD模式下運行，所以我們要制作一個AUTOCAD菜單，來方便的調(diào)用我們的程序。1.打開記事本，新建一個空文件，輸入下面內(nèi)容：/菜單組名稱*menugroup=斷面處理/菜單*pop1*斷面處理ID_斷面處理 縱斷面數(shù)據(jù)成果表cc-vbarun;D:/K-VB