張仕林

(中鐵大橋局集團(tuán)第二工程有限公司，江蘇南京　210015)

Using the Combining of EXCEL-VBA and CAD to realize automatic points drawing

ZHANG Shi-lin

EXCEL-VBA結(jié)合CAD自動(dòng)實(shí)現(xiàn)線(xiàn)路展點(diǎn)

張仕林

(中鐵大橋局集團(tuán)第二工程有限公司，江蘇南京210015)

Using the Combining of EXCEL-VBA and CAD to realize automatic points drawing

ZHANG Shi-lin

摘要Excel VBA是寄生于運(yùn)用廣泛的微軟軟件Microsoft Office中執(zhí)行通用自動(dòng)化程序的編程語(yǔ)言，有強(qiáng)大的數(shù)據(jù)處理能力，集統(tǒng)計(jì)、計(jì)算等功能與一身，能夠提供與其他軟件交互的接口，具有友好的交互功能。介紹如何運(yùn)用EXCEL中的宏語(yǔ)言(即VBA)編寫(xiě)程序來(lái)計(jì)算線(xiàn)路坐標(biāo)并自動(dòng)在不同版本的autoCAD軟件中展繪點(diǎn)位。該方法可以避免在CAD中逐個(gè)繪制點(diǎn)位時(shí)可能的錯(cuò)誤輸入，亦可批量展繪線(xiàn)路計(jì)算點(diǎn)，提高測(cè)繪工作的準(zhǔn)確性和工作效率。

關(guān)鍵詞EXCEL VBAautoCAD線(xiàn)路自動(dòng)展點(diǎn)

在公路、鐵路、水運(yùn)、管道等線(xiàn)路工程測(cè)繪工作中，往往需要將大量的線(xiàn)路點(diǎn)位數(shù)據(jù)通過(guò)各種方式進(jìn)行計(jì)算并在CAD中展繪成形象且直觀的平面圖形，為后續(xù)施工做好數(shù)據(jù)準(zhǔn)備。測(cè)量是一項(xiàng)系統(tǒng)、復(fù)雜，而又相對(duì)單調(diào)、繁瑣的工作，高強(qiáng)度的重復(fù)手工計(jì)算、輸入數(shù)據(jù)往往會(huì)造成錯(cuò)誤，進(jìn)而影響施工質(zhì)量，甚至造成不可估量的損失。需要一種精確、高效的數(shù)據(jù)計(jì)算和成圖方法來(lái)避免因測(cè)量數(shù)據(jù)錯(cuò)誤而造成的損失。EXCEL是當(dāng)前運(yùn)用十分廣泛的辦公軟件之一，不僅具有十分強(qiáng)大的表格函數(shù)，而且具有良好的二次開(kāi)發(fā)功能。CAD亦是工程領(lǐng)域運(yùn)用十分廣泛的成圖軟件，使用CAD繪制的平面圖形具有形象直觀的特點(diǎn)，方便查詢(xún)與檢核各工程結(jié)構(gòu)的相對(duì)位置關(guān)系。

本文所闡述的快速展點(diǎn)方法，是利用excel電子表格與測(cè)量平面坐標(biāo)(二維)相適應(yīng)的特性，利用積木法計(jì)算線(xiàn)路的設(shè)計(jì)中(邊)樁坐標(biāo)，然后利用excel VBA打開(kāi)或新建CAD文件，并且根據(jù)提示選取繪圖所需的原始數(shù)據(jù)區(qū)域，并對(duì)點(diǎn)的樣式、顏色等特性進(jìn)行設(shè)置，實(shí)現(xiàn)快速繪制點(diǎn)位圖。該方法在windows操作系統(tǒng)下的excel2007及CAD2004及CAD2008中驗(yàn)證通過(guò)。

1基本思路與方法

對(duì)設(shè)計(jì)單位提供的原始線(xiàn)路設(shè)計(jì)數(shù)據(jù)進(jìn)行核實(shí)與錄入excel表格，并利用積木法計(jì)算出所需里程對(duì)應(yīng)的中樁點(diǎn)(中樁點(diǎn)計(jì)算完成后也可以不同邊距邊樁點(diǎn)的計(jì)算)，然后在交互界面中根據(jù)用戶(hù)選擇新建或者利用已有CAD圖形文件來(lái)實(shí)現(xiàn)展點(diǎn)繪圖。

將新建工作簿的工作表Sheet1重命名為“平面數(shù)據(jù)”，并在對(duì)應(yīng)的單元格中錄入設(shè)計(jì)單位提供的線(xiàn)路設(shè)計(jì)參數(shù)，錄入完成后的效果如表1所示。

