利用VBA編程實現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換

1、利用VBA編程實現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換         06-03-20 11:40:00     作者：查擁軍    編輯：studa9ngns摘要：該程序可將Excel表格中的所有單元格全部按原來大小、風(fēng)格轉(zhuǎn)換到AutoCAD文件中來。在轉(zhuǎn)換過程中，表格線條的轉(zhuǎn)換和文字轉(zhuǎn)換是重點。文字轉(zhuǎn)換采用了直接利用AddMtext命令提供的屬性進行轉(zhuǎn)換，避免了已往修改形文件來進行文字標注的方法，直接控制表格文字字體、大小、下劃線

2、、上下腳標，傾斜，加粗等，使每個文字的風(fēng)格均可以得到很好的控制，極大提高了文字標注的靈活性。 關(guān)鍵詞：計算機  - 一、前言 - Microsoft Excel 軟件具有十分強大的制表、表格計算等功能，是普通人員常用的制表工具?？梢酝ㄟ^其內(nèi)嵌的VBA語言可以控制Microsoft Excel 的整個操作過程。 - AutoCAD是由AutoDesk公司的工程繪圖軟件，是CAD市場的主流產(chǎn)品，功能十分強大，是工程制圖人員常用的軟件之一。AutoDesk公司從R14版以后，為其提供了VBA語言接口。 - 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。其一，是利用剪貼板，將Mi

3、crosoft Excel表格拷貝至剪貼板中，然后打開AutoCAD文件，再將剪貼板中的文件粘貼至所需位置。這種方法十分簡單，但有其固有的缺點。同時打開多個表格操作，需要占據(jù)較大的內(nèi)存空間。文件體積變得很大，表格有時在.dwg文件中以圖標形式顯示，不便于觀察。 - 第二種方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進行轉(zhuǎn)換，將Microsoft Excel表格按原來樣子轉(zhuǎn)換，即把Microsoft Excel表格中的文字和線條信息全部讀取出來，在AutoCAD文件里按照一一對應(yīng)的方式寫出來，確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方法的缺點，便

4、于表格內(nèi)容編輯。本文著重介紹此方法。 - 二、表格轉(zhuǎn)換工作機理分析及具體實現(xiàn)方法 - 1表格轉(zhuǎn)換工作機理分析 - 在制表過程中，經(jīng)常遇到兩個概念，表和方格。 - 在Microsoft Excel中，與表對應(yīng)的對象是工作表（Sheet或Worksheet）,與每一個表格方格相對應(yīng)的對象是單元格區(qū)域（range），它可以僅包括一個單元格（cell）,也可以由多個單元格合并而成。 - 在AutoCAD中，沒有與表對應(yīng)的對象，但表可以理解由若干條線和文字對象組合而成。 - 根據(jù)上述分析，可以發(fā)現(xiàn)如下的轉(zhuǎn)換方法： - 讀取Microsoft Excel文件中的最小對象-單元格區(qū)域(range)的主要信息

5、-線條和文字，然后在AutoCAD文件里在指定圖層、位置畫線條，書寫文字。通過循環(huán)，遍歷所有單元格區(qū)域(range),邊讀邊寫，最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過程中，保持線條、文字及其相關(guān)屬性不發(fā)生改變。 - 下面就轉(zhuǎn)換工作的兩個主要對象表格線條和表格文字進行討論。 - 2、表格線條的轉(zhuǎn)換 - Microsoft Excel 中內(nèi)嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常，通過訪問range對象，可以獲得許多信息。訪問分析表格的屬性應(yīng)從分析range開始。每一個range包括許多對象和屬性,例如,font對象可以返回range的字體信息。通過遍歷,即可獲得整個表格信息。獲取表格信息的

6、目的在于準確地按照位置畫表格線，同時確定文字位置。 - 在獲取表格信息時，存在一個最佳算法問題。以下就畫線問題為例，闡明問題和解決方法。 - 假設(shè)表格由a(a>=1)行b(b>=1)列組成,x，y為循環(huán)變量, 表格完全由單元格組成，由于在每個單元格都有4條邊，讓x從1開始循環(huán)到a, 再y從1開始循環(huán)到b,讀取每個單元格的4條邊,會讀取a*b*4次，重復(fù)讀取a*b*2次。當x=1時，讀取上邊；當y=1時讀取,左邊，其余情況讀取右邊，下邊。共讀取a+b+ a*b*2次。以3行4列為例，共讀取3+4+3*4*2=31次，與實際表格的邊數(shù)相同，沒有重復(fù)讀取。 - 對合并單元格信息的讀取是個

