利用VBA程序語言繪制鐵路縱斷面圖

1、利用 VBA 程序語言繪制鐵路縱斷面圖摘 要 :VBA 作 為 一 個 集 成 的 開 發(fā) 環(huán) 境 , 能 夠 使 AutoCAD 數(shù) 據(jù) 與 其 它 的 VBA 應(yīng) 用 程 序 ,如 Microsoft Excel軟 件 ,直 接 共 享 ,實(shí) 現(xiàn) 無 縫 連 接 ,交 換 數(shù) 據(jù) 。 本 文 介 紹 如 何 利 用 VBA 編 程 建 立 AutoCAD2000與 Excel2000的 通 信 , 實(shí) 現(xiàn) 數(shù) 據(jù) 交 換 , 快 速 繪 制 公 路 縱 斷 面 地 面 線 。關(guān) 鍵 詞 :公 路 縱 斷 面 設(shè) 計 地 面 線 VBA AutoCAD與 Excel 的 通 信前 言縱 斷

2、面 設(shè) 計 圖 是 道 路 縱 斷 面 設(shè) 計 的 主 要 成 果 , 也 是 道 路 設(shè) 計 的 重 要 技 術(shù) 文 件 之 一 。 在 縱 斷 面 設(shè) 計 圖 上 有 兩 條 主 要 的 線 :一 條 是 地 面 線 , 它 是 根 據(jù) 中 線 上 各 樁 點(diǎn) 的 高 程 而 點(diǎn) 繪 的 一 條 不 規(guī) 則 的 折 線 , 反 映 了 沿 著 中 線 地 面 的 起 伏 變 化 ; 另 一 條 是 設(shè) 計 線 , 它 是 經(jīng) 過 技 術(shù) 上 、 經(jīng) 濟(jì) 上 以 及 美 學(xué) 上 等 多 方 面 比 較 后 定 出 的 一 條 規(guī) 則 形 狀 的 幾 何 線 。公 路 設(shè) 計 中 , 在 沒