表1　設(shè)計(jì)參數(shù)錄入

錄入數(shù)據(jù)時(shí)需要注意的是，線(xiàn)路轉(zhuǎn)角(偏角)左轉(zhuǎn)時(shí)為負(fù)值，右轉(zhuǎn)時(shí)為正值。

2坐標(biāo)計(jì)算

將工作簿的工作表Sheet2重命名為“積木元素”，制作如表2所示。

特征點(diǎn)計(jì)算完成以后，新建一張工作表，命名為“坐標(biāo)高程計(jì)算”，需要完成后續(xù)任一點(diǎn)里程坐標(biāo)及方位角的計(jì)算。計(jì)算時(shí)，利用excel電子表格現(xiàn)有的二維平面數(shù)組，利用數(shù)組公式，計(jì)算并存儲(chǔ)中間變量，任意里程的坐標(biāo)值計(jì)算源碼如下：

表2　積木元素特征點(diǎn)計(jì)算

Option Explicit

Public Sub CentCordCal2()’線(xiàn)路中心坐標(biāo)計(jì)算主程序

Dim V， R

Dim CalLCsz， Startlcsz， Endlcsz’定義里程數(shù)組

Dim Startqlsz， Endqlsz， StartDFwjsz， StartFwjsz， QLcsz’定義曲率，方位角數(shù)組

Dim StartXYsz

Dim Calxysz

Dim MaxlcAs Double， Minlc As Double

Dim SjlcnumAs Long， Callcnum As Long

Dim NumAs Long， Calnum As Long

Dim iAs Long， j As Long， k As Byte

Dim LCc， LS

Dim Calqlsz， CalFwjsz

Dim SumX， SumY

On Error Resume Next

V=Array(0.046910077， 0.2307653449， 0.5， 0.7692346551， 0.953089923)

R=Array(0.1184634425， 0.2393143352， 0.2844444444， 0.2393143352， 0.1184634425) ’常量數(shù)組賦值

Worksheets("積木元素").Activate

With Worksheets("積木元素")

Num=.Range("B" &Rows.Count).End(xlUp).Row’獲取交點(diǎn)個(gè)數(shù)

ReDimStartlcsz(1 To Num)

ReDimEndlcsz(1 To Num)

ReDimStartqlsz(1 To Num)

ReDimEndqlsz(1 To Num)

ReDimStartDFwjsz(1 To Num)

ReDimStartFwjsz(1 To Num)

ReDimQLcsz(1 To Num)

ReDimStartXYsz(1 To 2， 1 To Num) ’重新定義各個(gè)已知數(shù)據(jù)數(shù)組，并指定數(shù)組的維數(shù)

Startlcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 3)， Cells(Num， 3)))

Startqlsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 4)， Cells(Num， 4)))

StartDFwjsz=Application.WorksheetFunction.Transpose(.Range(Cells(4，5)，Cells(Num， 5)))

StartXYsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 6)， Cells(Num， 7)))

Endlcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 9)， Cells(Num， 9)))

Endqlsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 10)， Cells(Num， 10)))

QLcsz=Application.WorksheetFunction.Transpose(.Range(Cells(4， 11)， Cells(Num， 11)))

Maxlc=Application.WorksheetFunction.Max(.Range(Cells(4， 3)， Cells(Num， 3)))

Minlc=Application.WorksheetFunction.Min(.Range(Cells(4， 9)， Cells(Num， 9)))

’已知參數(shù)數(shù)組賦值

End With

Worksheets("坐標(biāo)高程計(jì)算").Activate

For i=1 To UBound(Startlcsz)

StartFwjsz(i)=Application.WorksheetFunction.Radians(StartDFwjsz(i)) ’角度轉(zhuǎn)換

Next

With Worksheets("坐標(biāo)高程計(jì)算")

.Range(Cells(5， 2)， Cells(Rows.Count， 4)).ClearContents’清除區(qū)域內(nèi)容

Calnum=.Range("A" &Rows.Count).End(xlUp).Row

If Calnum<=4 Then

MsgBox "缺少計(jì)算里程!"

Exit Sub

ElseIfCalnum=5 Then

ReDimCalLCsz(1 To 2)

CalLCsz(1)=.Range("A5")

CalLCsz(2)="--"

Else

ReDimCalLCsz(1 To Calnum-4)

CalLCsz=Application.WorksheetFunction.Transpose(.Range(Cells(5，1)， Cells(Calnum， 1)))

