Autocad VBA初级教程

第一课：入门 1.为什么要写这个教程 市面上ACAD VBA 的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也 慢慢生疏了，写个教程对自己来说也是一次复习。 2.什么是 Autocad VBA？ VBA是 Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好 VBA可以成倍 甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD 命令不可能完成的，只要学好 VBA 就可 以做到，相信到时候您一定会得到同事的佩服、老板的器重。 3、VBA 有多难？ 相信大家都知道Basic 是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一 定要提出批评，以便及时更正。 4、怎样学习VBA？ 介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考， 多想一些是什么、为什么。本教程将陆续发布在CAD 世界论坛上，您不需要付费就可以学习。本作者在此 郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任 何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。 5、现在我们开始编写第一个程序：画一百个同心圆 第一步：复制下面的红色代码 第二步：在模型空间按快捷键Alt+F8，出现宏窗口 第三步：在宏名称中填写C100，点“创建”、“确定” 第四步：在Sub c100()和 End Sub 之间粘贴代码 第五步：回到模型空间，再次按Alt+F8，点击“运行” Sub c100() Dim cc(0 To 2) As Double '声明坐标变量 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 '开始循环 Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆 Next i End Sub 也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。 第二课 编程基础 本课主要任务是对上一课的例程进行详细 分析 定性数据统计分析pdf销售业绩分析模板建筑结构震害分析销售进度分析表京东商城竞争战略分析 下面是源码： Sub c100() Dim cc(0 To 2) As Double '声明坐标变量 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 '开始循环 Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆 Next i End Sub 先看第一行和最后一行： Sub C100() …… End Sub C100是宏的名称，也叫过程名称，当用户执行C100时程序将运行 sub 和 end sub 之间的所有指令。 第二行： Dim cc(0 To 2) As Double '声明坐标变量 后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告 诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加 注释，越详细越好，对于程序员来说，这是一个好习惯。 电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double 它的作用就是声明变量。 Dim是一条语句，可以理解为计算机指令。 它的语法：Dim变量名 As 数据类型 本例中变量名为CC，而括号中的 0 to 2声明这个 CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、 CC(2)，如果改为 CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了这个数组，就可以把坐标数值放 到这个变量之中。 Double是数据类型中的一种。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD 中数据类型的有很 多，下面两个是比较常用的数据类型，初学者要有所理解。 Long（长整型），其范围从 -2,147,483,648 到 2,147,483,647。 Variant 它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常 用的。 下面三条语句 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0 它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z 坐标。 For i = 1 To 1000 Step 10 '开始循环 …… Next i '结束循环 这两条语句的作用是循环运行指令，每循环一次，i值要增加 10，当 i 加到 1000 时，结束循环。 i也是一个变量，虽然没有声明 i变量，程序还是认可的，VB 不是 C 语言，每用一个变量都要声明，不声 明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很 长，那就会出现一些意想不到的错误。 step后面的数值就是每次循环时增加的数值，step后也可以用负值。 例如：For i =1000 To 1 Step -10 很多情况下，后面可以不加step 10 如：For i=1 to 100，它的作用是每循环一次 i 值就增加1 Next i语句必须出现在需要结束循环的位置，不然程序没法运行。 下面看画圆命令： Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) Call语句的作用是调用其他过程或者方法。 ThisDrawing.ModelSpace 是指当前 CAD 文档的模型空间 AddCircle是画圆方法 Addcicle方法需要两个参数：圆心和半径 CC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310…… 本课到此结束，下面请完成一道思考题： 1.以(4,2)为圆心，画5 个 Autocad VBA 初级教程 (第三课 编程基础二) 有一位叫自然9172的网友提出了下面的问题： 绘制三维多段线时X、Y 值在屏幕上用鼠标选取，Z 值用键盘输入 本课将讲解这个问题。 为了简化程序，这里用多条直线来代替多段线。以下是源码： Sub myl() Dim p1 As Variant '申明端点坐标 Dim p2 As Variant p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标 z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入 Z坐标值 p1(2) = z '将 Z 坐标值赋予点坐标中 On Error GoTo Err_Control '出错陷井 Do '开始循环 p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标 z = ThisDrawing.Utility.GetReal("Z 坐标:") '用户输入 Z坐标值 p2(2) = z '将 Z 坐标值赋予点坐标中 Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线 p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标 Loop Err_Control: End Sub 先谈一下本程序的 设计 领导形象设计圆作业设计ao工艺污水处理厂设计附属工程施工组织设计清扫机器人结构设计 思路： 1、获取第一点坐标 2、输入第一点Z 坐标 3、获取第二点坐标 4、输入第二点Z 坐标 5、以第一、二点为端点，画直线 6、下一条线的第一点=这条线的第二点 7、回到第3 步进行循环 如果用户没有输入坐标或Z 值，则程序结束。 首先看以下两条语句： p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标 …… p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标 这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。 ThisDrawing.Utility.GetPoint（）在 ACAD 中这是最常用的方法之一，它需要两个参数，在逗号前面的参 数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标 移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。 逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。 VbCr通常代 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf 一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：” &的作用是连接字符。举例： “爱我中华 ”&”抵制日货 ”&”从我做起” z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入 Z坐标值 由用户输入一个实数 On Error GoTo Err_Control '出错陷井 …… Err_Control: On Error是出错陷井语句，在程序出错时将执行 On Error 后面的语句 GoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句， 本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。 Do '开始循环 …… Loop ‘结束循环 这个循环就历害了，它会无休止地进行循环，好在本例中已经有了一个出错陷井，当用户输入回车时，由 于程序没有得到点或坐标，程序出错，跳出循环，中止程序。如果要人为控制跳出循环，可以在代码中用 Exit Do语句跳出循环。在For 变量 和 Next 变量之间如果要跳出循环，那么只要在循环体内加一个Exit for 就可以跳出循环，关于这方面的例程以后会讲到。 Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线 画直线方法也是很常用的，它的两个参数是点坐标变量 本课到此结束，请做思考题： 连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出 同心圆，其半径为1-5 Autocad VBA初级教程 (第四课 程序的调试和保存) 人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤 为重要，随着学习的深入，以后我们需要经常进行程序调试。事实上，对于那些资深程序员来说，调试程 序也是一项不可或缺的重要工作。 首先，在程序输入阶段，应该充分利用VBA 编辑器的智能功能。当你在写代码时，输入一些字母后，编辑 器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB 键（它位于“Q”键左 边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。 我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变 量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看 这个变量有没有按照我的设想在变化。下面我举一个简单的例子，先看源代码： sub test() for i=2 to 4 step 0.6 next i end sub 这是一个非常简单的循环，每一次循环 i 便会增加0.6，当循环 3 次后 i 值就变为4.4，但问题是每一次循 环时i 值变为多少？ 第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中 会多一行。 第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。 好，一切就绪，请按F5 执行程序，在监视窗口中C 值立刻变为 2，再按 F5继续，C 值为 2.6，再按几次F5， 直到程序结束，这样我们就成功监视了C 值的变化。 第三步：在next i行再按一次 F9，清除断点。监视的表达式的右键菜单选择“删除监视”。 另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操 作比较简单，请读者自行领悟。 到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的 Autocad 图形文件中， 以后打开 这个文件时代码才会加载，如果别的dwg 文件也要使用，那就需要把代码导出为.bas文件，供其他dwg 文 件导入。在VBA 编辑器的“文件”菜单中有这两个功能，一试便知。 ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图 形文件中共享，但是由于VBA 功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要 这样做。 本课结束，请做思考题；监视下列代码中的i 和 j 的值，注意，此题虽然要监视2 个变量，但是在代窗口 中只要设置1 个断点就足够了。 sub test() for i=2 to 4 step 0.6 for j=-5 to 2 step 5.5 next j next i end sub Autocad VBA初级教程 (第五课 画函数曲线) 先画一组下图抛物线。 下面是源码： Sub myl() Dim p(0 To 49) As Double '定义点坐标 Dim myl As Object '定义引用曲线对象变量 co = 15 '定义颜色 For a = 0.01 To 1 Step 0.02 '开始循环画抛物线 For i = -24 To 24 Step 2 '开始画多段线 j = i + 24 '确定数组元素 p(j) = i '横坐标 p(j + 1) = a * p(j) * p(j) / 10 '纵坐标 Next i '至此 p(0)-p(40)所有元素已定义，结束循环 Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线 myl.Color = co '设置颜色属性 co = co + 1 '改变颜色，供下次定义曲线颜色 Next a End sub 为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些 解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如 果有问题不懂请跟贴提问。 在跟踪变量p 时请在跟踪窗口中单击变量 p 前的+号，这样可以看清数组 p 中每一个元素的变化。 ACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X 值可以是 无限小、无限大，这里取值范围在正负24之间。 程序第二行：Dim myl As Object '定义引用曲线对象变量 Object也是一种变量类型，它可以把变量定义为对象，本例中myl 变量将引用多段线，所以要定义为 Objet 类型。 看画多段线命令： Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线 其中括号中的p 是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。 等号前面部分“Set myl”的作用就将 myl 变量去引用画好的多段线。 myl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co 会增值，这样就会有五彩 缤纷的效果。 本课第二张图：正弦曲线，下面是源码： Sub sinl() Dim p(0 To 719) As Double '定义点坐标 For i = 0 To 718 Step 2 '开始画多段线 p(i) = i * 2 * 3.1415926535897 / 360 '横坐标 p(i + 1) = 2 * Sin(p(i)) '纵坐标 Next i ThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线 ZoomExtents '显示整个图形 End Sub p(i) = i * 2 * 3.1415926535897 / 360 '横坐标 横坐标表示角度，后面表达式的作用是把角度转化弧度 ZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域 本课思考题：画一条抛物线：y=0.5*x*x+3，其中 X 取值范围在正负50 之间 Autocad VBA初级教程 (第六课 数据类型的转换) 上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA 中有现成的方法可以 转换数据类型。 我们举例说明： jd = ThisDrawing.Utility.AngleToReal(30, 0) 这个表达式把角度30度转化为弧度，结果是.523598775598299。 AngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为 0-4之间的整数， 有如下意义： 0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位 例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1) 这个表达式计算62度 30 分 10秒的弧度 再看将字符串转换为实数的方法：DistanceToReal 需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义： 1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。 例：以下表达式得到一个12.5的实数 temp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1) temp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2) temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5) 而 realtostring方法正好相反，它把一个实数转换为字符串。它需要3 个参数 第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。 temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3) 得到这个字符串：“1.250E+01”， 下面介绍一些数型转换函数： Cint，获得一个整数，例：Cint(3.14159) ，得到 3 Cvar，获得一个Variant 类型的数值，例：Cvar("123" & "00")，得到”12300” Cdate，转换为 date 数据类型，例：MyShortTime = CDate("11:13:14 AM") 下面的代码可以写出一串数字，从000-099。 Sub test() Dim add0 As String Dim text As String Dim p(0 To 2) As Double p(1) = 0 'Y坐标为 0 p(2) = 0 'Z坐标为 0 For i = 0 To 99 '开始循环 If i < 10 Then '如果小于 10 add0 = "00" '需要加 00 Else '否则 add0 = "0" '需要加 0 End If text = add0 & CStr(i) '加零，并转换数据 p(0) = i * 100 'X坐标 Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字 Next i End Sub 重点解释条件判断语句： If 条件表达式 Then …… Else …… End if 如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if 后面 如果不满足条件，程序跳到else后往下运行。 Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字 这是写单行文本，需要三个参数，分别是:写的内容、位置、字高 Autocad VBA初级教程 (第七课 写文字) 客观地说，ACAD写字功能不够历害，而用VBA 可以使写字效率更高。比较正规的做法是把定义文字样式， 用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式， 然后用这个文字样式写一段多行文本。 Sub txt() Dim mytxt As AcadTextStyle '定义 mytxt 变量为文本样式 Dim p(0 To 2) As Double '定义坐标变量 p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值 Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加 mytxt 样式 mytxt.fontFile = "c:\windows\fonts\simfang.ttf" '设置字体文件为仿宋体 mytxt.Height = 100 '字高 mytxt.Width = 0.8 '宽高比 mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度） ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为 mytxt Set txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大， 过人远矣") txtobj.LineSpacingFactor = 2 '指定行间距 txtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2 为居中） End Sub 我们看这条语句 Set mytxt = ThisDrawing.TextStyles.Add("mytxt") 添加文本样式并赋值给mytxt 变量，只需要一个参数：文本样式名 fontfile、height、width、ObliqueAngle是文本样式最常用的属性 Call ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远 矣") 这条语句是写文本，需要三个参数。第一个参数p 是坐标，1400是宽度，最后一个参数是文本内容，其中 \p 是一个回车符 扩大字符间距用\T 数字，例：\T3abc，使文字 abc 的间距扩大 3 部，n 取值范围是0.75-3 在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34 \S 是格式字符，^是分隔符，前面的数字在上，后面的数字在下。 \C 是颜色格式字符，C 后面跟一个数字表示颜色 \A 是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐 Autocad VBA初级教程 (第八课:图层操作) 先简单介绍两条命令： 1、这条语句可以建立图层： ThisDrawing.Layers.Add("新建图层") 在括号中填写图层的名称。 2、设置为当前的图层 ThisDrawing.ActiveLayer=图层对象 注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量 以下一些属性在图层比较常用： LayerOn 打开关闭 Freeze 冻结 Lock锁定 Color 颜色 Linetype 线型 看一个例题： 1、先在已有的图层中寻找一个名为“新建图层”的图层 2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置 为当前图层。 3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设 置为当前图层 Sub mylay() Dim lay0 As AcadLayer '定义作为图层的变量 Dim lay1 As AcadLayer findlay = 0 '寻找图层的结果的变量，0 没有找到，1 找到 For Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环 If lay0.Name = "新建图层" Then '如果找到图层名 findlay = 1 '把变量改为 1 标志着图层已经找到 msgstr = lay0.Name + "已经存在" + vbCrLf msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf msgstr = msgstr + "是否设置为当前图层？" If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定 If Not lay0.LayerOn Then lay0.LayerOn = True '打开 ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层 End If Exit For '结束寻找 End If Next lay0 If findlay = 0 Then '没有找到图层 Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层 lay1.Color = 2 '图层设置为黄色 ltfind = 0 '找到线型的标志，0没有找到，1 找到 For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环 If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN" ltfind = 1 '标志为已找到线型 Exit For '退出循环 End If Next entry '结束循环 If ltfind = 0 Then '没有找到线型 ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型 End If lay1.Linetype = "HIDDEN" '设置线型 ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层 End If End Sub 在寻找图时时我们用到for each……next 语句 它的语法是这样的： For Each 变量 In 数组或集合对象 …… exit for …… next 变量 它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例 在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层 在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。 If lay0.Name = "新建图层" Then lay0.name代表这处图层的图层名 IIf(lay0.LayerOn = True, "打开", "关闭") 这是一个简单判断语句，语法如下： iif（判断表达式，返回值 1，返回值2） 当判断表达式成立，函数值=返回值 1，如果表达式不成立，函数值=2 MsgBox(msgstr, 1) Mgbox显示一个对话框，第一个参数是对话框显示的内容 第二个参数可以控制对话框上的按钮。 0 只有确认按钮 1 确认、取消 2 终止、重试、忽略 3 是、否、取消 4 是、否 MsgBox获得值如下： 确认：1 取消：2 终止：3 重试：4 忽略：5 是：6 否 7 初学者不需要死记硬背，能有所了解就行了 ACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这 条语句： ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" ThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。 利用 vba 编程实现从 excel 表到 autocad 表转换.txt --- 一、前言 ---- 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 – 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