3、有 專 業(yè) 設(shè) 計 軟 件 輔 助 的 情 況 下 , 繪 制 公 路 縱 斷 面 圖 是 很 繁 瑣 的 事 , 需 要 進(jìn) 行 大 量 的 、 重 復(fù) 的 操 作 , 既 勞 神 , 又 容 易 出 錯 。 特 別 在 公 路 外 業(yè) 勘 測 階 段 , 需 要 在 短 時 間 內(nèi) 將 所 測 量 的 中 樁 高 程 轉(zhuǎn) 化 成 縱 斷 面 圖 上 的 地 面 線 , 才 可 以 進(jìn) 行 路 線 縱 坡 設(shè) 計 , 分 析 測 量 成 果 (選 線 是 否 合 理 。 如 何 快 速 繪 制 公 路 縱 斷 面 地 面 線 呢 ? 答 案 是 :利 用 Microsoft Excel、 A

4、utoCAD 都 提 供 的 VBA 功 能 , 編 制 程 序 進(jìn) 行 繪 制 , 即 把 Microsoft Excel表 格 中 的 樁 號 、地 面 高 程 等 信 息 讀 取 出 來 ,在 AutoCAD 文 件 里 以 文 字 、線 條 的 方 式 寫 出 來 , 就 可 繪 出 中 樁 地 面 線 。2、 VBA 簡 介Visual Basic for Application(VBA 是 Microsoft 面 向 最 終 用 戶 的 應(yīng) 用 軟 件 編 程 語 言 。它 最 早 出 現(xiàn) 于 Microsoft 的 Excel 和 Project 中 ,如 今 VBA 已 成 為

5、 VB 和 所 有 Office 產(chǎn) 品 的 組 件 。 常 用 的 繪 圖 軟 件 AutoCAD 也 已 支 持 VBA 作 為 二 次 開 發(fā) 工 具 。VBA 最 大 特 點(diǎn) 和 最 大 優(yōu) 點(diǎn) 是 利 用 面 向 對 象 (OOP 的 ActiveX Automation技 術(shù) , 使 語 言 的 引 擎 在 技 術(shù) 上 與 開 發(fā) 環(huán) 境 分 離 。 它 的 功 能 在 很 大 程 度 上 依 賴 于 它 的 客 戶 顯 露 的 Automation 接 口 。 同 時 , 由 于 VBA 是 基 于 ActiveX Automation技 術(shù) , 它 可 以 使 用 任 何 Au

6、tomation 技 術(shù) 的 應(yīng) 用 程 序 共 同 工 作 ?；?于 AutoCAD 的 VBA 應(yīng) 用 程 序 就 是 高 級 程 序 語 言 的 計 算 功 能 與 AutoCAD 的 繪 圖 功 能 結(jié) 合 ,使 用 VBA 程 序 語 句 來 控 制 對 AutoCAD 圖 形 的 操 作 。VBA 作 為 一 個 集 成 的 開 發(fā) 環(huán) 境 ,它 提 供 了 高 質(zhì) 量 的 用 戶 化 編 程 能 力 ,能 夠 使 AutoCAD 數(shù) 據(jù) 與 其 它 的 VBA 應(yīng) 用 程 序 , 如 Microsoft Excel軟 件 , 直 接 共 享 , 實(shí) 現(xiàn) 無 縫 連 接 , 交 換

7、 數(shù) 據(jù) 非 常 方 便 。3、 工 作 機(jī) 理 分 析在 Microsoft Excel中 , 與 表 對 應(yīng) 的 對 象 是 工 作 表 (Sheet 或 Worksheet , 與 每 一 個 表 格 方 格 對 應(yīng) 的 對 象 是 單 元 格 區(qū) 域 (range , 它 可 以 僅 包 括 一 個 單 元 格(cell ,也 可 以 由 多 個 單 元 格 合 并 而 成 。工 作 表 對 象 中 的 cells 屬 性 ,在 單 元 格 的 選 擇 方 面 可 以 達(dá) 到 與 range 相 同 的 效 果 , 它 是 以 行(row 和 列 (gol 作 為 參 數(shù) 的 , 對

8、于 行 和 列 的 選 擇 可 以 采 用 變 量 的 形 式 。 在 本 例 中 , 可 設(shè) 定 工 作 表 (Worksheet 的 每 一 行 第 一 列 (cells (i,1 為 中 樁 樁 號 , 每 一 行 第 二 列 (cells (i,2 為 對 應(yīng) 的 地 面 高 程 。在 AutoCAD 中 ,沒 有 與 表 對 應(yīng) 的 對 象 ,但 可 以 根 據(jù) 表 中 前 后 樁 號 定 義 水 平 距 離 , 根 據(jù) 地 面 高 程 定 義 垂 直 距 離 , 將 表 中 數(shù) 據(jù) 理 解 為 線 條 與 文 字 對 象 的 集 合 。 這 樣 , 通 過 讀 取 Microsof

9、t Excel文 件 中 的 最 小 對 象 單 元 格 區(qū) 域 (cells (i,j 的 主 要 信 息 , 利 用 VBA 建 立 AutoCAD 與 Excel 的 通 信 , 然 后 在 AutoCAD 文 件 里 指 定 的 圖 層 、 位 置 畫 線 條 , 書 寫 文 字 。 通 過 循 環(huán) , 遍 歷 所 有 單 元 格 區(qū) 域 (cells (i,j , 邊 讀 邊 寫 , 最 終 完 成 縱 斷 面 地 面 線 的 繪 制 及 樁 號 、 地 面 高 程 的 書 寫 。4、 具 體 實(shí) 現(xiàn) 方 法4.1 在 AutoCAD 中 創(chuàng) 建 Excel 應(yīng) 用 程 序要 編 寫

10、 存 取 Excel 的 應(yīng) 用 程 序 , 必 須 通 過 VBA 將 Excel 中 的 對 象 能 夠 讓 用 戶 使 用 , 這 就 需 要 參 考 Excel對 象 的 數(shù) 據(jù) 庫 。 其 步 驟 如 下 :4.1.1 打 開 AutoCAD 的 VBA 編 輯 器 (命 令 :VBAIDE ;4.1.2 選 擇 “ 工 具 ” “ 引 用 ” 項 , 在 彈 出 的 “ 引 用 ” 對 話 框 的 “ 可 使 用 的 引 用 ” 列 表 框 內(nèi) , 選 擇 “Microsof t Excel 8.0 Object Library” 項 ;4.1.3 單 擊 “ 確 定 ” 按 鈕

11、;4.1.4 接 下 來 使 用 下 列 代 碼 可 創(chuàng) 建 完 整 的 應(yīng) 用 程 序 對 象 實(shí) 例 :Dim Excel As Excel.Application' 激 活 要 與 之 通 信 的 Excel 應(yīng) 用 程 序On Error Resume NextSet Excel = GetObject(, "Excel.Application"If Err <> 0 ThenSet Excel = CreateObject("Excel.Application"End If4.2 讀 入 坐 標(biāo) 點(diǎn) 畫 地 面 線4.2.1

12、 設(shè) 定 工 作 表(Worksheet 的 每 一 行 第 一 列(cells (i,1 為 中 樁 樁 號 ,每 一 行 第 二 列(cells (i,2 為 對 應(yīng) 的 地 面 高 程 。由 于 公 路 路 線 縱 斷 面 圖 水 平 方 向 比 例 為 1:2000,垂 直 方 向 比 例 為 1:200,故 讀 入 時 , y 坐 標(biāo) 應(yīng) 乘 以 10倍 。4.2.2 以(0, 0, 0為 原 點(diǎn) ,以 樁 號 里 程 為 x 坐 標(biāo) ,以 10倍 所 對 應(yīng) 的 地 面 高 程 為 y 坐 標(biāo) , 0為 z 坐 標(biāo) ,定 義 某 一 樁 號 對 應(yīng) 的 地 面 點(diǎn) 坐 標(biāo) ;然 后

13、 循 環(huán) 讀 取 各 里 程 樁 號 數(shù) 據(jù) 信 息 , 定 義 各 樁 號 所 對 應(yīng) 的 地 面 點(diǎn) 坐 標(biāo) ; 最 后 以 直 線 段 連 接 各 地 面 點(diǎn) 坐 標(biāo) , 則 為 地 面 線 。4.2.3 下 述 代 碼 可 讀 入 Excel 數(shù) 據(jù) 信 息 畫 地 面 線Dim i As IntegerDim lineobj As AcadLineDim sPnt(0 To 2 As DoubleDim ePnt(0 To 2 As Double 讀 入 坐 標(biāo) 畫 地 面 線Worksheets("sheet1".Activatei = 3 由 第 三 行 起D

14、o Until cells(i, 1.Value = ""If cells(i + 1, 1 = 0 ThenExit DoEnd IfsPnt(0 = cells(i, 1.ValuesPnt(1 = 10 * cells(i, 2.ValuesPnt(2 = 0ePnt(0 = cells(i + 1, 1.ValueePnt(1 = 10 * cells(i + 1, 2.ValueePnt(2 = 0Set lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnti = i + 1Loop4.3 樁 號 及 高 程 的

15、寫 入4.3.1 定 義 文 字 的 插 入 位 置 以 樁 號 里 程 為 x 坐 標(biāo) , 0為 y 坐 標(biāo) , 0為 z 坐 標(biāo) , 確 定 文 字 的 插 入 點(diǎn) 。4.3.2 以 單 行 文 字 形 式 創(chuàng) 建 樁 號 及 高 程 文 字 ,定 義 文 字 的 格 式 、字 體 、高 度 、 傾 斜 角 度 。 插 入 后 的 文 字 應(yīng) 逆 時 針 旋 轉(zhuǎn) 90度 。4.4 輔 助 網(wǎng) 格 線 的 繪 制4.4.1 輔 助 網(wǎng) 格 線 能 較 為 直 觀 地 表 示 樁 號 及 地 面 高 程 的 對 應(yīng) 關(guān) 系 , 有 助 于 縱 坡 設(shè) 計 ;4.4.2 以 樁 號 里 程 為

16、x 坐 標(biāo) , 0為 y 坐 標(biāo) , 0為 z 坐 標(biāo) , 確 定 網(wǎng) 格 線 第 一 點(diǎn) ; 以 樁 號 里 程 為 x 坐 標(biāo) , 10倍 所 對 應(yīng) 的 地 面 高 程 為 y 坐 標(biāo) , 0為 z 坐 標(biāo) , 確 定 網(wǎng) 格 線 第 二 點(diǎn) ; 兩 點(diǎn) 連 線 , 則 為 網(wǎng) 格 線 。5 實(shí) 例5.1 運(yùn) 行 AutoCAD2000程 序 ;5.2 打 開 AutoCAD 的 VBA 編 輯 器 (命 令 :VBAIDE ;5.3 創(chuàng) 建 成 下 面 的 過 程 及 代 碼 , 并 運(yùn) 行 之 :Sub ZDM(Dim Excel As Excel.ApplicationDim Ex

17、celSheet As ObjectDim ExcelWorkbook As ObjectDim i As IntegerDim lineobj As AcadLineDim klineobj As AcadLineDim sPnt(0 To 2 As DoubleDim ePnt(0 To 2 As DoubleDim kPnt(0 To 2 As DoubleDim hPnt(0 To 2 As DoubleDim ksPnt(0 To 2 As DoubleDim kePnt(0 To 2 As DoubleDim dmPnt(0 To 2 As DoubleDim textObj As

18、 AcadTextDim txtStr As StringDim insPnt As VariantDim txtHeight As DoubleDim layObj As AcadLayerDim newLayer As AcadLayerSet layObj = ThisDrawing.Layers.Add("標(biāo) 注 "Set layObj = ThisDrawing.Layers.Add("地 面 線 "Set layObj = ThisDrawing.Layers.Add("網(wǎng) 格 線 "Dim atTxtobj As Aca

19、dTextStyleSet atTxtobj = ThisDrawing.ActiveTextStyle atTxtobj.fontFile = "c:windowsfontssimfang.ttf"' 創(chuàng) 建 Excel 應(yīng) 用 程 序On Error Resume NextSet Excel = GetObject(, "Excel.Application"If Err <> 0 ThenSet Excel = CreateObject("Excel.Application"End If' 打 開 Ex

20、cel 表ExcelName = InputBox("路 徑 :"Excel.Workbooks.Open ExcelName' 表 格 不 可 見Excel.Visible = False' 讀 入 坐 標(biāo) 點(diǎn) 畫 地 面 線Worksheets("sheet1".Activatei = 3Do Until cells(i, 1.Value = ""If cells(i + 1, 1 = 0 ThenExit DoEnd IfsPnt(0 = cells(i, 1.ValuesPnt(1 = 10 * cells(i

21、, 2.ValuesPnt(2 = 0ePnt(0 = cells(i + 1, 1.ValueePnt(1 = 10 * cells(i + 1, 2.ValueePnt(2 = 0Set newLayer = ThisDrawing.Layers("地 面 線 " ThisDrawing.ActiveLayer = newLayernewLayer.Color = acWhiteSet lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt If cells(i, 2 = "" Then lineobj

22、.Deletei = i + 1Loop' 畫 輔 助 網(wǎng) 格 線 及 插 入 數(shù) 據(jù)i = 3Do Until cells(i, 1.Value = ""'畫 輔 助 網(wǎng) 格 線ksPnt(0 = cells(i, 1.Value: ksPnt(1 = 0: ksPnt(2 = 0kePnt(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 = 0Set newLayer =

23、 ThisDrawing.Layers("網(wǎng) 格 線 "ThisDrawing.ActiveLayer = newLayernewLayer.Color = acGreenSet klineobj = ThisDrawing.ModelSpace.AddLine(ksPnt, kePnt' 插 入 樁 號Set newLayer = ThisDrawing.Layers("標(biāo) 注 "ThisDrawing.ActiveLayer = newLayernewLayer.Color = acCyana = cells(i, 1.Valueb = In

24、t(a / 1000c = Format(a - b * 1000, "000.000"'d = a - Int(aE = "+" + Format(c, "000.000"If c = 0 Then E = "K" + LTrim(Str(btxtStr = EtxtHeight = 4textObj.Rotation = 3.14159 / 2insPnt = ksPntSet textObj = ThisDrawing.ModelSpace.AddText(txtStr, insPnt, txtHeight If cells(i, 2 = "" Then textObj.Delete' 插 入 地 面 高 程txtStr = Format(cells(i, 2.Value, "#0.#0"txtHeight = 4textObj.Rotation = 3.141