1 前言
縱斷面設計圖是道路縱斷面設計的主要成果，也是道路設計的重要技術文件之一。在縱斷面設計圖上有兩條主要的線：一條是地面線，它是根據中線上各樁點的高程而點繪的一條不規則的折線，反映了沿著中線地面的起伏變化；另一條是設計線，它是經過技術上、經濟上以及美學上等多方面比較后定出的一條規則形狀的幾何線。
公路設計中，在沒有專業設計軟件輔助的情況下，繪制公路縱斷面圖是很繁瑣的事，需要進行大量的、重復的操作，既勞神，又容易出錯。特別在公路外業勘測階段，需要在短時間內將所測量的中樁高程轉化成縱斷面圖上的地面線，才可以進行路線縱坡設計，分析測量成果（選線）是否合理。
如何快速繪制公路縱斷面地面線呢？答案是：利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進行繪制，即把Microsoft Excel表格中的樁號、地面高程等信息讀取出來，在AutoCAD文件里以文字、線條的方式寫出來，就可繪出中樁地面線。
2 VBA簡介
Visual Basic
for Application（VBA）是Microsoft面向最終用戶的應用軟件編程語言。它最早出現于Microsoft的Excel和Project中，如今VBA已成為VB和所有Office產品的組件。常用的繪圖軟件AutoCAD也已支持VBA作為二次開發工具。
VBA最大特點和最大優點是利用面向對象（OOP）的ActiveX
Automation技術，使語言的引擎在技術上與開發環境分離。它的功能在很大程度上依賴于它的客戶顯露的Automation接口。同時，由于VBA是基于ActiveX
Automation技術，它可以使用任何Automation技術的應用程序共同工作。
基于AutoCAD的VBA應用程序就是高級程序語言的計算功能與AutoCAD的繪圖功能結合，使用VBA程序語句來控制對AutoCAD圖形的操作。
VBA作為一個集成的開發環境，它提供了高質量的用戶化編程能力，能夠使AutoCAD數據與其它的VBA應用程序，如Microsoft
Excel軟件，直接共享，實現無縫連接，交換數據非常方便。
3 工作機理分析
在Microsoft Excel中，與表對應的對象是工作表（Sheet或Worksheet），與每一個表格方格對應的對象是單元格區域（range），它可以僅包括一個單元格（cell），也可以由多個單元格合并而成。工作表對象中的cells屬性，在單元格的選擇方面可以達到與range相同的效果，它是以行（row）和列（gol）作為參數的，對于行和列的選擇可以采用變量的形式。在本例中，可設定工作表（Worksheet）的每一行第一列（cells（i,1））為中樁樁號，每一行第二列（cells（i,2））為對應的地面高程。
在AutoCAD中，沒有與表對應的對象，但可以根據表中前后樁號定義水平距離，根據地面高程定義垂直距離，將表中數據理解為線條與文字對象的集合。這樣，通過讀取Microsoft
Excel文件中的最小對象—單元格區域（cells（i,j））的主要信息，利用VBA建立AutoCAD與Excel的通信，然后在AutoCAD文件里指定的圖層、位置畫線條，書寫文字。通過循環，遍歷所有單元格區域（cells（i,j）），邊讀邊寫，最終完成縱斷面地面線的繪制及樁號、地面高程的書寫。
4 具體實現方法
4.1 在AutoCAD中創建Excel應用程序
要編寫存取Excel的應用程序，必須通過VBA將Excel中的對象能夠讓用戶使用，這就需要參考Excel對象的數據庫。其步驟如下：
4.1.1
打開AutoCAD的VBA編輯器（命令：VBAIDE）；
4.1.2
選擇“工具”\“引用”項，在彈出的“引用”對話框的“可使用的引用”列表框內，選擇“Microsoft
Excel 8.0 Object Library”項；
4.1.3
單擊“確定”按鈕；
4.1.4
接下來使用下列代碼可創建完整的應用程序對象實例：
Dim Excel As
Excel.Application
'激活要與之通信的Excel應用程序
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Set Excel = CreateObject("Excel.Application")
End If
4.2 讀入坐標點畫地面線
4.2.1 設定工作表（Worksheet）的每一行第一列（cells（i,1））為中樁樁號，每一行第二列（cells（i,2））為對應的地面高程。由于公路路線縱斷面圖水平方向比例為1:2000，垂直方向比例為1:200，故讀入時，y坐標應乘以10倍。
4.2.2 以（0，0，0）為原點，以樁號里程為x坐標，以10倍所對應的地面高程為y坐標，0為z坐標，定義某一樁號對應的地面點坐標；然后循環讀取各里程樁號數據信息，定義各樁號所對應的地面點坐標；最后以直線段連接各地面點坐標，則為地面線。
4.2.3 下述代碼可讀入Excel數據信息畫地面線
Dim i As Integer
Dim
lineobj As AcadLine
Dim
sPnt(0 To 2) As Double
Dim
ePnt(0 To 2) As Double
‘讀入坐標畫地面線
Worksheets("sheet1").Activate
i =
3 ‘由第三行起
Do Until
cells(i, 1).Value = ""
If
cells(i + 1, 1) = 0 Then
Exit Do
End If
sPnt(0) =
cells(i, 1).Value
sPnt(1) =
10 * cells(i, 2).Value
sPnt(2) =
0
ePnt(0) =
cells(i + 1, 1).Value
ePnt(1) =
10 * cells(i + 1, 2).Value
ePnt(2) =
0
Set
lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
i = i + 1
Loop
4.3 樁號及高程的寫入
4.3.1 定義文字的插入位置 以樁號里程為x坐標，0為y坐標，0為z坐標，確定文字的插入點。
4.3.2 以單行文字形式創建樁號及高程文字，定義文字的格式、字體、高度、傾斜角度。插入后的文字應逆時針旋轉90度。
4.4 輔助網格線的繪制
4.4.1 輔助網格線能較為直觀地表示樁號及地面高程的對應關系，有助于縱坡設計；
4.4.2 以樁號里程為x坐標，0為y坐標，0為z坐標，確定網格線第一點；以樁號里程為x坐標，10倍所對應的地面高程為y坐標，0為z坐標，確定網格線第二點；兩點連線，則為網格線。
5 實例
5.1 運行AutoCAD2000程序；
5.2 打開AutoCAD的VBA編輯器（命令：VBAIDE）；
5.3 創建成下面的過程及代碼，并運行之：
Sub ZDM()
Dim Excel
As Excel.Application
Dim
ExcelSheet As Object
Dim
ExcelWorkbook As Object
Dim i As
Integer
Dim
lineobj As AcadLine
Dim
klineobj As AcadLine
Dim
sPnt(0 To 2) As Double
Dim
ePnt(0 To 2) As Double
Dim
kPnt(0 To 2) As Double
Dim
hPnt(0 To 2) As Double
Dim
ksPnt(0 To 2) As Double
Dim
kePnt(0 To 2) As Double
Dim
dmPnt(0 To 2) As Double
Dim
textObj As AcadText
Dim
txtStr As String
Dim
insPnt As Variant
Dim
txtHeight As Double
Dim
layObj As AcadLayer
Dim
newLayer As AcadLayer
Set
layObj = ThisDrawing.Layers.Add("標注")
Set
layObj = ThisDrawing.Layers.Add("地面線")
Set
layObj = ThisDrawing.Layers.Add("網格線")
Dim
atTxtobj As AcadTextStyle
Set
atTxtobj = ThisDrawing.ActiveTextStyle
atTxtobj.fontFile = "c:\windows\fonts\simfang.ttf"
'創建Excel應用程序
On Error
Resume Next
Set Excel
= GetObject(, "Excel.Application")
If Err <>
0 Then
Set
Excel = CreateObject("Excel.Application")
End If
'打開Excel表
ExcelName
= InputBox("路徑：")
Excel.Workbooks.Open ExcelName
'表格不可見
Excel.Visible = False
'讀入坐標點畫地面線
Worksheets("sheet1").Activate
i = 3
Do Until
cells(i, 1).Value = ""
If
cells(i + 1, 1) = 0 Then
Exit Do
End If
sPnt(0) =
cells(i, 1).Value
sPnt(1) =
10 * cells(i, 2).Value
sPnt(2) =
0
ePnt(0) =
cells(i + 1, 1).Value
ePnt(1) =
10 * cells(i + 1, 2).Value
ePnt(2) =
0
Set
newLayer = ThisDrawing.Layers("地面線")
ThisDrawing.ActiveLayer = newLayer
newLayer.Color = acWhite
Set
lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
If
cells(i, 2) = "" Then lineobj.Delete
i = i + 1
Loop
'畫輔助網格線及插入數據
i = 3
Do Until
cells(i, 1).Value = ""
'畫輔助網格線
ksPnt(0)
= cells(i, 1).Value: ksPnt(1) = 0: ksPnt(2) = 0
kePnt(0)
= cells(i, 1).Value: kePnt(1) = 10 * cells(i, 2).Value: kePnt(2) = 0
dmPnt(0)
= cells(i, 1).Value: dmPnt(1) = 48: dmPnt(2) = 0
Set
newLayer = ThisDrawing.Layers("網格線")
ThisDrawing.ActiveLayer = newLayer
newLayer.Color = acGreen
Set
klineobj = ThisDrawing.ModelSpace.AddLine(ksPnt, kePnt)
'插入樁號
Set newLayer
= ThisDrawing.Layers("標注")
ThisDrawing.ActiveLayer = newLayer
newLayer.Color = acCyan
a =
cells(i, 1).Value
b = Int(a
/ 1000)
c =
Format((a - b * 1000), "000.000")
'd = a -
Int(a)
E =
"+" + Format(c, "000.000")
If c = 0
Then E = "K" + LTrim(Str(b))
txtStr =
E
txtHeight
= 4
textObj.Rotation = 3.14159 / 2
insPnt =
ksPnt
Set
textObj = ThisDrawing.ModelSpace.AddText(txtStr, insPnt, txtHeight)
If
cells(i, 2) = "" Then textObj.Delete
'插入地面高程
txtStr =
Format(cells(i, 2).Value, "###0.##0")
txtHeight
= 4
textObj.Rotation = 3.14159 / 2
insPnt =
dmPnt
Set
textObj = ThisDrawing.ModelSpace.AddText(txtStr, insPnt, txtHeight)
i = i + 1
Loop
ZoomAll
'該語句用來等待查看顯示結果
MsgBox
"按‘確定’鍵將關閉Excel的運行！"
'保存傳過來的數據
ExcelWorkbook.Close
ExcelWorkbook.Save
'關閉Excel應用程序
Excel.Application.Quit
'刪除Excel應用程序實例
Set Excel
= Nothing
End Sub
5.4 運行上述代碼后，將會彈出窗口，提示輸入Excel文件的路徑；輸入后回車，就可以生成縱斷面地面線，可以進行路線縱坡設計。
5.5 本程序需要Microsoft Excel 2000和AutoCAD2000運行環境，編譯后通過。
6 結束語
6.1 在經過綜合分析、反復比較定出設計縱坡之后，可以確定各變坡點及其高程、豎曲線要素。在上述代碼中，加入合適的詞句，可以完整地繪制公路縱斷面設計圖。
6.2 公路工程設計中，經常遇到許多類似的大量的、重復的、有邏輯性的操作，只要合理利用VBA，發揮其強大的功能，實現AutoCAD與Excel應用程序的無縫連接，快速交換數據，就可以在短時間內完成所需的設計工作，達到事半功倍的效果。