End If

ReDimCalxysz(1 To 2， 1 To UBound(CalLCsz))

ReDimCalqlsz(1 To UBound(CalLCsz))

ReDimCalFwjsz(1 To UBound(CalLCsz))

For i=1 To UBound(CalLCsz) ’循環(huán)判斷計(jì)算的里程是否是有效數(shù)值

If IsNumeric(CalLCsz(i))=False Or Len(CalLCsz(i))=0 Or CalLCsz(i) >Maxlc Or CalLCsz(i)

Calxysz(1， i)="--"

Calxysz(2， i)="--"

CalFwjsz(i)="--"

Else

For j=1 To UBound(Startlcsz)

If CalLCsz(i) >Startlcsz(j) And CalLCsz(i) <=Endlcsz(j) Then

LCc=CalLCsz(i)-Startlcsz(j)

LS=Endlcsz(j)-Startlcsz(j)

SumX=0

SumY=0

For k=0 To 4’計(jì)算總的ΔX，ΔY

SumX=SumX+LCc * R(k) * Cos(StartFwjsz(j)+(Startqlsz(j) * V(k) * LCc+QLcsz(j) * V(k) ^ 2 * LCc ^ 2 / (2 * LS)))

SumY=SumY+LCc * R(k) * Sin(StartFwjsz(j)+(Startqlsz(j) * V(k) * LCc+QLcsz(j) * V(k) ^ 2 * LCc ^ 2 / (2 * LS)))

Next

Calxysz(1， i)=StartXYsz(1， j)+SumX

Calxysz(2， i)=StartXYsz(2， j)+SumY

CalFwjsz(i)=Application.WorksheetFunction.Degrees(StartFwjsz(j)+(Startqlsz(j)+QLcsz(j) * LCc / LS+Startqlsz(j)) * LCc / 2)

Exit For

ElseIfCalLCsz(i)=Startlcsz(j) Then

Calxysz(1， i)=StartXYsz(1， j)

Calxysz(2， i)=StartXYsz(2， j)

CalFwjsz(i)=StartDFwjsz(j)

Else

Calxysz(1， i)="--"

Calxysz(2， i)="--"

CalFwjsz(i)="--"

End If

Next

End If

Next

Application.ScreenUpdating=False

.Range(Cells(5，2)，Cells(UBound(CalLCsz)+4，3))=Application.WorksheetFunction.Transpose(Calxysz)

.Range(Cells(5，4)，Cells(UBound(CalLCsz)+4，4))=Application.WorksheetFunction.Transpose(CalFwjsz) ’計(jì)算結(jié)果顯示在指定區(qū)域

End With

Application.ScreenUpdating=True

End Sub

計(jì)算結(jié)果如表3所示，出現(xiàn)“--”符號(hào)表示計(jì)算里程超出設(shè)計(jì)范圍或者里程輸入有誤。

表3　坐標(biāo)計(jì)算結(jié)果

3坐標(biāo)展點(diǎn)

當(dāng)線(xiàn)路設(shè)計(jì)中樁計(jì)算完成后，可以進(jìn)行任意距離的邊樁計(jì)算，并打開(kāi)cad，自動(dòng)展點(diǎn)。按ALT+F11打開(kāi)VBE界面，點(diǎn)擊“插入-模塊”，將以下代碼復(fù)制并黏貼到模塊中，點(diǎn)擊運(yùn)行。

Option Explicit

Sub CadDraw()’利用cad畫(huà)點(diǎn)主程序

Dim acadApp As Object’定義cad對(duì)象

Dim acadDoc As Object

Dim Drawxy

Dim Selrng As Range’定義需要繪圖的表格區(qū)域

Dim Sopenfilename

Dim cell As Range

Dim Points(1 To 3) As Double’定義三維點(diǎn)

Dim i As Long

Dim AddNewfile As String

On Error Resume Next’忽略錯(cuò)誤

Set acadApp=GetObject(， "AutoCAD.Application")’獲取cad對(duì)象

If Err Then

Err.Clear

Set acadApp=CreateObject("AutoCAD.Application")’如果獲取cad對(duì)象失敗，則創(chuàng)建

If Err Then End

End If

AddNewfile=MsgBox("是否打開(kāi)已有文件繪圖？"， vbYesNo+vbQuestion+vbDefaultButton2， "選擇操作")

If AddNewfile=vbYes Then

Sopenfilename=Application.GetOpenFilename("Dwg格式文件(*.dwg)，*.dwg"，， "請(qǐng)選擇需要繪圖的(*.dwg)格式文件"， MultiSelect:=False) ’打開(kāi)已有dwg格式的文件

