autocad vba初级教程

autocad vba初级教程 autocad vba初级教程 ( 第一课 旧约精览一百步肺炎基本知识第八章运动和力知识点六上学与问第一课时开学第一课收心教育 :入门) 发布:2007-2-16 10:32:46 来源:模具网 浏览 171 次 编辑:佚名 第一课:入门 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 也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。 autocad vba初级教程 (第二课 编程基础) 发布:2007-2-16 10:32:47 来源:模具网 浏览 151 次 编辑:佚名 第二课 编程基础 本课主要任务是对上一课的例程进行详细分析 下面是源码: 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个同心圆，其半径为1-5 autocad vba初级教程 (第三课 编程基础二) 发布:2007-2-16 10:32:52 来源:模具网 浏览 129 次 编辑:佚名 有一位叫自然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 先谈一下本程序的设计思路: 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通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令:” &的作用是连接字符。举例: “爱我中华 ”&”抵制日货 ”&”从我做起” 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) 画直线 画直线方法也是很常用的，它的两个参数是点坐标变量 本课到此结束，请做思考题: 连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出 autocad vba初级教程 (第四课 程序的调试和保存) 发布:2007-2-16 10:32:53 来源:模具网 浏览 80 次 编辑:佚名 人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，随着学习的深入，以后我们需要经常进行程序调试。事实上，对于那些资深程序员来说，调试程序也是一项不可或缺的重要工作。 首先，在程序输入阶段，应该充分利用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初级教程 (第五课 画函数曲线) 发布:2007-2-16 10:33:12 来源:模具网 浏览 212 次 编辑:佚名 先画一组下图抛物线。 下面是源码: 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.14 / 360 横坐标 p(i + 1) = 2 * Sin(p(i)) 纵坐标 Next i ThisDrawing.ModelSpace.AddLightWeightPolyline (p) 画多段线 ZoomExtents 显示整个图形 End Sub p(i) = i * 2 * 3.14 / 360 横坐标 横坐标表示角度，后面表达式的作用是把角度转化弧度 ZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域 本课思考题:画一条抛物线:y=0.5*x*x+3，其中X取值范围在正负50之间 autocad vba初级教程 (第六课 数据类型的转换) 发布:2007-2-16 10:33:15 来源:模具网 浏览 112 次 编辑:佚名 上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。 我们举例说明: jd = ThisDrawing.Utility.AngleToReal(30, 0) 这个表达式把角度30度转化为弧度，结果是.。 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初级教程 (第七课 写文字) 发布:2007-2-16 10:33:20 来源:模具网 浏览 88 次 编辑:佚名 客观地说，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初级教程 (第八课:图层操作) 发布:2007-2-16 10:33:50 来源:模具网 浏览 272 次 编辑:佚名 先简单介绍两条命令: 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后需要两个参数，一个是线型的名称，另外一个是线型文件的 名称。 autocad vba初级教程 (第九课:创建选择集) 发布:2007-2-16 10:36:40 来源:模具网 浏览 334 次 编辑:佚名 1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色. Sub c300() Dim myselect(0 To 300) As AcadEntity 定义选择集数组 Dim pp(0 To 2) As Double 圆心坐标 For i = 0 To 300 循环300次 pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 设置圆心坐标 Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) 画不同大小的圆 Next i For i = 1 To 300 If myselect(i).Radius > 10 Then 判断圆的直径是否大于10 myselect(i).color = Int(255 * Rnd + 1) 大圆颜色改为随机数 Else myselect(i).color = 0 小圆改为白色 End If Next i ZoomExtents 缩放到显示全部对象 End Sub pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 这一行实际上应该是三条语句,用三行合并为一行,用冒号分开 rnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数 Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) 这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集. 2.提标用户在屏幕中选取 选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了. 下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除 Sub mysel() Dim sset As AcadSelectionSet 定义选择集对象 Dim element As AcadEntity 定义选择集中的元素对象 Set sset = ThisDrawing.SelectionSets.Add("ss1") 新建一个选择集 sset.SelectOnScreen 提示用户选择 For Each element In sset 在选择集中进行循环 element.color = acGreen 改为绿色 Next sset.Delete 删除选择集 End Sub 3.选择全部对象 用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象, 并计算对象数. Sub allsel() Dim sel1 As AcadSelectionSet 定义选择集对象 Set sel1 = ThisDrawing.SelectionSets.Add("s") 新建一个选择集 Call sel1.Select(acSelectionSetAll) 全部选中 sel1.Highlight (True) 显示选择的对象 sco= sel1.Count 计算选择集中的对象数 MsgBox "选中对象数:" & CStr(sco) 显示对话框 End Sub 3.运用select方法 上面的例题已经运用了select方法,下面讲一下select的5种选择方式: 1:择全部对象(acselectionsetall) 2.选择上次创建的对象(acselectionsetlast) 3.选择上次选择的对象(acselectionsetprevious) 4.选择矩形窗口内对象(acselectionsetwindow) 5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing) 还是看代码来学习.其中选择语句是: Call sel1.Select(Mode, p1, p2) Mode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标, Sub selnew() Dim sel1 As AcadSelectionSet 定义选择集对象 Dim p1(0 To 2) As Double 坐标1 Dim p2(0 To 2) As Double 坐标2 p1(0) = 0: p1(1) = 0: p1(2) = 0 设置坐标1 p2(0) = 300: p2(1) = 300: p2(2) = 0 设置坐标1 Mode = 5 把选择模式存入mode变量中 Set sel1 = ThisDrawing.SelectionSets.Add("sel3") 新建一个选择集 Call sel1.Select(Mode, p1, p2) 选择对象 sel1.Highlight (ture) 显示已选中的对象 End Sub autocad vba初级教程 (第十课:画多段线和样条线) 发布:2007-2-16 10:59:07 来源:模具网 浏览 189 次 编辑:佚名 画二维多段线语句这样写: set lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint) AddLightweightPolyline后面需一个参数，存放顶点坐标的数组 画三维多段线语句这样写: Set lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint) Add3dpoly后面需一个参数，就是顶点坐标数组 画二维样条线语句这样写: Set lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT) Addspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。 下面看例题。这个程序是第三课例程的改进版。原题是这样的: 绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。 细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路: 用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码: Sub myl() Dim p1 As Variant 申明端点坐标 Dim p2 As Variant Dim l() As Double 声明一个动态数组 Dim templ As Object p1 = ThisDrawing.Utility.GetPoint(, "输入点:") 获取点坐标 z = ThisDrawing.Utility.GetReal("Z坐标:") 用户输入Z坐标值 p1(2) = z 将Z坐标值赋予点坐标中 ReDim l(0 To 2) 定义动态数组 l(0) = p1(0) l(1) = p1(1) l(2) = z On Error GoTo Err_Control 出错陷井 Do 开始循环 p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") 获取下一个点的坐标 z = ThisDrawing.Utility.GetReal("Z坐标:") 用户输入Z坐标值 p2(2) = z 将Z坐标值赋予点坐标中 lub = UBound(l) 获取当前l数组中元的元素个数 ReDim Preserve l(lub + 3) For i = 1 To 3 l(lub + i) = p2(i - 1) Next i If lub > 3 Then templ.Delete 删除前一次画的多段线 End If Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) 画多段线 p1 = p2 将第二点的端点保存为下一条直线的第一个端点坐标 Loop Err_Control: End Sub 我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。 这样定义数组:Dim l( ) As Double 赋值语句: ReDim l(0 To 2) l(0) = p1(0) l(1) = p1(1) l(2) = z 重新定义数组元素语句: lub = UBound(l) 先要获取当前l数组中元的元素个数,用ubount函数计算。 ReDim Preserve l(lub + 3) 重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。 再看画多段线语句: Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) 画多段线 在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。 删除语句: templ.Delete 因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。 下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路:用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。 Sub sp2pl() Dim getsp As Object „获取样条线的变量 Dim newl() As Double „多段线数组 Dim p1 As Variant „获得拟合点点坐标 ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线" sumctrl = getsp.NumberOfControlPoints „计算样条线中一共有多少拟合点 ReDim newl(0 To sumctrl * 3 - 1) „重定义数组 For i = 0 To sumctrl - 1 „开始循环， p1 = getsp.GetControlPoint(i) „把拟合点坐标存到p1变量中 For j = 0 To 2 newl(i * 3 + j) = p1(j) Next j Next i Set templ = ThisDrawing.ModelSpace.Add3DPoly(newl) „画样条线 End Sub 下面的语句是让用户选择样条线: ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线" ThisDrawing.Utility.GetEntity 后面需要三个参数: 第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。 autocad vba初级教程 (第十一课:动画基础) 发布:2007-2-16 10:59:08 来源:模具网 浏览 139 次 编辑:佚名 说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法…… 下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。 移动方法:object.move 起点坐标,端点坐标 Sub testmove() Dim p0 As Variant 起点坐标 Dim p1 As Variant 终点坐标 Dim pc As Variant 移动时起点坐标 Dim pe As Variant 移动时终点坐标 Dim movx As Variant x轴增量 Dim movy As Variant y轴增量 Dim getobj As Object 移动对象 Dim movtimes As Integer 移动次数 ThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象" p0 = ThisDrawing.Utility.GetPoint(, "起点:") p1 = ThisDrawing.Utility.GetPoint(p0, "终点:") pe = p0 pc = p0 motimes = 3000 movx = (p1(0) - p0(0)) / motimes movy = (p1(1) - p0(1)) / motimes For i = 1 To motimes pe(0) = pc(0) + movx pe(1) = pc(1) + movy getobj.Move pc, pe 移动一段 getobj.Update 更新对象 Next End Sub 先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。 看第二个例题:做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路:先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。 旋转方法:object. rotate 基点,角度 偏移方法: object.offset(偏移量) Sub moveball() Dim ccball As Variant 圆 Dim ccline As Variant 圆轴 Dim cclinep1(0 To 2) As Double 圆轴端点1 Dim cclinep2(0 To 2) As Double 圆轴端点2 Dim cc(0 To 2) As Double 圆心 Dim hill As Variant 山坡线 Dim moveline As Variant 移动轨迹线 Dim lay1 As AcadLayer 放轨迹线的隐藏图层 Dim vpoints As Variant 轨迹点 Dim movep(0 To 2) As Double 移动目标点坐标 cclinep1(0) = -0.1: cclinep2(0) = 0.1 定义圆轴坐标 Set ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) 画直线 Set ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) 画半径为0.1的圆 Dim p(0 To 719) As Double 申明正弦线顶点坐标 For i = 0 To 718 Step 2 开始画多段线 p(i) = i * 3.14 / 360 横坐标 p(i + 1) = Sin(p(i)) 纵坐标 Next i Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) 画正弦线即山坡曲线 hill.Update 显示山坡线 moveline = hill.Offset(-0.1) 球心运动轨迹线 vpoints = moveline(0).Coordinates 获得规迹点 Set lay1 = ThisDrawing.Layers.Add("hidelay") 创建名为"hidelay"的图层 lay1.LayerOn = False 关闭图层 moveline(0).Layer = "hidelay" 将轨迹线放到关闭的图层中 ZoomExtents 显示整个图形 For i = 0 To UBound(vpoints) - 1 Step 2 movep(0) = vpoints(i) 计算移动的轨迹 movep(1) = vpoints(i + 1) ccline.Rotate cc, 0.05 旋转直线 ccline.Move cc, movep 移动直线 ccball.Move cc, movep 移动圆 cc(0) = movep(0) 把当前位置作为下次移动的起点 cc(1) = movep(1) For j = 1 To 50000 这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑 速度设置 j = j * 1 Next j ccline.Update 更新 Next i End Sub 本课结束，请做思考题:在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而 行，到互换位置后停下来，尺寸自定 autocad vba初级教程 (第十二课:参数化设计基础) 发布:2007-2-16 10:59:10 来源:模具网 浏览 218 次 编辑:佚名 简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。 本课的例程是画一个标准足球场。足球场长度90,120米，宽度45,90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。 Sub court() Dim courtlay As AcadLayer 定义球场图层 Dim ent As AcadEntity 镜像对象 Dim linep1(0 To 2) As Double 线条端点1 Dim linep2(0 To 2) As Double 线条端点2 Dim linep3(0 To 2) As Double 罚球弧端点1 Dim linep4(0 To 2) As Double 罚球弧端点2 Dim centerp As Variant 中心坐标 xjq = 11000 小禁区尺寸 djq = 33000 大禁区尺寸 fqd = 11000 罚球点位置 fqr = 9150 罚球弧半径 fqh = 14634.98 罚球弧弦长 jqqr = 1000 角球区半径 zqr = 9150 中圈半径 On Error Resume Next chang = ThisDrawing.Utility.GetReal("长度(90000,120000)<105000>") If Err.Number <> 0 Then 用户输入的不是有效数字 chang = 105000 Err.Clear 清除错误 End If kuan = ThisDrawing.Utility.GetReal("宽度(45000,90000)<68000>") If Err.Number <> 0 Then kuan = 68000 End If centerp = ThisDrawing.Utility.GetPoint(, "定位球场中心:") Set courtlay = ThisDrawing.Layers.Add("足球场") 设置图层 ThisDrawing.ActiveLayer = courtlay 把当前图层设为足球场图层 画小禁区 linep1(0) = centerp(0) + chang / 2 linep1(1) = centerp(1) + xjq / 2 linep2(0) = centerp(0) + chang / 2 - xjq / 2 linep2(1) = centerp(1) - xjq / 2 Call drawbox(linep1, linep2) 调用画矩形子程序 画大禁区 linep1(0) = centerp(0) + chang / 2 linep1(1) = centerp(1) + djq / 2 linep2(0) = centerp(0) + chang / 2 - djq / 2 linep2(1) = centerp(1) - djq / 2 Call drawbox(linep1, linep2) 画罚球点 linep1(0) = centerp(0) + chang / 2 - fqd linep1(1) = centerp(1) Call ThisDrawing.ModelSpace.AddPoint(linep1) ThisDrawing.SetVariable "PDMODE", 32 点样式 ThisDrawing.SetVariable "PDSIZE", 30 点的尺寸 画罚球弧，罚球弧圆心就是罚球点linep1 linep3(0) = centerp(0) + chang / 2 - djq / 2 linep3(1) = centerp(1) + fqh / 2 linep4(0) = linep3(0) 两个端点的x轴相同 linep4(1) = centerp(1) - fqh / 2 ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) 计算角度 ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4) Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) 画弧 角球弧 ang1 = ThisDrawing.Utility.AngleToReal(90, 0) 角度转换为弧度 ang2 = ThisDrawing.Utility.AngleToReal(180, 0) linep1(0) = centerp(0) + chang / 2 角球弧圆心 linep1(1) = centerp(1) - kuan / 2 Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) 画弧 ang1 = ThisDrawing.Utility.AngleToReal(270, 0) linep1(1) = centerp(1) + kuan / 2 Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1) 镜像轴 linep1(0) = centerp(0) linep1(1) = centerp(1) - kuan / 2 linep2(0) = centerp(0) linep2(1) = centerp(1) + kuan / 2 镜像 For Each ent In ThisDrawing.ModelSpace 所有模型空间的对象进行一次循环 If ent.Layer = "足球场" Then 对象在"足球场"图层中 ent.Mirror linep1, linep2 镜像 End If Next ent 画中线 Call ThisDrawing.ModelSpace.AddLine(linep1, linep2) 画中圈 Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr) 画外框 linep1(0) = centerp(0) - chang / 2 linep1(1) = centerp(1) - kuan / 2 linep2(0) = centerp(0) + chang / 2 linep2(1) = centerp(1) + kuan / 2 Call drawbox(linep1, linep2) ZoomExtents 显示整个图形 End Sub Private Sub drawbox(p1, p2) 根据对角线坐标画矩形的子程序 Dim boxp(0 To 14) As Double boxp(0) = p1(0) boxp(1) = p1(1) boxp(3) = p1(0) boxp(4) = p2(1) boxp(6) = p2(0) boxp(7) = p2(1) boxp(9) = p2(0) boxp(10) = p1(1) boxp(12) = p1(0) boxp(13) = p1(1) Call ThisDrawing.ModelSpace.AddPolyline(boxp) End Sub 下面开始分析源码: On Error Resume Next chang = ThisDrawing.Utility.GetReal("长度(90,120)<10500>") If Err.Number <> 0 Then 用户输入的不是有效数字 chang = 10500 Err.Clear 清除错误 End If 这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示:On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。 在画小禁区的最后一行这样写:Call drawbox(linep1, linep2) Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形， 而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数:linep1、linep2。 ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) 计算角度 ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4) Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) 画弧 画圆用addarc方法，需要4个参数:圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标 下面看镜像操作: For Each ent In ThisDrawing.ModelSpace 所有模型空间的对象进行一次循环 If ent.Layer = "足球场" Then 对象在"足球场"图层中 ent.Mirror linep1, linep2 镜像 End If Next ent 本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。 本课思考题: 1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入 2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中 autocad vba初级教程 第十三课块操作 发布:2007-2-16 10:59:12 来源:模具网 浏览 537 次 编辑:佚名 定义块方法: Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名) 把选择集加入块中的方法: ThisDrawing.CopyObjects(选择集,块) 插入块方法: ThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度) 画块属性方法: ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值) 一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式 下面的例题是利用属性块画足球场的阵型图。 程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一课内容。 编程思路: 1(定义一个空块 2(在块中画一段弧(球服衣领) 3(画多段线，镜像画出球衣 4(画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块 的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更 改对齐点属性 5(把多段线和属性复制到块中 6(提示用户点选球员位置和姓名 7(插入块，修改球衣号码属性、球员姓名属性 以下是源码，附有详细的注释，如果有疑问，建议用变量跟踪法研究一下。 Sub team() Dim playerlay As AcadLayer 定义球员图层 Dim playerblock As AcadBlock 定义块变量 Dim arcc(0 To 2) As Double 圆弧圆心 Dim linep1(0 To 2) As Double 线条端点1 Dim linep2(0 To 2) As Double 线条端点2 Dim pline(0 To 20) As Double 定义队服右侧多段线7个顶点 Dim basep(0 To 2) As Double 块基点 Dim playernumberpoint(0 To 2) As Double 块属性插入点 Dim mytxt As AcadTextStyle 定义mytxt变量为文本样式 Dim blockRef As AcadBlockReference 定义块属性变量 Dim Attr3 As Variant 插入块属性变量 Set playerblock = ThisDrawing.Blocks.Add(basep, "球员") 定义一个"球员"的块 arcc(0) = 0 arcc(1) = 430 Call playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) 画弧并 加入块中 pline(0) = 0 pline(1) = 20 pline(3) = 100 pline(4) = 20 pline(6) = 100 pline(7) = 250 pline(9) = 125 pline(10) = 207 pline(12) = 212 pline(13) = 257 pline(15) = 112 pline(16) = 430 pline(18) = 50 pline(19) = 430 Set line1 = ThisDrawing.ModelSpace.AddPolyline(pline) 画队服右侧多段线 linep2(1) = 1 镜像轴第二点位于Y轴上任一点 Set line2 = line1.Mirror(linep1, linep2) 镜像获得另一半多段线 Dim p(0 To 2) As Double 定义坐标变量 Set mytxt = ThisDrawing.TextStyles.Add("mytxt") 添加mytxt样式 mytxt.fontFile = "c:\windows\fonts\simfang.ttf" 设置字体文件为仿宋体 ThisDrawing.ActiveTextStyle = mytxt 将当前文字样式设置为mytxt playernumberpoint(0) = 0 块属性位置 playernumberpoint(1) = 200 Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "号码", playernumberpoint, "X", 0) 画块属性 attr1.Alignment = 7 居中 attr1.TextAlignmentPoint = playernumberpoint 重定义对齐点 Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) 画块属性 attr2.Alignment = 7 居中 Dim objCollection(0 To 3) As Object 创建选择集 Set objCollection(0) = line1 线条1加入选择集 Set objCollection(1) = line2 线条2加入选择集 Set objCollection(2) = attr1 属性1加入选择集 Set objCollection(3) = attr2 属性2加入选择集 Call ThisDrawing.CopyObjects(objCollection, playerblock) 把选择集加入块中 For Each element In objCollection 在选择集中进行循环 element.Delete 删除线条和属性(此操作并不影响已创建的块) Next Set playerlay = ThisDrawing.Layers.Add("球员") 新建图层 playerlay.color = 2 为黄色 ThisDrawing.ActiveLayer = playerlay 将当前图层设置为球员图层 Dim p1 As Variant 块插入点位置 For i = 1 To 11 插入块 pstring = CStr(i) & "号球员位置:" p1 = ThisDrawing.Utility.GetPoint(, pstring) 点选球员位置坐标 nstring = ThisDrawing.Utility.GetString(30, "球员姓名:") Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球员", 1, 1, 1, 0) 插入块 Attr3 = blockRef.GetAttributes 获取块属性 Attr3(0).TextString = CStr(i) 赋值球员号码 Attr3(1).TextString = nstring 赋值球员姓名 Next End Sub 本课思考题: 1、在本课例程的最后一段增加出错陷阱代码，当用户输入非正常数值时退出程序 2、画一个简易路灯块，用属性块做为路灯编号，由用户点选路灯位置，程序画路灯时自动 为路灯编号 基于autocad的vba组件的包装结构自动设计实现 发布:2007-2-16 11:00:45 来源:模具网 浏览 147 次 编辑:佚名 摘要:从包装CAD 图形的分类及实现方法入手，比较AutoCAD 的二次开发方法，基于功能构素划分和参数化设计思想，提出利用VBA 组件实现包装结构工程图形自动设计生成的解决方案，并通过纸盒结构自动设计实例给出了具体开发过程。该过程易实现、成本低，适于企业开发个性化包装结构设计系统。 关键词:VBA 组件;包装结构;参数化设计;功能构素 包装CAD 的图形分平面装潢与外观造型、包装结构工程图形(如生产工艺单)2 大类。平面装潢通过Photoshop、Illustrator、CorelDRAW、Freehand 等实现，包装造型部分通过3DMax、Rhino、Maya、Pro / E、UG 等实现;包装结构工程图形设计既可以运用Pro / E、UG、AutoCAD 等软件直接设计绘制，也可以利用一定的平台二次开发实现自动设计生成。目前，国内外也涌现出一批优秀的包装设计专业软件，如packdesign2000、方正包装3. 0。 利用通用的图形图像设计软件直接设计效率不高，而专业软件不可能适应所有的企业，而且这些软件都很昂贵。针对包装容器的生产加工，如何寻找一种有效的途径，既满足不同企业个性化需求，又能缩短设计周期、大大降低人力、物力成本，提高设计效率，是许多企业渴望实现的。当然，平面装潢设计包含了太多艺术成分，具有太多的可变性，难以用程序实现，因此，本文将讨论不同包装企业，以AuotCAD 为平台，如何方便的实现包装容器结构工程图形的自动设计生成。 1 AutoCAD 系统二次开发概述 AutoCAD 系统的二次开发指由既熟悉专业产品设计又掌握计算机应用技术的人员在AutoCAD 平台上开发出针对某类产品的专业CAD 应用软件。二次开发实现图形设计及自动生成是对CAD 软件更高层次的运用。 AutoCAD 是AUTODESK 公司推出的基于微机的当今世界应用最为广泛的CAD 系统，采用开放式体系和良好的二次开发环境，许多机械、电子、建筑行业的专业软件都是在其基础上二次开发得到的。AutoCAD 先后提供了Autolisp / Visuallisp、ADS / ARX、VBA 这3 种主要的开发工具。从目前的应用看，Autolisp 是最初的开发手段，已被Visuallisp 取代;ADS 将逐步被功能强大的ARX 所取代;VBA 则成为AutoCAD 用户二次开发的另一支生产军。AutoCAD 提供的几种开发工具各有千秋，让各类开发者都能有适合于自己的开发工具。 从AutoCAD R14 开始，VBA 就成为AutoCAD 标准的嵌入组件。VBA 起着一种接口作用，把微软推出的VB 开发工具的强大开发功能与AutoCAD 丰富的图形对象有机结合起来，形成强大的工程图形二次开发功能。VBA 组件基于可视化、面向对象开发工具VB，其开发环境与VB 集成开发环境相近，但较Autolisp / Visuallisp、ADS / ARX 等开发工具，更能快捷、方便地实现友好的人机交互，功能强大、扩展灵活且开发简单，易于实现。 当然，要实现包装结构自动设计系统的二次开发，不论用哪种开发工具，都必须在参数化和图形库与功能构素库技术上下功夫，只有这样系统才能真正高效。本文以一种折叠纸盒为例，介绍利用AutoCAD 的VBA 组件进行二次开发实现工程图自动生成的解决方法及具体实现。 2 Auto CAD 内嵌的VBA 组件实现包装结构图形自动设计解决方案 图1 为包装结构图形自动设计解决方案，分为开发阶段和应用阶段。开发阶段主要是从专业设计入手，分析图形( 由于本文例程图形简单，故省掉该环节)、划分功能构素、参数化、编写dvb 程序;应用阶段通过前期设计提供的数据，同时将dvb程序自动加载，然后直接执行实现自动设计生成。下面是具体 的实现过程。 图1 包装结构图形自动设计解决方案 3 功能构素划分 所谓功能构素就是构成完整包装容器的功能部位结构元素，所有功能构素的集合则构成功能构素库,。功能构素解决构成完整结构的不同功能部位，在每个部位都有多种结构供选择情况下，各个功能部位结构任意组合问题，使得用很少的局部功能结构元素的参数化设计( 即很小的功能构素库)，就可以高效的得到很多种结构组合，以满足用户需求，而不必每种结构都设计。各种具体的包装结构将从功能构素库中调用构素组合而成，实现构素的复用。 一种折叠纸盒的展开图见图2，将其划分盒盖、盒体、盒底 3 部分功能构素。 4 参数化功能构素 参数化设计，就是在给定结构形式的条件下，依据一定的参数，自动生成相应的设计。参数绘图则是通过输入设计的主要参数，对标准图样进行变量代换，实现参数化绘图，最后生成符合设计要求的图形。这种方法的优点是能够和设计模块连接起来，自动出图，实现真正的计算机辅助设计，从而极大地提高设计效率。参数化设计是新一代CAD 技术的基本特征，是实现设计过程自动化的有效手段之一，它不仅使CAD 系统具有交互式绘图功能，还具有自动绘图功能。 图2 功能构素划分 对包装行业，许多包装容器还没有进行标准化、系列化和通用化分类，包装容器作为特殊的产品，必须容装各种随机尺寸、形状的产品，其结构是千变万化的，但是，总可以按一定形式分类，对出现的所有结构按照分类实现参数化，对未出现的新结构可以寻找相似的结构加以修改，逐渐积累。 对各种纸盒，尤其是常见的六面体盒形，以折叠纸盒为例:一旦其长、宽，高，纸的厚度等尺寸给出，盒形的各部件的尺寸及位置，就可以用盒形的这几个参数来确定，通过修改这几个参数就可以得到不同大小的盒形，当出现用现有几个参数不能表达的新结构，可以根据需要增加参数，这是包装纸盒系统的参数化设计。 分别令长、宽、高为:L、B、H;插舌和粘贴边为:可kcs、kjt。 如图2 所示，对盒盖功能构素标点1 - 15 点，以盒盖的第1 点为坐标原点，水平方向为x 轴，竖直方向为y 轴建立坐标系，则所有坐标点被参数化为含L、B、H、kcs、kjt 相关的表达式。 5 编写功能构素绘图程序 5. 1 建立交互界面 在AutoCAD 命令行执行vbaide 命令打开VBA 集成开发环境，该环境与VB 的开发环境接近。将设计、运行、调试集成，以Thisdrawing 文档组织，根据需要添加模块、实现人机交互的窗体等对象，以dvb 文件保存工程所有信息。右键点击工程，在快捷菜单中选添加，选择窗体命令，即可建立一个新的窗体。根据人机交互需要建立相应的对象。 5. 2 初始化图层 右键点击工程，在快捷菜单中选添加，选择模块命令，即可建立一个新的模块。图层初始化方法如下: Public l1csx As AcadLayer '定义图层对象: Sub italize()'初始化图层 ThisDrawing. Linetypes. Load " center" ，" acadiso. lin" Set l1csx = ThisDrawing. Layers. Add(" l1csx" ) l1csx. color = acblack ThisDrawing. ActiveLayer = l1csx ThisDrawing. ActiveLayer. Linetype = " continuous" End Sub„其它图层略 5. 3 在Thisdrawing 文档进行绘图编程 5. 3. 1 创建图形对象;(以盒盖为例) Sub js-01hega(i )'计算盒盖各点坐标值 pthega(i 0)= 0:pthega(i 1)= 0 '1 pthega(i 2)= 0:pthega(i 3)= b - 2 '2 . . .„其它点坐标表达式省略 End Sub Sub draw-01hega(i )'画盒盖 Dim points(0 To 29)As Double Dim points1(0 To 3)As Double '定义盒盖图形对象 Dim plobj-hegai-cx As AcadLWPolyline Dim plobj-hegai-xx As AcadLWPolyline '画2 - 5 虚线段略 For i = 0 To 29 '画实线 point(s i) = pthega(i i) Next i Set plobj-hegai-cx = ThisDrawing. ModelSpace. AddLightWeightPolyline(points) End Sub 5. 3. 2 创建标注对象;(以盒身为例) Sub dim-hes()'水平标注 Dim dimobj As AcadDimAligned Dim point1(2)As Double:Dim point2(2)As Double: Dim location(2)As Double '水平总尺寸 point1(0)= pthes(8):point1(1)= pthes(9)- kjt point2(0)= pthes(22):point2(1)= pthes(23) location(0)=(point1(0)+ point2(0))/ 2:location(1) = b + 50 Set dimobj = ThisDrawing. ModelSpace. AddDimAligned (point1，point2，location) '水平其它尺寸略 End Sub 5. 3. 3 创建文本对象 Sub txt-01zdzh()'建立文本 Dim txt00zdzh As AcadMText Dim txt As String:Dim points(0 To 2)As Double txt = . . .„(具体文本内容根据需要给定) points(0) = 4 * l:points(1) = 0:points(2) = 0 Set txt00zdzh = ThisDrawing. ModelSpace. AddMText (points，240，txt) End Sub 5. 4 添加自动加载dvb 程序命令和程序文件路径 将自动加载dvb 程序命令添加到菜单，并在配置对话框中添加的程序文件路径。 以下是向AutoCAD 添加主菜单“ 包装实例”的方法，在ACAD. mnu 文件里添加如下内容:ID-draw-01zdzh, 折叠盒,ˆCˆC( command " vbaload" " 01-zdzh" );(command " - vbarun" " draw-01zdzh" )在AutoCAD 命令行执行config 命令，弹出“ 选项”对话框，点击“文件标签”，设置菜单加载位置和添加工程文件路径和工作文件路径。 5. 5 运行命令实现图形自动生成 运行主菜单“包装实例”下的“折叠纸盒”命令，在弹出的对话框中输入长、宽、高、插塞尺寸、接头尺寸等已知条件即可自动生成折叠纸盒生产工艺单。 6 结 语 通过功能构素划分，分别编写了几种盒底和盒盖，自由组合得到多种结构，表明Auto CAD 内嵌的VBA 组件是实现包装结构自动设计的一种有效解决方案。该方法简洁、有效、实用、易实现，适用于企业开发个性化包装结构设计系统，开发成本低。 参考文献: ,1, 包装设计的数字化手段,EB/ OL,.(2005 - 10 - 3). http:/ / www.99bz. cn / llxx / sjll / 200510 / 194. html.(余不详) ,2, 张锋，陈爱萍. AutoCAD 二次开发环境的探讨,J,. 机械设计与制造，2005，(9):125 - 127. ,3, 杨文杰，刘浩学. 包装纸盒的组件设计,J,. 包装工程，2003，24(5):12 - 13. ,4, 杨文杰. 包装纸盒参数化设计的实现, J,. 包装工程，2004，25(2):81 - 83. ,5, 张帆，郑立楷，等. AutoCAD VBA 二次开发教程,M,. 北京:清华大学出版社，2006. autocad结合matlab实现公式曲线曲面的精确绘制 发布:2006-12-17 17:03:47 来源:模具网 浏览 80 次 编辑:佚名 一、引言 用AutoCAD绘制平面公式曲线(如渐开线、心形线)、空间公式曲线(如螺旋线)以及公式曲面(如马鞍形曲面)是比较困难的，一般情况下，需要用AutoCAD开发程序编程，但多数程序比较复杂，尤其是公式曲面的绘制程序，需要多层嵌套循环，复杂且运行效率低。 快速且精确地绘制各种公式曲线、曲面恰恰是MATLAB的长项，但是MATLAB绘制的图形却不能直接用于机械零件设计。其中非常关键的一点，就是MATLAB绘制的曲线、曲面分别是由有限个点连接而成的折线和空间网格构成的，而在AutoCAD中绘制的曲线、曲面也是如此。因此，只需要把在MATLAB中绘制的公式曲线、曲面上所有的点坐标数据都提取出来，若能让AutoCAD正确识别，那么我们就可以在AutoCAD中精确地绘制这些曲线、曲面了。 本文介绍了一种快速、精确地绘制各种公式曲线、曲面的方法，即在AutoCAD中通过调用经过Excel处理的MATLAB数据实现。 二、AutoCAD和MATLAB的特点 MATLAB是非常优秀的科学计算、信号处理以及图形显示软件，它有自身的语言，与其他高级语言相比，MATLAB提供了一个人机交互的数学环境，并以矩阵作为基本的数据结构，可大大节省编程时间。另外，MATLAB不仅语法规则简单，容易掌握，调试方便，还可以存储中间结果，这使得MATLAB既可以快捷、精确地绘制各种公式曲线、曲面，又可以很方便地提取中间数据。 在工业设计领域，AutoCAD不仅被广泛应用于平面绘图，也可以用于三维建模，但在曲线、曲面造型方面不是很理想。它是开放型的人机交互系统，有多种语言接口，与外界的数据交换很灵活，这些特点使得它与MATLAB的结合成为可能。 三、结合MATLAB在AutoCAD中绘制曲线、曲面的原理及方法 1.原理 MATLAB中的矩阵数据虽然很容易提取，但由于它不是AutoCAD能识别的格式，因此不能直接被AutoCAD调用，需要先用Excel对从MATLAB中提取的数据进行编辑，转换成AutoCAD可以识别的格式，才能在AutoCAD中绘出曲线、曲面。 2.方法 由于在AutoCAD中绘制平面曲线、空间曲线和曲面的绘制命令不同，且数据结构也不同，因此结合MATLAB的绘制方法也稍有区别。这种绘制方法的关键就是把数据格式转换成AutoCAD的绘制命令所需要的数据格式，只要熟悉AutoCAD的数据结构，就可以举一反三。 在这三者中最复杂的是绘制公式曲面的数据结构，下面就以一个马鞍形曲面的绘制为例来介绍这种方法，数学模型如公式(1)所示。 (1)利用MATLAB得到公式曲面数据 1)在MATLAB中绘制出曲面 在MATLAB中输入如下命令: [th,r]=meshgrid((0:5:360)*pi/180,0:.05:1); %在极坐标系下设置一个73×21的网格矩阵，即圆周方向分为73份，半径方向分为21份，总共分了1533个点，节点越多，图形越精确 % [X,Y]=pol2cart(th,r); %转化为笛卡儿坐标系% Z=X+i.*Y; F=abs((Z.^4-1).^(1/4)); surf(X,Y,F); %显示曲面的立体图形% S=[X(:) Y(:) F(:)]; %把X、Y、F 3个矩阵中的数据存储到矩阵S中% 运行后得到曲面图形，如图1所示。 图1 MATLAB中绘制的曲面 2)提取点坐标 在MATLAB的“Workspace”窗口中可以看到S是个1533×3的矩阵，即表示有1533个点的坐标，每个点有三个坐标参数，双击打开S，则弹出“Array Editor:S”窗口，窗口表格中的数字就是矩阵的数据。 先将全部数据复制到剪贴板，下面用Excel对坐标数据进行数据处理。 (2)利用Excel编辑曲面数据 打开Excel，将保存在剪贴板里的数据粘贴到Excel表格里，得到三列数据，每列1533行。其中，A、B、C列中的数据分别是曲面上各点的笛卡儿坐标系中的X、Y、Z值，而在AutoCAD中的笛卡儿坐标系的点坐标的输入形式为“x，y，z”，所以我们需要对A、B、C列的数据间加个“，”。 方法是:点选中D1(D表示第D列，1表示第1行)格，在公式栏里输入“=A1&","&B1&","&C1”后回车，再将光标放到D1格的左下角，当光标变成黑色十字时，按住鼠标左键向下拖动，一直到D1533格，这时D列的数据格式已经变成了“X，Y，Z”，就可以被AutoCAD正确读取了。复制D列数据到剪贴板后，就可以在AutoCAD中绘制曲面了，如图2所示。 图2 在Excel中编辑后的曲面数据 3.在AutoCAD中绘制曲面 在AutoCAD中运行3dmesh(三维网格)命令，命令行提示“Enter size of mesh in M direction: ”，输入“73”后回车，命令行提示“Enter size of mesh in N direction: ”，输入“21”后再回车，(即73×21的网格矩阵)，然后在命令行中粘贴剪贴板中的数据，程序将自动运行，结束后就得到了马鞍形曲面，如图3所示。 图3 网格矩阵为73×21的马鞍形曲面 特别需要注意的是，在运行3dmesh命令时的网格矩阵一定要和MATLAB中的相同，否则将得到错误图形或运行出错。如果输入的网格节点数不等于1533，则命令运行出错;如果输入成21×73的网格，则命令执行结束后将得到错误的图形，如图4所示。 图4 网格矩阵为21×73的错误图形 四、结束语 用这种方法得到的公式曲线、曲面不是贴图，而是实际绘出和AutoCAD图元，不仅可以在MATLAB中控制精度，还可以被用于进行各种相应发的命令操作，比如复制、镜像、拉伸放样、旋转放样或用鼠标直接拖动任意节点来调整图形等等。AutoCAD结合MATLAB实现公式曲线、曲面的绘制，加强了AutoCAD在曲线、曲面造型方面的功能，使其在辅助设计方面发挥更大的作用。