[推荐]VBA编程实现从EXCEL表到AUTOCAD表转换(2)

-- 3、表格文字转换

---- 表格文字转换包括表格文字本身转换和表格文字在表格中位置的转换两个部分。

---- 在AutoCAD中，文字标注的形式有多种，与Microsoft Excel 单元格区域多行文本内容相对应的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令语句是：

RetVal = object.AddMText(InsertionPoint, Width, Text)

---- 通过修改RetVal的属性可以控制表格文字在表格中的位置。

---- (1)．表格文字本身的转换

---- 分析AddMText命令可以得出：表格文字所在位置、文字内容宽度，文字内容，均可通过此命令来添加。然而表格文字字体，大小，下划线、上下脚标，倾斜，加粗等却不能。一般的方法是采用修改字体形文件的方法来实现，方法烦琐，不便于实现，而且仅对修改过形文件的字体有效。况且当同一文字块内的不同文字的字体，大小，下划线、上下脚标，倾斜，加粗不同时，使用修改字体形文件的方法也无法实现。本文介绍一种直接利用Mtext命令提供的方法进行转换。

---- 在AddMText命令中，影响文字内容和文字属性的参数Text。在具体文字前加上一定的控制符号可以控制文字的文字属性，具体控制符号可以参阅AutoCAD帮助文件。例如，{\F宋体；\Q18;\W1.2;ABCDEFG}把“ABCDEFG”设置成宋体、向右倾斜18度，每个字的宽度是正常宽度1.2倍。

---- 本程序具体采用的方法是：读取Microsoft Excel文件某一单元格区域里的某第j个字符属性（字体，大小，下划线、上、下脚标，倾斜，加粗），读取Microsoft Excel文件某一单元格区域里的某第j+1个字符属性，如果与第j个字符相同，则二者采用同样的控制符号；若不同，则从第j+1个字符开始，重复前面的工作。

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
‘下面函数控制字体本身属性
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;", "") '上脚标
a3 = IIf(m.Characters(u, 1).Font.Subscript =
True, "\H0.33x;\A0;", "") '下脚标
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）.表格中表格文字位置的转换

---- 对文字对象的属性的直接控制来实现，通过with….end with 结构可以很容易地控制文字的高度、图层、颜色、书写方向。由于Mtext文字提供支持的排列位置分为9种，必须根据Microsoft Excel表格文字的排列方式加以合适的判定，然后进行转换。其具体的实现方法详见下面的程序。

Sub kz( )
With textObj ‘文字对象
.Height = textHgt
.Layer = newlayer.Name ‘设置图层
.Color = acRed ‘设置颜色
.DrawingDirection = 1 ‘设置书写方向