利用VBA编程实现从EXCEL表到AUTOCAD表转换(2)
作者:佚名; 更新时间:2014-12-05
--- 通过修改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 ‘设置书写方向
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
---- 三、功能与特点介绍
---- 该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。在转换过程中,表格线条的转换和文字转换是重点。文字转换采用了直接利用AddMtext命令提供的属性进行转换,避免了已往修改形文件来进行文字标注的方法,直接控制表格文字字体、大小、下划线、上下脚标,倾斜,加粗等,使每个文字的风格均可以得到很好的控制,极大提高了文字标注的灵活性。
---- 本程序采用Visual BASIC编制,需要Microsoft Excel 2000和AutoCAD R14运行环境,编译后通过。
---- (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 ‘设置书写方向
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
---- 三、功能与特点介绍
---- 该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。在转换过程中,表格线条的转换和文字转换是重点。文字转换采用了直接利用AddMtext命令提供的属性进行转换,避免了已往修改形文件来进行文字标注的方法,直接控制表格文字字体、大小、下划线、上下脚标,倾斜,加粗等,使每个文字的风格均可以得到很好的控制,极大提高了文字标注的灵活性。
---- 本程序采用Visual BASIC编制,需要Microsoft Excel 2000和AutoCAD R14运行环境,编译后通过。
上一篇:MIS 系统开发中的项目管理
下一篇:Delphi常用应用函数
热门论文