您的位置: 首页 > EXCEL技巧 > ExcelVBA >

利用VBA编程实现从EXCEL表到AUTOCAD表转换

时间:2013-08-29 整理:docExcel.net

一、媒介

Microsoft Excel 软件具有十分强大的制表、表格计较等成果,是普通人员常用的制表东西。可以通过其内嵌的VBA语言可以节制Microsoft Excel 的整个操纵。

AutoCAD是由AutoDesk公司的工程画图软件,是CAD市场的主流产物,成果十分强大,是工程制图人员常用的软件之一。AutoDesk公司从R14版今后,为其提供了VBA语言接口。

在工程制图中,经常需要在图中绘制表格,一般有两种。其一,是操作剪贴板,将Microsoft Excel表格拷贝至剪贴板中,然后打开AutoCAD文件,再将剪贴板中的文件粘贴至所需位置。这种十分简朴,但有其固有的缺点。①在生存文件必需将.xls和.dwg文件生存在一起,一旦缺少excel,则再对表格继承修改。②同时打开多个表格操纵,需要占据较大的内存空间。③文件体积很大,表格有时在.dwg文件中以图标形式显示,未便于调查。

第二种,即操作Microsoft Excel、AutoCAD都提供的VBA成果,体例措施举办转换,将Microsoft Excel表格按本来样子转换,即把Microsoft Excel表格中的文字和线条信息全部读取出来,在AutoCAD文件里凭据一一对应的写出来,确保转换后的表格与原表格一致。这样彻底制止了前种的缺点,便于表格内容编辑。本文着重先容此。

二、表格转换事情机理阐明及详细实现

1.表格转换事情机理阐明

在制表中,常常碰着两个观念,表和方格。

在Microsoft Excel中,与表对应的工具是事情表(Sheet或Worksheet),与每一个表格方格相对应的工具是单位格区域(range),它可以仅包罗一个单位格(cell),也可以由多个单位格归并而成。

在AutoCAD中,没有与表对应的工具,但表可以领略由若干条线和文字工具组合而成。

按照上述阐明,可以发明如下的转换:

读取Microsoft Excel文件中的最小工具----单位格区域(range)的主要信息---线条和文字,然后在AutoCAD文件里在指定图层、位置画线条,书写文字。通过轮回,遍历所有单位格区域(range),边读边写,最终完成表格的转换。转换中,线条、文字及其相关属性不产生改变。

下面就转换事情的两个主要工具表格线条和表格文字举办接头。

2、表格线条的转换

Microsoft Excel 中内嵌的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)单位格的归并单位格区域c.mergearea的绝对地点,假如前4个字符与cells(x,y) 单位格的地点沟通,为cells(x,y)单位格为归并单位格区域最靠上、靠左的谁人归并单位格,读取其4条边信息,不然不读取。这样,彻底制止了反复读取,同时了整个读取和画线速度。

在AutoCAD中,线条有多种,思量可以或许利便节制线条属性,选用了多义线。详细呼吁如下: RetVal = object.AddLightWeightPolyline(VerticesList)

