AutoCAD VBA在大沙河河道斷面繪制中的應用

蔣云杰　董　雷　張麗萍　張　磊　楊　寧　陸文君

AutoCAD VBA在大沙河河道斷面繪制中的應用

蔣云杰董雷張麗萍張磊楊寧陸文君

大沙河是古黃河進入江蘇省境內的第一條分洪道，大沙河兩岸均為黃河沖積的粉砂土，地勢高亢，河道寬淺彎曲，汛期行洪不暢，經常決口，灌溉期又嚴重缺水，干旱和洪澇災害頻發。根據《全國重點中小河流治理實施方案》（2013-2015年），豐縣大沙河治理總長度8.47km。根據河道規劃方案，河底寬從50～250m不等，邊坡為1∶4。結合大沙河的工程實際，利用VBA對AutoCAD進行二次開發，繪制大沙河河道設計斷面。

一、啟動VBA程序

AutoCAD VBA程序代碼的集合叫做宏。該宏不能直接獨立運行，需要借助于其他應用程序的調用。點擊AutoCAD軟件菜單欄中的“工具”選項，在下拉列表框中選擇“宏”。然后點擊“加載工程”可以加載已經編譯好的VBA工程，也可以點擊“Visual Basic編輯器”進行新工程的編譯。

二、與Excel程序的交互接口

Excel軟件是微軟辦公軟件中的重要組成部分，可以進行各種數據的處理、統計分析和輔助決策等，廣泛應用于各個領域。AutoCAD可以通過ActiveX訪問Excel數據表，并實現數據資源的共享。將規劃設計好的各河道斷面數據按照表1的順序依次列入Excel數據表中。

表1　　河道斷面數據數據表樣表

首先聲明某個量為Excel.Applica -tion，其次聲明某個量為工作表，然后獲取需要調用的Excel的路徑。在該程序中，Excel的路徑和編譯好的VBA工程放在同一個文件夾中，并且將文件命名為Excel.xls。調用Excel程序的命令如下：

Dimxlapp As Excel.Application

Dimxlbook As Excel.Workbook'定義工作簿

DimxlsheetAsExcel.Worksheet'定義工作表

'獲得當前工程的路徑

DimstrFile As String

strFile=ThisDrawing.Application. VBE.ActiveVBProject.FileName

'創建Excel應用程序實例

Set xlapp=CreateObject（"Excel. Application"）

xlapp.Visible=True

'指定打開Excel的位置

（strFile，Len（strFile）-Len（"Excel to line.dvb"））&"Excel.xls"

'指定Excel文件為當前活動的文件

三、調用Excel數據表中的數據

應用VBA程序查詢Excel數據表中所具有的數據的組數，并賦值給循環變量“i”，以便為相應的數組申請空間。由于Excel數據表中的數據已按照一定的格式列于數據表中，故可以將Excel數據表中的數據直接分配給申請好空間的數組。可用如下程序代碼實現：

ReDim L（i+10）As Double'導線到中心線距離數組

ReDim px（i+10）As Double'基點x坐標數組

ReDim py（i+10）As Double'基點y坐標數組

ReDim JG（i+10）As Double'基點高程數組

ReDimDG（i+10）As Double'河底高程數組

ReDim DB（i+10）As Double'斷面的寬度數組

ReDim m（i+10）As Double'邊坡系數數組

ReDim TG（i+10）As Double'灘面高程數組

ReDim TB（i+10）As Double'灘面寬度數組

ReDimZBD（i+10）As Double'坐標圖最高點坐標數組

四、繪制河道斷面圖

將河道中心線設置為點劃線，河道邊線設置為實線。因此在VBA中聲明objLayer1和objLayer2為AutoCAD的圖層屬性，分別表示河道中心線層和河道邊線層，并根據繪圖習慣設置線寬，本文中設置河道中心線線寬為0.3mm，河道邊線線寬為0.7mm。由于中心線是點劃線，初始AutoCAD中是沒有點劃線的，需要自己手動加載才可以。本文首先采用判斷語句判斷打開的AutoCAD文件中是否已經加載了點劃線的樣式，如果已加載則直接使用，否則通過VBA語句加載。在本文中應用以下語句自動加載點劃線，并設置點劃線為紅色：

