[下载]：好东西(原创)：CAD中读取EXCEL数据的函数

黄卫文

最初由 wowoaicad 发布
[B]呵呵，你也在晓东论坛发一个怎么样？ [/B]

好大呀，给别人做的那个如何（老金的）？不过是共享版的哟，明经那儿有的，容易做到不过期。我的东西只供单位用的。

unionsoft

最初由 黄卫文 发布
[B]
你那程序还行，但并不是最好的。至少你画的表格不是很精确。 [/B]

请指教，是哪里不精确，谢谢。

黄卫文

最初由 unionsoft 发布
[B]


请指教，是哪里不精确，谢谢。 [/B]

你的表读的是EXCEL的表，字和行高是自己给的，列宽是是怎算出的不知道，但与EXCEL的列宽是没有关系的，字的位置关系、大小也是自己设定的，所以还不能真实地反映EXCEL表的情况。但程序编的确实还是不错的，如果你要用精确还反映EXCEL表的情况可能还需要努力改进。说的不当之处还望见谅。

unionsoft

谢谢你的指教

Excel-->AutoCAD，数据肯定要本地化，各种关系都是通过一定的公式转化而来的，因为两个程序间的单位都不一样

同时，在TrueTable中可以对表格单元格的高度，宽度进行精确定义，以适合那些固定格式的表格

前生

题外话:
文无第一,武无第二,何解?
呵呵,请不要扣分哦.

njshf

能不能在不启动EXCEL的情况下，读取EXCEL文件数据。

黄卫文

最初由 njshf 发布
[B]能不能在不启动EXCEL的情况下，读取EXCEL文件数据。 [/B]

这个不行，不启动只是在显示上没有看到EXCEL，其实它还是加载进了内存。我这个接口只是为了方便将打开的EXCEL文件中的数据转入CAD中形成一个表。

hxy-xdcad

最好能有cad中读取数据自动生成excel表格的程序


TrueTable能实现autocad→excel么

13607219756

利用VBA编程实现从EXCEL表到AUTOCAD表转换  作者:查拥军  
　　一、前言 ---- 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 Integer /*表格的最大行数 Dim b As Integer /*表格的最大列数 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 3) 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 - 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 - 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运行环境，编译后通过。 注意：实际调试代码的时候，请将//用VB的注释号代替，因为文章中心不支持VB的注释号，所以用//替代

David Li

我是菜鸟
怎么加载你的程序阿？

cooduchamp

2005版的cad经意实现与excel的表格接口了。

Ashun5201314

哈哈， 你们完善,我拿现成的

JOSDENNIS

樓主你的程序有個缺點. 就是
(setq list-b (hww-excel-cad  row-begin col-begin row-end col-end))
您定義的hww-excel-cad 應在運行這個子涵數前給用戶(我)自定義我要讀取的EXECL文件嘛, 不行嗎?

boyhaodong

真晕！这个上面怎么是你们两聊天的地方呀！

swaywood

真是好东西，能读取单元格中的数据已经很好了，其实明细表中的很多东西都可以在VBA FOR EXCEL 中计算出来，再加上EXCEL中超强的数据处理功能，有了它一连接，真是无懈可击了！