一、前言

---- Microsoft Excel 軟件具有十分強(qiáng)大的制表、表格計(jì)算等功能，是普通人員常用的制表工具�？梢酝ㄟ^(guò)其內(nèi)嵌的VBA語(yǔ)言可以控制Microsoft Excel 的整個(gè)操作過(guò)程。

---- AutoCAD是由AutoDesk公司的工程繪圖軟件，是CAD市場(chǎng)的主流產(chǎn)品，功能十分強(qiáng)大，是工程制圖人員常用的軟件之一。AutoDesk公司從R14版以后，為其提供了VBA語(yǔ)言接口。

---- 在工程制圖中，常常需要在圖中插入繪制表格，一般有兩種方法。其一，是利用剪貼板，將Microsoft Excel表格拷貝至剪貼板中，然后打開(kāi)AutoCAD文件，再將剪貼板中的文件粘貼至所需位置。這種方法十分簡(jiǎn)單，但有其固有的缺點(diǎn)。①在保存文件必須將.xls和.dwg文件保存在一起，一旦缺少excel環(huán)境，則再對(duì)表格繼續(xù)修改。②同時(shí)打開(kāi)多個(gè)表格操作，需要占據(jù)較大的內(nèi)存空間。③文件體積變得很大，表格有時(shí)在.dwg文件中以圖標(biāo)形式顯示，不便于觀察。

---- 第二種方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，編制程序進(jìn)行轉(zhuǎn)換，將Microsoft Excel表格按原來(lái)樣子轉(zhuǎn)換，即把Microsoft Excel表格中的文字和線條信息全部讀取出來(lái)，在AutoCAD文件里按照一一對(duì)應(yīng)的方式寫(xiě)出來(lái)，確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方法的缺點(diǎn)，便于表格內(nèi)容編輯。本文著重介紹此方法。

---- 二、表格轉(zhuǎn)換工作機(jī)理分析及具體實(shí)現(xiàn)方法

---- 1．表格轉(zhuǎn)換工作機(jī)理分析

---- 在制表過(guò)程中，經(jīng)常遇到兩個(gè)概念，表和方格。

---- 在Microsoft Excel中，與表對(duì)應(yīng)的對(duì)象是工作表（Sheet或Worksheet）,與每一個(gè)表格方格相對(duì)應(yīng)的對(duì)象是單元格區(qū)域（range），它可以?xún)H包括一個(gè)單元格（cell）,也可以由多個(gè)單元格合并而成。

---- 在AutoCAD中，沒(méi)有與表對(duì)應(yīng)的對(duì)象，但表可以理解由若干條線和文字對(duì)象組合而成。

---- 根據(jù)上述分析，可以發(fā)現(xiàn)如下的轉(zhuǎn)換方法：

---- 讀取Microsoft Excel文件中的最小對(duì)象----單元格區(qū)域(range)的主要信息---線條和文字，然后在AutoCAD文件里在指定圖層、位置畫(huà)線條，書(shū)寫(xiě)文字。通過(guò)循環(huán)，遍歷所有單元格區(qū)域(range),邊讀邊寫(xiě)，最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過(guò)程中，保持線條、文字及其相關(guān)屬性不發(fā)生改變。

---- 下面就轉(zhuǎn)換工作的兩個(gè)主要對(duì)象表格線條和表格文字進(jìn)行討論。

---- 2、表格線條的轉(zhuǎn)換

---- Microsoft Excel 中內(nèi)嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常，通過(guò)訪問(wèn)range對(duì)象，可以獲得許多信息。訪問(wèn)分析表格的屬性應(yīng)從分析range開(kāi)始。每一個(gè)range包括許多對(duì)象和屬性,例如,font對(duì)象可以返回range的字體信息。通過(guò)遍歷,即可獲得整個(gè)表格信息。獲取表格信息的目的在于準(zhǔn)確地按照位置畫(huà)表格線，同時(shí)確定文字位置。

---- 在獲取表格信息時(shí)，存在一個(gè)最佳算法問(wèn)題。以下就畫(huà)線問(wèn)題為例，闡明問(wèn)題和解決方法。

---- 假設(shè)表格由a(a>=1)行b(b>=1)列組成,x，y為循環(huán)變量, 表格完全由單元格組成，由于在每個(gè)單元格都有4條邊，讓x從1開(kāi)始循環(huán)到a, 再y從1開(kāi)始循環(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ù)相同，沒(méi)有重復(fù)讀取。

---- 對(duì)合并單元格信息的讀取是個(gè)難點(diǎn)。因?yàn)槿绻�按照單元格的位置依次讀取，那么由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)讀取信息。筆者通過(guò)研究發(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è)讀取和畫(huà)線速度。

---- 在AutoCAD中，線條有多種，考慮能夠方便控制線條屬性，選用了多義線。具體命令如下： RetVal = object.AddLightWeightPolyline(VerticesList)

---- 下面的程序演示表格線條讀取和畫(huà)表格線的具體過(guò)程。

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文件里畫(huà)線
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 Function

利用VBA編程實(shí)現(xiàn)從EXCEL表到AUTOCAD表轉(zhuǎn)換(2)
-- 3、表格文字轉(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)

---- 通過(guò)修改RetVal的屬性可以控制表格文字在表格中的位置。

---- (1)．表格文字本身的轉(zhuǎn)換

---- 分析AddMText命令可以得出：表格文字所在位置、文字內(nèi)容寬度，文字內(nèi)容，均可通過(guò)此命令來(lái)添加。然而表格文字字體，大小，下劃線、上下腳標(biāo)，傾斜，加粗等卻不能。一般的方法是采用修改字體形文件的方法來(lái)實(shí)現(xiàn)，方法煩瑣，不便于實(shí)現(xiàn)，而且僅對(duì)修改過(guò)形文件的字體有效。況且當(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è)字符開(kāi)始，重復(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ì)象的屬性的直接控制來(lái)實(shí)現(xiàn)，通過(guò)with….end with 結(jié)構(gòu)可以很容易地控制文字的高度、圖層、顏色、書(shū)寫(xiě)方向。由于Mtext文字提供支持的排列位置分為9種，必須根據(jù)Microsoft Excel表格文字的排列方式加以合適的判定，然后進(jìn)行轉(zhuǎn)換。其具體的實(shí)現(xiàn)方法詳見(jiàn)下面的程序。

Sub kz( )
With textObj ‘文字對(duì)象
.Height = textHgt
.Layer = newlayer.Name ‘設(shè)置圖層
.Color = acRed ‘設(shè)置顏色
.DrawingDirection = 1 ‘設(shè)置書(shū)寫(xiě)方向
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表格中的所有單元格全部按原來(lái)大小、風(fēng)格轉(zhuǎn)換到AutoCAD文件中來(lái)。在轉(zhuǎn)換過(guò)程中，表格線條的轉(zhuǎn)換和文字轉(zhuǎn)換是重點(diǎn)。文字轉(zhuǎn)換采用了直接利用AddMtext命令提供的屬性進(jìn)行轉(zhuǎn)換，避免了已往修改形文件來(lái)進(jìn)行文字標(biāo)注的方法，直接控制表格文字字體、大小、下劃線、上下腳標(biāo)，傾斜，加粗等，使每個(gè)文字的風(fēng)格均可以得到很好的控制，極大提高了文字標(biāo)注的靈活性。