下面的措施演示表格线条读取和画表格线的详细。
Sub hxw()
Dim a as interger ‘表格的最大行数
Dim b as interger ‘表格的最大列数
Dim xinit as double ‘点x坐标
Dim yinit as double ‘点y坐标
Dim zinit as double ‘点z坐标
Dim xinsert as double ‘当前单位格的左上角点的x左标
Dim yinsert as double ’当前单位格的左上角点的y左标
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)))
‘以行号、列号单位格地点
Set ma = c.MergeArea
‘求出单位格C的归并单位格地点
If Left(Trim(ma.Address), 4) = Trim(c.Address) Then
如果c.mergearea的绝对地点,假如前4个字符与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
‘第一点坐标(数组下标 0 and 1)
ptArray(1) = ypoint
ptArray(2) = xpoint + xh
‘第二点坐标(数组下标 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
‘第三点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第四点坐标(数组下标 2 and 3)
ptArray(3) = ypoint C yh
Lineweight lwployobj,
ma.Borders(xlEdgeBottom).Weight
End If
If y = 1 Then
If ma.Borders(xlEdgeLeft).LineStyle
< > xlNone Then
ptArray(0) = xpoint
‘第四点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第一点坐标(数组下标 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
‘第二点坐标(数组下标 0 and 1)
ptArray(1) = ypoint
ptArray(2) = xpoint + xh
‘第三点坐标(数组下标 2 and 3)
ptArray(3) = ypoint C 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
‘下面措施节制线条粗细
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
‘下面措施完成列号转换
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

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 ‘配置书写偏向
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运行,编译后通过。

合肥荣博电脑教育培训中心 问题:合肥荣博电脑教育培训中心
回答:...hotoshop、Illustrator等常用平面软件 3、合肥电脑培训学校—AutoCAD 培训内容:二维画图、图形界限的配置、二维标注、二维修建图形的绘制与及修改、二维图形的打印、修剪呼吁的快捷应用、比线的乖巧应用、延伸的利用、块的界...
用Excel共同CAD画工程曲线 问题:用Excel共同CAD画工程曲线
回答:...存坐标值。作为工程技能人员确实应该此! 我们在利用AutoCAD时,有时要输入多个坐标点并毗连成曲线。在工程计较时,常常要用AutoCAD画出一条曲线,而这条曲线假如是由多个坐标点毗连成的,输入起来就贫苦,并且容易堕落...
最全的autocad教程大全 问题:最全的autocad教程大全
回答:1为什么要拥有《AutoCAD视频教程全集》?400-0990-827 结果最直接 这些技能是AutoCAD好手10年岁情,在事情中久经检验,是拿高薪的担保,已经在行业中引领技能规范,学员争相进修的偶像。 操纵性最强 化的进修计策,综...
AutoCAD画完图形后发现文件变得很大,如何将文件 问题:AutoCAD画完图形后发现文件变得很大,如何将文件变小
回答:减少图形中的对象数量,比如把n条边围成的图形编辑合并成一个对象;删除重叠对象;删除无用的块、标注样式、文字样式、图层等等设置;适当降低显示精度。可在一定...
AutoCAD中Excel表格打不开 问题:AutoCAD中Excel表格打不开
回答:CAD中就有excel转CAD的功能,方法介绍如下:1.在excel(包括word)中先做好表格,可以用函数进行计算。()2.选中要转的单元进行复制。3.打开CAD,进行如下操作:编辑——选择性粘贴——4.在CAD2002中选中“%PRODUCT图元”然后 “确...
在CAD2007中如何调用office 问题:在CAD2007中如何调用office
回答:...el 和 PowerPoint)。访问 Vault 与访问 Microsoft Office(可以在 AutoCAD 中访问)类似。要使用此组件,必须安装 Vault Client。Vault Client 软件包括 Autodesk Vault Explorer。Vault Explorer 是一个单机版应用程序,它提供工具用于访问存储在 Autodesk D...
相关知识:

下面内容对您也许有用

      话题:利用VBA编程实现在关闭excel前清空报价单有字的行,从第4行
      答:Sheets("检测费用报价").Rows(i).ClearContents Sheets("检测费用报价").Rows(i).ClearFormats 利用VBA编程实现在关闭excelEXCEL 函数 VBA编程
      话题:如何利用excel的VBA编程解决,根据现有表格指定导出指定行的
      答:数据表发:1813340428 VBA编程实现,在工作表2中,当 EXCELVBA对表格元素的操作编程
      话题:在EXCEL表中如何实现VBA编程,请高手指点!笑盼!知道
      答:VBA的实质是VB,当然能够连接数据库,亦能建立数据库,但对于数据库的类型,个人觉得最好还是ACCESS以及SQL SERVER,因为这两个数据库和OFFICE都是微软的,同 用VBA编程如何遍历EXCEL每一个 excel VBA编程做99乘法表
      话题:Excel 中用VBA编程实现以下功能
      问:用VBA编程实现以下功能 F列从F4单元格开始,寻找第一个数值不为0的单元格,并
      答:见附件!Sub test()Dim x For x=1 To Range("f1000").End(3).Row If Range("f"&x)0 Then Range("G4")=Range("f"&x).Offset(0,-1)Exit For End If Next x End VBA.excel编程 能否实现以下 我想在excel中用VBA代码实现以下
      话题:利用EXCEL VBA 编程,将一列数据进行降序排列。求编程语句_
      答:有标题行用这样子,以下以A列作列子 Columns("A:A").Select Selection.Sort Key1:=Range("A2"),Order1:=xlDescending,Header:=xlGuess,_OrderCustom:=1,MatchCase
      话题:利用EXCEL VBA 编程,将一列数据进行降序排列。求编程语句_
      答:Function BubbleSort1(ZHArray,XArray,YArray,ZArray As Variant)'方法 2:气泡排序。根据 : support.microsoft./ 网站提供的代码修改 '思路是根据一维
      话题:如何使用excel中的VBA编程?实现如下内容:一个工作簿中的2个
      问:模板。表2中每一行存放表1中的姓名、成绩、评语等。同时在表2做一个按纽,实现
      答:有3种方法实现:1.用邮件合并。2.用函数。每打印一次变换一下数据行数。3.用VBA编程。用程序实现有多少条数据复制多少个模板,并分别将数据写进去。
      话题:autocad vba编程,当前坐标系统如何从用户自定义的ucs坐标系统
      问:autocad vba编程,当前坐标系统如何从用户自定义的ucs坐标系统,转换到wcs?用户
      答:我也想知道答案,但很长时间了没有寻到.我是这么做的:向命令行发送一行命令:"ucs w
      话题:excel怎么样可以实现这中功能?是VBA编程吗?求问相关教程_
      答:给你个例子看看,建议你新建个文件用来测试研究 一、在vba窗口,表(如sheet1)对象中写入代码 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal
      话题:用EXCEL VBA编程实现,一个四位数,即0000到9999中的一位,
      问:备注,前边的0也要显示出来,比如0010。
      答:方法1:Sub ouyangff()For i=0 To 9 For j=0 To 9 For k=0 To 9 For l=0 To 9 If i+j+k=j+k+l Then t=t+1:Cells(t,1).NumberFormat="#":Cells(t,1)=i&j&k&l Next
最新评论