7、難點。因為如果按照單元格的位置依次讀取，那么由a行b列個單元格（cell）合并而成的單元格區(qū)域(range)僅有4條邊，采用上述計算方法，需要讀取a+b+ a*b*2次，重復(fù)讀取a+b+ a*b*2 - 4次。以以3行4列為例，共讀取3+4+3*4*2=31次，重復(fù)讀取31 - 4=27次。算法有重復(fù)。如果按照行號，列號讀取，合并單元格的行號、列號只有一個，其值為最靠左、靠上的那個單元格的行號、列號。例如，將A2：E5的單元格合并后，其行號為2，列號為A。這樣由多個合并單元格組合后的表格行號、列號有間斷，不連續(xù)，無法進行循環(huán)讀取信息。筆者通過研究發(fā)現(xiàn)，函數(shù)address（）和單元格的merge

8、area屬性可以獲得合并單元格的準確信息。具體方法為：讀取cells(x,y)單元格時，用address()判斷包含cells(x,y)單元格的合并單元格區(qū)域c.mergearea的絕對地址,如果前4個字符與cells(x,y) 單元格的地址相同，為cells(x,y)單元格為合并單元格區(qū)域最靠上、靠左的那個合并單元格，讀取其4條邊信息，否則不讀取。這樣，徹底避免了重復(fù)讀取，同時提高了整個讀取和畫線速度。 -在AutoCAD中，線條有多種，考慮能夠方便控制線條屬性，選用了多義線。具體命令如下：RetVal=object.AddLightWeightPolyline(VerticesList)

9、- 下面的程序演示表格線條讀取和畫表格線的具體過程。 Sub hxw() Dim a as interger 表格的最大行數(shù) Dim b as interger 表格的最大列數(shù) Dim xinit as double 插入點x坐標 Dim yinit as double 插入點y坐標 Dim zinit as double 插入點z坐標 Dim xinsert as double 當前單元格的左上角點的x左標 Dim yinsert as double 當前單元格的左上角點的y左標 Dim ptarray (0 to 2) as double Dim x as integer Dim y as

10、 integer For x =1 to a For y=1 to b Set c = xlsheet.Range(zh(y) + Trim(Str(x) 以行號、列號獲得單元格地址 Set ma = c.MergeArea 求出單元格C的合并單元格地址 If Left(Trim(ma.Address), 4) = Trim(c.Address) Then 假如c.mergearea的絕對地址,如果前4個字符與c單元格的地址相同 xl = "A1:" + ma.Address xh = xlsheet.Range(ma.Address).Width yh = xlsheet

11、.Range(ma.Address).Height Set xlrange = xlsheet.Range(xl) xinsert = xlrange.Width - xh yinsert = xlrange.Height - yh xpoint = xinit + xinsert ypoint = yinit - yinsert If x = 1 Then If ma.Borders(xlEdgeTop).LineStyle <> xlNone Then ptArray(0) = xpoint 第一點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint ptA

12、rray(2) = xpoint + xh 第二點坐標（數(shù)組下標 2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight End If If ma.Borders(xlEdgeBottom).LineStyle < > xlNone Then ptArray(0) = xpoint + xh 第三點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint 第四點坐標（數(shù)組下標 2 and 3） ptA

13、rray(3) = ypoint yh Lineweight lwployobj, ma.Borders(xlEdgeBottom).Weight End If If y = 1 Then If ma.Borders(xlEdgeLeft).LineStyle < > xlNone Then ptArray(0) = xpoint 第四點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint 第一點坐標（數(shù)組下標 2 and 3) ptArray(3) = ypoint End If Lineweight lwpl

14、oyobj, ma.Borders(xlEdgeLeft).Weight End If If ma.Borders(xlEdgeRight).LineStyle < > xlNone Then ptArray(0) = xpoint + xh 第二點坐標（數(shù)組下標 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh 第三點坐標（數(shù)組下標 2 and 3） ptArray(3) = ypoint yh Lineweight lwployobj, ma.Borders(xlEdgeRight).Weight End If Set

15、lwployobj = moSpace.AddLightWeightPolyline(ptArray) 在AutoCAD文件里畫線 With lwployobj .Layer = 指定lwployobj所在圖層 .Color = acBlue 指定lwployobj的顏色 End With Lwployobj.Update Next y Next x End Sub 下面程序控制線條粗細 Sub Lineweight(ByVal line As Object, u As Integer) Select Case u Case 1 Call line.SetWidth(0, 0.1, 0.1) Case 2 Call line.SetWidth(0, 0.3, 0.3) Case -4138 Call line.SetWidth(0, 0.5, 0.5) Case 4 Call line.SetWidth(0, 1, 1) Case Else Call line.SetWidth(0, 0.1, 0.1) End Select End Sub 下面程序完成列號轉(zhuǎn)換 Function zh(pp As Integer) As String If pp < 26 Then zh = Chr(64 + pp) Else zh = Chr(