利用VBA编程实现从EXCEL表到AUTOCAD表转换doc221.docx
《利用VBA编程实现从EXCEL表到AUTOCAD表转换doc221.docx》由会员分享，可在线阅读，更多相关《利用VBA编程实现从EXCEL表到AUTOCAD表转换doc221.docx（13页珍藏版）》请在冰点文库上搜索。
利用VBA编程实现从EXCEL表到AUTOCAD表转换doc221
利用VBA编程实现从EXCEL表到AUTOCAD表转换
摘要：
该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。
在转换过程中，表格线条的转换和文字转换是重点。
文字转换采用了直接利用AddMtext命令提供的属性进行转换，防止了已往修改形文件来进行文字标注的方法，直接控制表格文字字体、大小、下划线、上下脚标，倾斜，加粗等，使每个文字的风格均可以得到很好的控制，极大提高了文字标注的灵活性。
关键词：
计算机
----一、前言
----MicrosoftExcel软件具有十分强大的制表、表格计算等功能，是普通人员常用的制表工具。
可以通过其内嵌的VBA语言可以控制MicrosoftExcel的整个操作过程。
----AutoCAD是由AutoDesk公司的工程绘图软件，是CAD市场的主流产品，功能十分强大，是工程制图人员常用的软件之一。
AutoDesk公司从R14版以后，为其提供了VBA语言接口。
----在工程制图中，常常需要在图中插入绘制表格，一般有两种方法。
其一，是利用剪贴板，将MicrosoftExcel表格拷贝至剪贴板中，然后翻开AutoCAD文件，再将剪贴板中的文件粘贴至所需位置。
这种方法十分简单，但有其固有的缺点。
①在保存文件必须将.xls和.dwg文件保存在一起，一旦缺少excel环境，那么再对表格继续修改。
②同时翻开多个表格操作，需要占据较大的内存空间。
③文件体积变得很大，表格有时在.dwg文件中以图标形式显示，不便于观察。
----第二种方法，即利用MicrosoftExcel、AutoCAD都提供的VBA功能，编制程序进行转换，将MicrosoftExcel表格按原来样子转换，即把MicrosoftExcel表格中的文字和线条信息全部读取出来，在AutoCAD文件里按照一一对应的方式写出来，确保转换后的表格与原表格一致。
这样彻底防止了前种方法的缺点，便于表格内容编辑。
本文着重介绍此方法。
----二、表格转换工作机理分析及具体实现方法
----1．表格转换工作机理分析
----在制表过程中，经常遇到两个概念，表和方格。
----在MicrosoftExcel中，与表对应的对象是工作表〔Sheet或Worksheet〕,与每一个表格方格相对应的对象是单元格区域〔range〕，它可以仅包括一个单元格〔cell〕,也可以由多个单元格合并而成。
----在AutoCAD中，没有与表对应的对象，但表可以理解由假设干条线和文字对象组合而成。
----根据上述分析，可以发现如下的转换方法：
----读取MicrosoftExcel文件中的最小对象----单元格区域（range）的主要信息---线条和文字，然后在AutoCAD文件里在指定图层、位置画线条，书写文字。
通过循环，遍历所有单元格区域（range）,边读边写，最终完成表格的转换。
转换过程中，保持线条、文字及其相关属性不发生改变。
----下面就转换工作的两个主要对象表格线条和表格文字进行讨论。
----2、表格线条的转换
----MicrosoftExcel中内嵌的VBA为我们获取Excel文件信息提供了极大便利。
通常，通过访问range对象，可以获得许多信息。
访问分析表格的属性应从分析range开始。
每一个range包括许多对象和属性,例如,font对象可以返回range的字体信息。
通过遍历,即可获得整个表格信息。
获取表格信息的目的在于准确地按照位置画表格线，同时确定文字位置。
----在获取表格信息时，存在一个最正确算法问题。
以下就画线问题为例，说明问题和解决方法。
----假设表格由a（a>=1）行b（b>=1）列组成,x，y为循环变量,表格完全由单元格组成，由于在每个单元格都有4条边，让x从1开始循环到a,再y从1开始循环到b,读取每个单元格的4条边,会读取a*b*4次，重复读取a*b*2次。
当x=1时，读取上边；当y=1时读取,左边，其余情况读取右边，下边。
共读取a+b+a*b*2次。
以3行4列为例，共读取3+4+3*4*2=31次，与实际表格的边数相同，没有重复读取。
----对合并单元格信息的读取是个难点。
因为如果按照单元格的位置依次读取，那么由a行b列个单元格〔cell〕合并而成的单元格区域（range）仅有4条边，采用上述计算方法，需要读取a+b+a*b*2次，重复读取a+b+a*b*2-4次。
以以3行4列为例，共读取3+4+3*4*2=31次，重复读取31-4=27次。
算法有重复。
如果按照行号，列号读取，合并单元格的行号、列号只有一个，其值为最靠左、靠上的那个单元格的行号、列号。
例如，将A2：
E5的单元格合并后，其行号为2，列号为A。
这样由多个合并单元格组合后的表格行号、列号有间断，不连续，无法进行循环读取信息。
笔者通过研究发现，函数address〔〕和单元格的mergearea属性可以获得合并单元格的准确信息。
具体方法为：
读取cells（x,y）单元格时，用address（）判断包含cells（x,y）单元格的合并单元格区域的绝对地址,如果前4个字符与cells（x,y）单元格的地址相同，为cells（x,y）单元格为合并单元格区域最靠上、靠左的那个合并单元格，读取其4条边信息，否那么不读取。
这样，彻底防止了重复读取，同时提高了整个读取和画线速度。
----在AutoCAD中，线条有多种，考虑能够方便控制线条属性，选用了多义线。
具体命令如下：
RetVal=object.AddLightWeightPolyline（VerticesList）
----下面的程序演示表格线条读取和画表格线的具体过程。
Subhxw（）
Dimaasinterger‘表格的最大行数
Dimbasinterger‘表格的最大列数
Dimxinitasdouble‘插入点x坐标
Dimyinitasdouble‘插入点y坐标
Dimzinitasdouble‘插入点z坐标
Dimxinsertasdouble‘当前单元格的左上角点的x左标
Dimyinsertasdouble’当前单元格的左上角点的y左标
Dimptarray（0to2）asdouble
Dimxasinteger
Dimyasinteger
Forx=1toa
Fory=1tob
Setc=xlsheet.Range（zh（y）+Trim（Str（x）））
‘以行号、列号获得单元格地址
Setma=c.MergeArea
‘求出单元格C的合并单元格地址
IfLeft（Trim（ma.Address）,4）=Trim（c.Address）Then
假设的绝对地址,如果前4个字符与c单元格的地址相同
xl="A1:
"+ma.Address
xh=xlsheet.Range（ma.Address）.Width
yh=xlsheet.Range（ma.Address）.Height
Setxlrange=xlsheet.Range（xl）
xinsert=xlrange.Width-xh
yinsert=xlrange.Height-yh
xpoint=xinit+xinsert
ypoint=yinit-yinsert
Ifx=1Then
Ifma.Borders（xlEdgeTop）.LineStyle
<>xlNoneThen
ptArray（0）=xpoint
‘第一点坐标〔数组下标0and1）
ptArray
（1）=ypoint
ptArray
（2）=xpoint+xh
‘第二点坐标〔数组下标2and3）
ptArray（3）=ypoint
EndIf
Lineweightlwployobj,ma.Borders（xlEdgeTop）.Weight
EndIf
Ifma.Borders（xlEdgeBottom）.LineStyle
<>xlNoneThen
ptArray（0）=xpoint+xh
‘第三点坐标〔数组下标0and1）
ptArray
（1）=ypoint-yh
ptArray
（2）=xpoint
‘第四点坐标〔数组下标2and3〕
ptArray（3）=ypoint–yh
Lineweightlwployobj,
ma.Borders（xlEdgeBottom）.Weight
EndIf
Ify=1Then
Ifma.Borders（xlEdgeLeft）.LineStyle
<>xlNoneThen
ptArray（0）=xpoint
‘第四点坐标〔数组下标0and1）
ptArray
（1）=ypoint-yh
ptArray
（2）=xpoint
‘第一点坐标〔数组下标2and3）
ptArray（3）=ypoint
EndIf
Lineweightlwployobj,ma.Borders（xlEdgeLeft）.Weight
EndIf
Ifma.Borders（xlEdgeRight）.LineStyle
<>xlNoneThen
ptArray（0）=xpoint+xh
‘第二点坐标〔数组下标0and1）
ptArray
（1）=ypoint
ptArray
（2）=xpoint+xh
‘第三点坐标〔数组下标2and3〕
ptArray（3）=ypoint–yh
Lineweightlwployobj,
ma.Borders（xlEdgeRight）.Weight
EndIf
Setlwployobj=moSpace.AddLightWeightPolyline（ptArray）
‘在AutoCAD文件里画线
Withlwployobj
.Layer=newlayer.name‘指定lwployobj所在图层
.Color=acBlue‘指定lwployobj的颜色
EndWith
Lwployobj.Update
Nexty
Nextx
EndSub
‘下面程序控制线条粗细
SubLineweight（ByVallineAsObject,uAsInteger）
SelectCaseu
Case1
Callline.SetWidth（0,0.1,0.1）
Case2
Callline.SetWidth（0,0.3,0.3）
Case-4138
Callline.SetWidth（0,0.5,0.5）
Case4
Callline.SetWidth（0,1,1）
CaseElse
Callline.SetWidth（0,0.1,0.1）
EndSelect
EndSub
‘下面程序完成列号转换
Functionzh（ppAsInteger）AsString
Ifpp<26Then
zh=Chr（64+pp）
Else
zh=Chr（64+Int（pp/26））+Chr（64+ppMod26）
EndIf
EndFunction
----3、表格文字转换
----表格文字转换包括表格文字本身转换和表格文字在表格中位置的转换两个局部。
----在AutoCAD中，文字标注的形式有多种，与MicrosoftExcel单元格区域多行文本内容相对应的是多行文本命令。
AutoCAD提供的VBA添加多行文本的命令语句是：
RetVal=object.AddMText（InsertionPoint,Width,Text）
----通过修改RetVal的属性可以控制表格文字在表格中的位置。
----
（1）．表格文字本身的转换
----分析AddMText命令可以得出：
表格文字所在位置、文字内容宽度，文字内容，均可通过此命令来添加。
然而表格文字字体，大小，下划线、上下脚标，倾斜，加粗等却不能。
一般的方法是采用修改字体形文件的方法来实现，方法烦琐，不便于实现，而且仅对修改正形文件的字体有效。
况且当同一文字块内的不同文字的字体，大小，下划线、上下脚标，倾斜，加粗不同时，使用修改字体形文件的方法也无法实现。
本文介绍一种直接利用Mtext命令提供的方法进行转换。
----在AddMText命令中，影响文字内容和文字属性的参数Text。
在具体文字前加上一定的控制符号可以控制文字的文字属性，具体控制符号可以参阅AutoCAD帮助文件。
例如，{\F宋体；\Q18;\W1.2;ABCDEFG}把“ABCDEFG〞设置成宋体、向右倾斜18度，每个字的宽度是正常宽度倍。
----本程序具体采用的方法是：
读取MicrosoftExcel文件某一单元格区域里的某第j个字符属性〔字体，大小，下划线、上、下脚标，倾斜，加粗〕，读取MicrosoftExcel文件某一单元格区域里的某第j+1个字符属性，如果与第j个字符相同，那么二者采用同样的控制符号；假设不同，那么从第j+1个字符开始，重复前面的工作。
Subwz（）
Char=RTrim（Left（c.Characters.Caption,256））
IfChar<>EmptyThen
textStr=""
Forj=1ToLen（Char）
Ifc.Characters（j,1）.Font.Underline=
xlUnderlineStyleNoneThen
cpt=c.Characters（j,1）.Caption
sonstr=ForeFontStr（c,j）
tempstr=""
DoWhilej+1<=Len（Char）
sonstr1=ForeFontStr（c,j+1）
Ifsonstr1=sonstrThen
j=j+1
tempstr=tempstr+c.Characters（j,
1）.Caption
Else
ExitDo
EndIf
Loop
textStr=textStr+"{"+sonstr+cpt
+tempstr+"}"
Else
cpt=c.Characters（j,1）.Caption
sonstr=ForeFontStr（c,j）
tempstr=""
DoWhilej+1<=Len（Char）
sonstr1=ForeFontStr（c,j+1）
Ifsonstr1=sonstrThen
j=j+1
tempstr=tempstr+c.Characters（j,
1）.Caption
Else
ExitDo
EndIf
Loop
textStr=textStr+"{\L"+
sonstr+cpt+tempstr+"\l}"
EndIf
Nextj
EndIf
EndSub
‘下面函数控制字体本身属性
FunctionForeFontStr（mAsRange,uAsInteger）AsString
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
EndFunction
----〔2〕.表格中表格文字位置的转换
----对文字对象的属性的直接控制来实现，通过with….endwith结构可以很容易地控制文字的高度、图层、颜色、书写方向。
由于Mtext文字提供支持的排列位置分为9种，必须根据MicrosoftExcel表格文字的排列方式加以适宜的判定，然后进行转换。
其具体的实现方法详见下面的程序。
Subkz（）
WithtextObj‘文字对象
.Height=textHgt
.Layer=newlayer.Name‘设置图层
.Color=acRed‘设置颜色
.DrawingDirection=1‘设置书写方向
If（ma.VerticalAlignment=xlTop_
Orma.VerticalAlignment=xlGeneral）_
And（ma.HorizontalAlignment=xlLeft_
Orma.HorizontalAlignment=xlGeneral）_
Then.AttachmentPoint=1'acAttachmentPointTopLeft
If（ma.VerticalAlignment=xlTop_
Orma.VerticalAlignment=xlGeneral）_
And（ma.HorizontalAlignment=xlCenter_
Orma.HorizontalAlignment=xlJustify_
Orma.HorizontalAlignment=xlDistributed）_
Then.AttachmentPoint=2'acAttachmentPointTopCenter
If（ma.VerticalAlignment=xlTop_
Orma.VerticalAlignment=xlGeneral）_
Andma.HorizontalAlignment=xlRight_
Then.AttachmentPoint=3'acAttachmentPointTopRight
If（ma.VerticalAlignment=xlCenter_
Orma.VerticalAlignment=xlJustify_
Orma.VerticalAlignment=xlDistributed）_
And（ma.HorizontalAlignment=xlLeft_
Orma.HorizontalAlignment=xlGeneral）_
Then.AttachmentPoint=4'acAttachmentPointMiddleLeft
If（ma.VerticalAlignment=xlCenter_
Orma.VerticalAlignment=xlJustify_
Orma.VerticalAlignment=xlDistributed）_
And（ma.HorizontalAlignment=xlCenter_
Orma.HorizontalAlignment=xlJustify_
Orma.HorizontalAlignment=xlDistributed）_
Then.AttachmentPoint=5'acAttachmentPointMiddleCenter
If（ma.VerticalAlignment=xlCenter_
Orma.VerticalAlignment=xlJustify_
Orma.VerticalAlignment=xlDistributed）_
Andma.HorizontalAlignment=xlRight_
Then.AttachmentPoint=6'acAttachmentPointMiddleRight
Ifma.VerticalAlignment=xlBottom_
And（ma.HorizontalAlignment=xlLeft_
Orma.HorizontalAlignment=xlGeneral）_
Then.AttachmentPoint=7'acAttachmentPointBottomLeft
Ifma.VerticalAlignment=xlBottom_
And（ma.HorizontalAlignment=xlCenter_
Orma.HorizontalAlignment=xlJustify_
Orma.HorizontalAlignment=xlDistributed）_
Then.AttachmentPoint=8'acAttachmentPointBottomCenter
Ifma.VerticalAlignment=xlBottom_
Andma.HorizontalAlignment=xlRight_
Then.AttachmentPoint=9'acAttachmentPointBottomRight
EndWith
textObj.Update
EndSub
----三、功能与特点介绍
----该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。
在转换过程中，表格线条的转换和文字转换是重点。
文字转换采用了直接利用AddMtext命令提供的属性进行转换，防止了已往修改形文件来进行文字标注的方法，直接控制表格文字字体、大小、下划线、上下脚标，倾斜，加粗等，使每个文字的风格均可以得到很好的控制，极大提高了文字标注的灵活性。
----本程序采用VisualBASIC编制，需要MicrosoftExcel2000和AutoCA
升级会员 