電子發(fā)燒友App
利用VBA編程實(shí)現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換
一、前言
---- Microsoft Excel 軟件具有十分強(qiáng)大的制表、表格計(jì)算等功能，是普通人員常用的制表工具?？梢酝ㄟ^其內(nèi)嵌的VBA語(yǔ)言可以控制Microsoft Excel 的整個(gè)操作過程。
---- AutoCAD是由AutoDesk公司的工程繪圖軟件，是CAD市場(chǎng)的主流產(chǎn)品，功能十分強(qiáng)大，是工程制圖人員常用的軟件之一。AutoDesk公司從R14版以后，為其提供了VBA語(yǔ)言接口。
---- 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。其一，是利用剪貼板，將Microsoft Excel表格拷貝至剪貼板中，然后打開AutoCAD文件，再將剪貼板中的文件粘貼至所需位置。這種方法十分簡(jiǎn)單，但有其固有的缺點(diǎn)。①在保存文件必須將.xls和.dwg文件保存在一起，一旦缺少excel環(huán)境，則再對(duì)表格繼續(xù)修改。②同時(shí)打開多個(gè)表格操作，需要占據(jù)較大的內(nèi)存空間。③文件體積變得很大，表格有時(shí)在.dwg文件中以圖標(biāo)形式顯示，不便于觀察。
---- 第二種方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進(jìn)行轉(zhuǎn)換，將Microsoft Excel表格按原來樣子轉(zhuǎn)換，即把Microsoft Excel表格中的文字和線條信息全部讀取出來，在AutoCAD文件里按照一一對(duì)應(yīng)的方式寫出來，確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方法的缺點(diǎn)，便于表格內(nèi)容編輯。本文著重介紹此方法。
---- 二、表格轉(zhuǎn)換工作機(jī)理分析及具體實(shí)現(xiàn)方法
---- 1．表格轉(zhuǎn)換工作機(jī)理分析
---- 在制表過程中，經(jīng)常遇到兩個(gè)概念，表和方格。
---- 在Microsoft Excel中，與表對(duì)應(yīng)的對(duì)象是工作表（Sheet或Worksheet）,與每一個(gè)表格方格相對(duì)應(yīng)的對(duì)象是單元格區(qū)域（range），它可以僅包括一個(gè)單元格（cell）,也可以由多個(gè)單元格合并而成。
---- 在AutoCAD中，沒有與表對(duì)應(yīng)的對(duì)象，但表可以理解由若干條線和文字對(duì)象組合而成。
---- 根據(jù)上述分析，可以發(fā)現(xiàn)如下的轉(zhuǎn)換方法：
---- 讀取Microsoft Excel文件中的最小對(duì)象----單元格區(qū)域(range)的主要信息---線條和文字，然后在AutoCAD文件里在指定圖層、位置畫線條，書寫文字。通過循環(huán)，遍歷所有單元格區(qū)域(range),邊讀邊寫，最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過程中，保持線條、文字及其相關(guān)屬性不發(fā)生改變。
---- 下面就轉(zhuǎn)換工作的兩個(gè)主要對(duì)象表格線條和表格文字進(jìn)行討論。
---- 2、表格線條的轉(zhuǎn)換
---- Microsoft Excel 中內(nèi)嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常，通過訪問range對(duì)象，可以獲得許多信息。訪問分析表格的屬性應(yīng)從分析range開始。每一個(gè)range包括許多對(duì)象和屬性,例如,font對(duì)象可以返回range的字體信息。通過遍歷,即可獲得整個(gè)表格信息。獲取表格信息的目的在于準(zhǔn)確地按照位置畫表格線，同時(shí)確定文字位置。
---- 在獲取表格信息時(shí)，存在一個(gè)最佳算法問題。以下就畫線問題為例，闡明問題和解決方法。
---- 假設(shè)表格由a(a>=1)行b(b>=1)列組成,x，y為循環(huán)變量, 表格完全由單元格組成，由于在每個(gè)單元格都有4條邊，讓x從1開始循環(huán)到a, 再y從1開始循環(huán)到b,讀取每個(gè)單元格的4條邊,會(huì)讀取a*b*4次，重復(fù)讀取a*b*2次。當(dāng)x=1時(shí)，讀取上邊；當(dāng)y=1時(shí)讀取,左邊，其余情況讀取右邊，下邊。共讀取a+b+ a*b*2次。以3行4列為例，共讀取3+4+3*4*2=31次，與實(shí)際表格的邊數(shù)相同，沒有重復(fù)讀取。
---- 對(duì)合并單元格信息的讀取是個(gè)難點(diǎn)。因?yàn)槿绻凑諉卧竦奈恢靡来巫x取，那么由a行b列個(gè)單元格（cell）合并而成的單元格區(qū)域(range)僅有4條邊，采用上述計(jì)算方法，需要讀取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ù)。如果按照行號(hào)，列號(hào)讀取，合并單元格的行號(hào)、列號(hào)只有一個(gè)，其值為最靠左、靠上的那個(gè)單元格的行號(hào)、列號(hào)。例如，將A2：E5的單元格合并后，其行號(hào)為2，列號(hào)為A。這樣由多個(gè)合并單元格組合后的表格行號(hào)、列號(hào)有間斷，不連續(xù)，無(wú)法進(jìn)行循環(huán)讀取信息。筆者通過研究發(fā)現(xiàn)，函數(shù)address（）和單元格的mergearea屬性可以獲得合并單元格的準(zhǔn)確信息。具體方法為：讀取cells(x,y)單元格時(shí)，用address()判斷包含cells(x,y)單元格的合并單元格區(qū)域c.mergearea的絕對(duì)地址,如果前4個(gè)字符與cells(x,y) 單元格的地址相同，為cells(x,y)單元格為合并單元格區(qū)域最靠上、靠左的那個(gè)合并單元格，讀取其4條邊信息，否則不讀取。這樣，徹底避免了重復(fù)讀取，同時(shí)提高了整個(gè)讀取和畫線速度。
---- 在AutoCAD中，線條有多種，考慮能夠方便控制線條屬性，選用了多義線。具體命令如下： RetVal = object.AddLightWeightPolyline(VerticesList)
---- 下面的程序演示表格線條讀取和畫表格線的具體過程。
Sub hxw() Dim a as interger ‘表格的最大行數(shù) Dim b as interger ‘表格的最大列數(shù) Dim xinit as double ‘插入點(diǎn)x坐標(biāo) Dim yinit as double ‘插入點(diǎn)y坐標(biāo) Dim zinit as double ‘插入點(diǎn)z坐標(biāo) Dim xinsert as double ‘當(dāng)前單元格的左上角點(diǎn)的x左標(biāo) Dim yinsert as double ’當(dāng)前單元格的左上角點(diǎn)的y左標(biāo) Dim ptarray (0 to 2) as double Dim x as integer Dim y as integer For x =1 to a For y=1 to b Set c = xlsheet.Range(zh(y) + Trim(Str(x))) ‘以行號(hào)、列號(hào)獲得單元格地址 Set ma = c.MergeArea ‘求出單元格C的合并單元格地址 If Left(Trim(ma.Address), 4) = Trim(c.Address) Then 假如c.mergearea的絕對(duì)地址,如果前4個(gè)字符與c單元格的地址相同 xl = "A1:" + ma.Address xh = xlsheet.Range(ma.Address).Width yh = xlsheet.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 ‘第一點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh ‘第二點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 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 ‘第三點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint ‘第四點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 2 and 3） ptArray(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 ‘第四點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint - yh ptArray(2) = xpoint ‘第一點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight End If If ma.Borders(xlEdgeRight).LineStyle < > xlNone Then ptArray(0) = xpoint + xh ‘第二點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh ‘第三點(diǎn)坐標(biāo)（數(shù)組下標(biāo) 2 and 3） ptArray(3) = ypoint – yh Lineweight lwployobj, ma.Borders(xlEdgeRight).Weight End If Set lwployobj = moSpace.AddLightWeightPolyline(ptArray) ‘在AutoCAD文件里畫線 With lwployobj .Layer = newlayer.name ‘指定lwployobj所在圖層 .Color = acBlue ‘指定lwployobj的顏色 End With Lwployobj.Update Next y Next x End Sub ‘下面程序控制線條粗細(xì) 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 ‘下面程序完成列號(hào)轉(zhuǎn)換 Function zh(pp As Integer) As String If pp < 26 Then zh = Chr(64 + pp) Else zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26) End If End Function3、表格文字轉(zhuǎn)換
---- 表格文字轉(zhuǎn)換包括表格文字本身轉(zhuǎn)換和表格文字在表格中位置的轉(zhuǎn)換兩個(gè)部分。
---- 在AutoCAD中，文字標(biāo)注的形式有多種，與Microsoft Excel 單元格區(qū)
域多行文本內(nèi)容相對(duì)應(yīng)的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令語(yǔ)句是：
RetVal = object.AddMText(InsertionPoint, Width, Text)
---- 通過修改RetVal的屬性可以控制表格文字在表格中的位置。
---- (1)．表格文字本身的轉(zhuǎn)換
---- 分析AddMText命令可以得出：表格文字所在位置、文字內(nèi)容寬度，
文字內(nèi)容，均可通過此命令來添加。然而表格文字字體，大小，下劃線、
上下腳標(biāo)，傾斜，加粗等卻不能。
一般的方法是采用修改字體形文件的方法來實(shí)現(xiàn)，方法煩瑣，不便于實(shí)現(xiàn)，
而且僅對(duì)修改過形文件的字體有效。
況且當(dāng)同一文字塊內(nèi)的不同文字的字體，大小，下劃線、上下腳標(biāo)，傾斜，
加粗不同時(shí)，使用修改字體形文件的方法也無(wú)法實(shí)現(xiàn)。
本文介紹一種直接利用Mtext命令提供的方法進(jìn)行轉(zhuǎn)換。
---- 在AddMText命令中，影響文字內(nèi)容和文字屬性的參數(shù)Text。在具體文
字前加上一定的控制符號(hào)可以控制文字的文字屬性，具體控制符號(hào)可以參閱AutoCAD幫助文件。
例如，{\F宋體；\Q18;\W1.2;ABCDEFG}把“ABCDEFG”設(shè)置成宋體、
向右傾斜18度，每個(gè)字的寬度是正常寬度1.2倍。
---- 本程序具體采用的方法是：讀取Microsoft Excel文件某一單元格區(qū)域里
的某第j個(gè)字符屬性（字體，大小，下劃線、上、下腳標(biāo)，傾斜，加粗），
讀取Microsoft Excel文件某一單元格區(qū)域里的某第j+1個(gè)字符屬性，
如果與第j個(gè)字符相同，則二者采用同樣的控制符號(hào)；若不同，則從第j+1個(gè)字符開始，
重復(fù)前面的工作。
Sub wz (? )
Char = RTrim(Left(c.Characters.Caption, 256))
If Char < > Empty Then
?? textStr = ""
?? For j = 1 To Len(Char)
? If c.Characters(j, 1).Font.Underline =
? xlUnderlineStyleNone Then
????????? cpt = c.Characters(j, 1).Caption
????????? sonstr = ForeFontStr(c, j)
????????? tempstr = ""
????????? Do While j + 1 < = Len(Char)
?????????????? sonstr1 = ForeFontStr(c, j + 1)
?????????????? If sonstr1 = sonstr Then
????????????????? j = j + 1
????????????????? tempstr = tempstr + c.Characters(j,
?1).Caption
?????????????? Else
????????????????? Exit Do
?????????????? End If
????????? Loop
????????? textStr = textStr + "{" + sonstr + cpt
? + tempstr + "}"
????? Else
????????? cpt = c.Characters(j, 1).Caption
????????? sonstr = ForeFontStr(c, j)
????????? tempstr = ""
????????? Do While j + 1 < = Len(Char)
????????????? sonstr1 = ForeFontStr(c, j + 1)
????????????? If sonstr1 = sonstr Then
???????????????? j = j + 1
???????????????? tempstr = tempstr + c.Characters(j,
? 1).Caption
????????????? Else
???????????????? Exit Do
????????????? End If
?????? Loop
?????????? textStr = textStr + "{\L" +
?????????? sonstr + cpt + tempstr + "\l}"
?????? End If
?? Next j
End If
End Sub???
‘下面函數(shù)控制字體本身屬性
Function ForeFontStr(m As Range, u As Integer) As String
??? a1 = "\F" + m.Characters(u, 1).Font.Name + ";"? ‘字體
a2 = IIf(m.Characters(u, 1).Font.Superscript =
True, "\H0.33x;\A2;", "")? '上腳標(biāo)
a3 = IIf(m.Characters(u, 1).Font.Subscript =
True, "\H0.33x;\A0;", "")? '下腳標(biāo)
a4 = IIf(m.Characters(u, 1).Font.FontStyle =
"傾斜", "\Q18;", "")? '傾斜
a5 = IIf(m.Characters(u, 1).Font.FontStyle =
?"加粗", "\W1.2;", "")? '加粗
a6 = IIf(m.Characters(u, 1).Font.FontStyle =
"加粗 傾斜", "\W1.2;\Q18;", "")? ' 加粗傾斜?
?ForeFontStr = a1 + a2 + a3 + a4 + a5 + a6
End Function---- （2）.表格中表格文字位置的轉(zhuǎn)換
---- 對(duì)文字對(duì)象的屬性的直接控制來實(shí)現(xiàn)，通過with….end with 結(jié)構(gòu)可以很容易地
控制文字的高度、圖層、顏色、書寫方向。
由于Mtext文字提供支持的排列位置分為9種，必須根據(jù)Microsoft Excel表格文字的排列
方式加以合適的判定，然后進(jìn)行轉(zhuǎn)換。其具體的實(shí)現(xiàn)方法詳見下面的程序。
Sub kz( )
With textObj ‘文字對(duì)象
??? .Height = textHgt
??? .Layer = newlayer.Name? ‘設(shè)置圖層
??? .Color = acRed????????? ‘設(shè)置顏色
??? .DrawingDirection = 1??? ‘設(shè)置書寫方向
?? If (ma.VerticalAlignment = xlTop _
?????? Or ma.VerticalAlignment = xlGeneral) _
?????? And (ma.HorizontalAlignment = xlLeft _
?????? Or ma.HorizontalAlignment = xlGeneral) _
?????? Then .AttachmentPoint = 1? 'acAttachmentPointTopLeft
?? If (ma.VerticalAlignment = xlTop _
?????? Or ma.VerticalAlignment = xlGeneral) _
?????? And (ma.HorizontalAlignment = xlCenter _
?????? Or ma.HorizontalAlignment = xlJustify _
?????? Or ma.HorizontalAlignment = xlDistributed) _
?????? Then .AttachmentPoint = 2? 'acAttachmentPointTopCenter
?? If (ma.VerticalAlignment = xlTop _
?????? Or ma.VerticalAlignment = xlGeneral) _
?????? And ma.HorizontalAlignment = xlRight _
?????? Then .AttachmentPoint = 3? 'acAttachmentPointTopRight
?? If (ma.VerticalAlignment = xlCenter _
?????? Or ma.VerticalAlignment = xlJustify _
?????? Or ma.VerticalAlignment = xlDistributed) _
?????? And (ma.HorizontalAlignment = xlLeft _
?????? Or ma.HorizontalAlignment = xlGeneral) _
?????? Then .AttachmentPoint = 4? 'acAttachmentPointMiddleLeft
?? If (ma.VerticalAlignment = xlCenter _
?????? Or ma.VerticalAlignment = xlJustify _
?????? Or ma.VerticalAlignment = xlDistributed) _
?????? And (ma.HorizontalAlignment = xlCenter _
?????? Or ma.HorizontalAlignment = xlJustify _
?????? Or ma.HorizontalAlignment = xlDistributed) _
?????? Then .AttachmentPoint = 5? 'acAttachmentPointMiddleCenter
?? If (ma.VerticalAlignment = xlCenter _
?????? Or ma.VerticalAlignment = xlJustify _
?????? Or ma.VerticalAlignment = xlDistributed) _
?????? And ma.HorizontalAlignment = xlRight _
?????? Then .AttachmentPoint = 6 'acAttachmentPointMiddleRight
?? If ma.VerticalAlignment = xlBottom _
?????? And (ma.HorizontalAlignment = xlLeft _
?????? Or ma.HorizontalAlignment = xlGeneral) _
?????? Then .AttachmentPoint = 7? 'acAttachmentPointBottomLeft
? If ma.VerticalAlignment = xlBottom _
?????? And (ma.HorizontalAlignment = xlCenter _
?????? Or ma.HorizontalAlignment = xlJustify _
?????? Or ma.HorizontalAlignment = xlDistributed) _
?????? Then .AttachmentPoint = 8? 'acAttachmentPointBottomCenter
? If ma.VerticalAlignment = xlBottom _
?????? And ma.HorizontalAlignment = xlRight _
?????? Then .AttachmentPoint = 9? 'acAttachmentPointBottomRight
End With
textObj.Update
End Sub---- 三、功能與特點(diǎn)介紹
---- 該程序可將Excel表格中的所有單元格全部按原來大小、
風(fēng)格轉(zhuǎn)換到AutoCAD文件中來。在轉(zhuǎn)換過程中，表格線條的轉(zhuǎn)換和文字轉(zhuǎn)換是重點(diǎn)。
文字轉(zhuǎn)換采用了直接利用AddMtext命令提供的屬性進(jìn)行轉(zhuǎn)換，
避免了已往修改形文件來進(jìn)行文字標(biāo)注的方法，
直接控制表格文字字體、大小、下劃線、上下腳標(biāo)，傾斜，加粗等，
使每個(gè)文字的風(fēng)格均可以得到很好的控制，極大提高了文字標(biāo)注的靈活性。
---- 本程序采用Visual BASIC編制，需要Microsoft Excel 2000和AutoCAD R14運(yùn)行環(huán)境，
編譯后通過。
工商網(wǎng)監(jiān)
評(píng)論