Set acadDoc=acadApp.Documents.Open(Sopenfilename) ’給cad對(duì)象賦值

Else

Set acadDoc=acadApp.Documents.Add’創(chuàng)建新的cad對(duì)象

End If

Set acadDoc=acadApp.ActiveDocument

acadApp.Visible=True

Do While Selrng.Columns.Count <> 2 Or Selrng.Rows.Count < 2 '循環(huán)選擇繪圖的數(shù)據(jù)區(qū)域，直至選擇出正確區(qū)域?yàn)橹?/p>

Set Selrng=Application.InputBox("選擇XY的區(qū)域，X在前，Y在后"， "Select range"，，，，，，8)

If Selrng.Columns.Count <> 2 Or Selrng.Rows.Count < 2 Then

MsgBox "選擇區(qū)域不對(duì)，請(qǐng)重新選擇!" & Chr(13) & "注意選擇的區(qū)域必須為兩列(至少兩行)，且X在前，Y在后!"

End If

Loop

For Each cell In Selrng

If IsNumeric(cell)=False Then’循環(huán)判斷選擇的單元格的值是否有效

MsgBox "選擇的區(qū)域含有非法字符，不能繪圖，請(qǐng)重試!"

Exit Sub

End If

Next cell

ReDim Drawxy(1 To 2， 1 To Selrng.Rows.Count)

Drawxy=Application.WorksheetFunction.Transpose(Selrng) ’繪圖坐標(biāo)數(shù)組賦值

For i=1 To UBound(Drawxy， 2)

Points(1)=Drawxy(2， i)

Points(2)=Drawxy(1， i)

Points(3)=0

acadDoc.ModelSpace.AddPoint Points’cad展點(diǎn)關(guān)鍵的代碼

Next

acadDoc.Application.Update’cad界面更新

acadDoc.Save’保存cad文件

End Sub

代碼首先預(yù)定義acadApp為對(duì)象，再利用后期綁定的方法定義為cad對(duì)象，便于利用cad的庫(kù)進(jìn)行后續(xù)的繪圖，且可以利用程序?qū)c(diǎn)的顏色、大小、形狀以及圖層等諸多特性進(jìn)行設(shè)置，此處未展示源代碼。由以上程序可見(jiàn)，只要實(shí)現(xiàn)錄入設(shè)計(jì)圖紙?zhí)峁┑木€(xiàn)路參數(shù)，運(yùn)行以上兩個(gè)主程序，就可以準(zhǔn)確、快速實(shí)現(xiàn)線(xiàn)路的坐標(biāo)展點(diǎn)。

4結(jié)束語(yǔ)

隨著Excel不斷發(fā)展，其數(shù)據(jù)處理能力愈加強(qiáng)大，VBA也伴隨著其一同發(fā)展，其良好的數(shù)據(jù)處理能力和用戶(hù)交互界面將更大程度解決繁瑣的數(shù)據(jù)計(jì)算。同時(shí)，CAD內(nèi)置VBA，同樣可以進(jìn)行良好的運(yùn)用，兩者的有機(jī)結(jié)合和集成開(kāi)發(fā)，其交互能力、數(shù)據(jù)處理能力將愈發(fā)強(qiáng)大，作用也會(huì)更為明顯。

參考文獻(xiàn)

[1]張正祿，等.工程測(cè)量學(xué)[M].武漢：武漢大學(xué)出版社，2005

[2]狄鋼.AutoCAD VBA在工程測(cè)量中的應(yīng)用[J].鐵道勘察,2006(6)

[3]王建國(guó),吳美容.運(yùn)用ACAD VBA語(yǔ)言設(shè)計(jì)批量繪制隧道橫斷面軟件[J].鐵道勘察,2010(4)

[4]張帆，等.AutoCAD VBA二次開(kāi)發(fā)教程[M].北京:清華大學(xué)出版社，2006

[5]羅剛君.Excel VBA程序開(kāi)發(fā)自學(xué)寶典：第2版[M].北京：電子工業(yè)出版社，2009

中圖分類(lèi)號(hào)：P283.7

文獻(xiàn)標(biāo)識(shí)碼：B

文章編號(hào)：1672-7479(2015)01-0036-04

作者簡(jiǎn)介：張仕林(1987—)，男，2010年畢業(yè)于長(zhǎng)安大學(xué)測(cè)繪工程專(zhuān)業(yè)，助理工程師。

收稿日期：2014-11-15