Dim T As AcadLineType'CAD線型，用于遍歷已加載的線型

Dim BB As Boolean'用于標記檢查已加載線型的結果

DimobjLayer1 As AcadLayer

DimobjLayer2 As AcadLayer

Set objLayer1=ThisDrawing.Layers. Add（"中心線"）

Set objLayer2=ThisDrawing.Layers. Add（"邊線"）

For Each TIn ThisDrawing.Linetyp -es'檢查是否已加載中心線的線型

If BB=False Then ThisDrawing. Linetypes.Load"ACAD_ISO10W100"，"acad.lin"'在要求的線型未找到時加載該線型

objLayer1.Linetype="ACAD_ISO 10W100"'按要求定義中心線線型

objLayer1.color=acRed

objLayer1.Lineweight=acLnWt030

objLayer2.Lineweight=acLnWt070

在圖層及線型設置完成之后，根據Excel數據表中的數據，按照幾何關系列出計算河道斷面幾個特征點坐標的表達式，調用AutoCADVBA程序中的畫直線命令，根據兩點連線命令繪制河道斷面，并設置中心線的線型比例為0.2。由于各斷面河道現狀灘面線形狀各不相同，因此在本文中將河道灘面以上的邊線按照邊坡比例繪制到坐標網格的最頂端，然后利用河道現狀灘面線，手動將河道線截斷，就可以形成設計的河道斷面圖。通過以下語句完成以上目的：

Call ThisDrawing.ModelSpace. AddLine（p1，p2）'調用劃直線命令繪制中心線左側河底線

Call ThisDrawing.ModelSpace. AddLine（p2，p3）'調用劃直線命令繪制中心線左側邊坡線

CallThisDrawing.ModelSpace. AddLine（p3，p4）'調用劃直線命令繪制中心線左側灘面線

CallThisDrawing.ModelSpace. AddLine（p4，p5）'調用劃直線命令繪制中心線左側邊坡線

CallThisDrawing.ModelSpace. AddLine（p1，p6）'調用劃直線命令繪制中心線右側河底線

CallThisDrawing.ModelSpace. AddLine（p6，p7）'調用劃直線命令繪制中心線右側邊坡線

CallThisDrawing.ModelSpace. AddLine（p7，p8）'調用劃直線命令繪制中心線右側灘面線

CallThisDrawing.ModelSpace. AddLine（p8，p9）'調用劃直線命令繪制中心線右側邊坡線

Set ML=ThisDrawing.Model Space.AddLine（p10，p11）'調用劃直線命令繪制中心線

圖1　　繪制完成的大沙河某兩個河道斷面圖

五、實例應用

以大沙河河道斷面繪制為例，在平面圖上繪制河道中心線，并采集每個斷面導線至中心線的距離，存入河道數據表中，記為A列（基點距中心線距離），采用另外的程序在斷面圖中采集導線基點坐標存入河道數據表中，記為B列（基點x坐標）、C列（基點y坐標）。利用VBA打開河道數據表，根據B列和C列數據找到河道斷面基點，再結合A列數據可以得到河底中線位置坐標，根據Excel數據表中的數據按照計算式計算各特征點的坐標，繪制河道邊線和中心線。繪制完成的河道斷面如圖1所示。

六、結語

通過AutoCAD的VBA編譯技術，調用Excel數據表中的河道斷面數據自動繪制河道斷面，大大減少了設計人員的工作量，提高了繪圖效率。尤其是在河道參數有變動的時候，可以重新生成改動后的河道斷面圖，減少了設計人員逐個斷面修改的工作量■

（作者單位：江蘇省徐州市水利建筑設計研究院221100）