AutocadVBA初级教程（2020修订版）本书源代码网盘资源下载地址：https://pan.baidu.com/s/1sk4iMvJ
v3zK77J-wfeRt2w提取码：6666（将网址复制到浏览器地址栏，输入提取码后下载）作者：普天同庆2020/12目录目
录1第一课:入门1第二课编程基础2第三课编程基础二4第四课程序的调试和保存6第五课画函数曲线8第六课数据类型的转换11
第七课写文字15第八课图层操作17第九课创建选择集20第十课画多段线和样条线22第十一课动画基础26第十二课参数化设计
基础30第十三课块操作35第十四课读写Excel表格39第十五课创建CAD表格42第十六课各种修改47第十七课填充54第
十八课自动标注61第十九课打印布局和输出70第二十课设计窗体74参考答案86第一课:入门1.为什么要写这个教程市面上ACAD
VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
2.什么是AutoCADVBA？VBA是VisualBasicforApplications的缩写。它是一个功能强大的开发
工具，学好VBA可以成倍提高工作效率。在工作中，有很多任务仅用ACAD命令不可能完成，只要学好VBA就可以做到，相信到时候您一定会
得到同事的佩服、老板的器重。3.VBA有多难？一句话：Basic的英文词义就是基础。4.怎样学习VBA？介绍大家一个学习公式：信心
+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。最好结合一些参考资料学习研究。为您推荐
AutoCAD官网学习资料：http://help.autodesk.com/view/OARX/2021/CHS/?guid=G
UID-5D302758-ED3F-4062-A254-FB57BAB01C44http://help.autodesk.com/
view/OARX/2021/CHS/?guid=GUID-5D302758-ED3F-4062-A254-FB57BAB01C4
45.现在我们开始玩第一个程序：画100个同心圆第一步：复制下面的红色代码第二步：在模型空间按快捷键Alt+F11打开vba编辑器
，因为新版VBA模块不再随AutoCAD一同安装，请移步Autodesk官网下载安装VBA模块,如果您的CAD是2016前版本，请
移步本教程封面百度网盘文件夹。第三步：在宏名称中填写C100，点“创建”，“确定”第四步：在Subc100()和EndSub之
间粘贴代码第五步：回到模型空间，再次按Alt+F8，点击“运行”Subc100()Dimcc(0To2)AsDoubl
e''声明坐标变量cc(0)=1000''定义圆心坐标cc(1)=1000cc(2)=0Fori=1To10
00Step10''开始循环CallThisDrawing.ModelSpace.AddCircle(cc,i10
)''画圆NextiZoomExtents?''显示整个图形EndSub也许您还看不懂上面的代码，这没有关系，只要能把同心画出来
就可以了，祝您成功。最后请做本课思考题：现在您愿意继续学习本教程第2课吗？第二课编程基础本课主要任务是对上一课的例程进行详细分析
。为了便于阅读，我用工具把代码自动改为黑底彩字，更改字体不会影响程序正常运行。下面是画100个同心圆的代码：Sub?c100()D
im?cc(0?To?2)?As?Double?''声明坐标变量cc(0)?=?1000?''赋值圆心坐标cc(1)?=?1000cc
(2)?=?0For?i?=?1?To?1000?Step?10?''开始循环?Call?ThisDrawing.ModelSpac
e.AddCircle(cc,?i??10)?''画圆Next?iZoomExtents?''显示整个图形End?Sub先看第1行和
最后1行：Sub?c100()?……End?SubC100是宏的名称，也叫过程名，程序开始运行后将执行subc100()和end
sub之间的所有指令。第2行：Dim?cc(0?To?2)?As?Double?''声明坐标变量后半段?''声明坐标变量自动变为绿色
字体，VBA单引号后面的绿色文字都是代码语句的注释，它不会影响程序运行，其作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要
写注释，如果要编写非常复杂的程序，最好多加注释，这是一个好习惯。电脑真正编译执行的是这条语句：Dim?cc(0?To?2)?As
?DoubleDim语句的作用是声明变量（另有翻译为定义变量）并分配存储空间。语法：Dim变量名As数据类型。本例中变量名为
CC，而括号中的0to2声明这个CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、CC(2)，如果改为CC(1to
3)，则三个元素是CC(1)、CC(2)、CC(3)。有了这个数组，就可以把坐标值放到这个变量之中。Double是数据类型中的一
种，称为双精度浮点数。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD的数据类型有很多，下面2个是比较常用的数据类型，初学
者要有所理解。Object：各种对象类型，CAD的各种图元都可以用这个变量类型Variant：变体类型变量，可以理解为一种通用的
数据类型。如果Dim语句写在Sub和Endsub之间，那么这个变量只是在这个过程中有效，称为“私有变量”，与之对应的是“公共变
量”，在所有Sub中都有效，应写在所有Sub的前面。下面三条语句cc(0)?=?1000?''赋值圆心坐标cc(1)?=?1000c
c(2)?=?0它们的作用是给CC数组的每一个元素赋值，本例中，3个变量分别存放X、Y、Z坐标值。For?i?=?1?To?100
0?Step?10?''开始循环……Next?i这2条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到1000时，结
束循环。i也是一个变量，虽然没有声明i变量，程序还是认可的。这样做也有缺点，如果不小心打错了一个字母，程序不会报错，如果程序很长，
那就会出现一些意想不到的错误。step后面的数值就是每次循环时增加的数值，step后也可以用负值。例如：Fori=1000
To1Step-10I这是1个等差数列：i0=1000,in+1=in-10。很多情况下，后面step可以省略不用。如：Fo
ri=1to100，它的作用是每循环一次i值就增加1。Nexti语句必须放在需要结束循环的位置，不然程序没法运行。为了方便
阅读，建议循环体内的代码全部缩进2个空格。这样代码结构会更加清晰。最后看画圆：?Call?ThisDrawing.ModelSpa
ce.AddCircle(cc,?i??10)?''画圆Call语句的作用是调用其他方法或过程。ThisDrawing.Model
Space是确定画圆位置在CAD当前文档的模型空间中AddCircle是画圆方法，括号里需要填两个参数：圆心和半径圆心参数要先声明
为Double或Variant类型,必须是3个元素的数组，存储圆心的x，y，z坐标值。半径参数应该是大于0的数值，也可以填入计算结
果大于0的表达式。在本例中i10就是1种典型的表达式。这些圆的半径分别是10、110、210、310……最大号圆半径是9910，
因为当i=991时是这个程序画出来的最后1个圆，下1次循环时i=991+10=1001，这个数字已经超过i最大值1000，这时程序
会退出循环体,不再执行画圆指令。以AddCircle方法为例，在文档模型空间里调用各种方法画图有以下3种写法：1.CallThi
sDrawing.ModelSpace.AddCircle(圆心,半径)2.ThisDrawing.ModelSpace.AddC
ircle圆心,半径3.Set圆对象=ThisDrawing.ModelSpace.AddCircle(圆心,半径)前2种
写法效果1样。第3种用set命令的作用是把画好的圆赋值给圆对象，便于以后选择修改。等号左侧的圆对象可以声明为Variant、Obj
ect、AcadCircle等3种类型中的1种。虽然不声明圆对象变量也可以完成任务，但建议这类关键变量在使用之前先Dim。关于画圆
方法更多内容请参阅官网参考手册，网址：http://help.autodesk.com/view/OARX/2021/CHS/?g
uid=GUID-837C702F-91A7-445B-8713-3099B94664BEhttp://help.autodesk
.com/view/OARX/2021/CHS/?guid=GUID-837C702F-91A7-445B-8713-3099B9
4664BE思考题：1.以(4,2)为圆心，画5个同心圆，其半径为1-5。第三课编程基础二有一位叫自的网友提出了下面的问
题：绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。本课以此题为例。谈一下编程思路：1、获取第一点坐标2、输入第一点Z
坐标3、获取第二点坐标4、输入第二点Z坐标5、以第一、二点为端点，画直线6、下一条线的第一点=这条线的第二点7、回到第3步进行循环
在此期间，只要用户输入不对，则程序结束。为了简化程序，这里用多条直线来代替多段线。以下是源码：Sub?myl()Dim?p1?As
?Variant?''声明端点坐标Dim?p2?As?VariantOn?Error?GoTo?Err_Control?''出错陷井p
1?=?ThisDrawing.Utility.GetPoint(,?"输入点:")?''获取点坐标z?=?ThisDrawing.
Utility.GetReal("Z坐标:")?''用户输入Z坐标值p1(2)?=?z?''将Z坐标值赋予点坐标中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?''将第二点的
端点存为下一条直线的第一个端点坐标LoopErr_Control:End?Sub看以下两条语句：p1?=?ThisDrawing.
Utility.GetPoint(,?"输入点:")?''获取点坐标……p2?=?ThisDrawing.Utility.GetPo
int(p1,?vbCr?&?"输入下一点:")?''获取下一个点坐标这两条语句的作用是由用户在CAD的当前活动文档中输入或用鼠标选
取点坐标，并把坐标值分别赋予p1、p2两个变量。ThisDrawing.Utility.GetPoint()在ACAD中这是最常用
的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标数组，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点
跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。逗号后面使用一串字符，程序在命令行显示这串字符，
这不难理解。VbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”&是连接字符。请注意，这个方法等号左面的
被赋值变量必须声明为变体（Variant）类型。z?=?ThisDrawing.Utility.GetReal("Z坐标:")?''
用户输入Z坐标值由用户输入一个实数，括号里双引号中的字串是提示语。On?Error?GoTo?Err_Control?''出错陷井…
…Err_Control:OnError是出错陷井语句，在程序出错时将执行OnError后面的语句GoToErr_cont
orl是程序跳转语句，它的作用是在程序中寻找并跳转到Err_control:，然后执行这一行下面的语句，本例中Err_Contr
ol:后就是结束宏，所以只要出现错误，程序中止。Do?''开始循环……Loop这个循环就历害了，它会无休止地进行循环，好在本例中已经
有了一个出错陷井，当用户输入回车时，由于程序没有得到点坐标，程序出错，跳出循环，中止程序。如果想控制跳出循环，可以在代码中用Exi
tDo语句跳出循环体。如果需要在For和Next语句之间跳出循环，那么只要在循环体内的适当位置加上Exitfor就可以了。
有时候程序运行时会无休止循环永不退出，行话称为“死循环”。初学者写代码，往往会不小心让程序陷入死循环，如果程序开始运行后长时间没反
应，这时可以同时按下Ctrl+Break键强行退出，标准键盘的Break键在第1行最右侧。Call?ThisDrawing.Mod
elSpace.AddLine(p1,?p2)?''画直线画直线方法也是很常用的，它的两个参数是端点坐标变量。这个方法还有另外2种写
法，请参照本教程第2课画圆方法自行脑补。和画直线类似的画射线方法：AddRay,其参数是2个坐标点，可以这样写：ThisDrawi
ng.ModelSpace.AddRayp1,?p2?''画射线思考题：1.连续画圆，每次要求用户输入圆心、半径，当用户不再输入
圆心或半径时程序才退出2.画出5根射线，第1点坐标（1，1），第2点坐标由用户依次输入第四课程序的调试和保存人非圣贤，孰能无过。
初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，程序中的缺陷和漏洞，行话称为Bug。码农捉Bug是
一项不可或缺的重要工作，而每1个新手都要在调试程序中不断摸索、积累经验。首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。
当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、方法、函数参考数据供你参考，可以用上下键选择，然后按TAB键（
它位于“Q”键左边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。为了避免低级错误，当我们在写比较复
杂的程序时，会在代码窗口顶部增加一行命令:Option?Explicit其作用是强制声明所有变量，这样程序编译时出现没有声明过的变
量就会报错，虽然需要多写几个dim语句,但这样做可以最大程度避免打字错误。作为初级教程，这里大部分例题非常简短，所以没必要强制声明
所有变量，而且初学者也需要训练在一堆代码中寻找问题的眼力。如果你发现程序运行有问题，反复调试仍然找不出原因，建议在开头加上这条语句
，强制声明所有变量，看看是不是哪里打错字了。我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪
一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变
化。下面我举一个简单的例子，先看源码：Option?ExplicitSub?test()Dim?i,?j,?kFor?i?=?2?
To?4?Step?0.5?For?j?=?-5?To?2?Step?5.6k?=?i?Mod?j?Next?jNext?iEnd
?Sub这里每一次循环i便会增加0.5，k=i/j的余数。每一次循环后i、j、k值变为多大？第一步：在菜单中选“调试”—“添加监视
”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。再来1次，加上变量j、k。第二步：把光标移到代码窗口中的“nex
ti”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F
5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。第三步：在nexti行再按一次F9，清除断点。
要取消监视可以在右键菜单选择“删除监视”,选中那个变量或表达式后按Del键也行。另外，还可以用“逐语句”、“逐过程”、“运行到光标
处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。另外，还可以用快捷键Ctrl+G打开立即窗口，然后输入问号+
变量或表达式获得答案。建议在写代码时把程序中所有的出错陷阱语句先注释掉，待程序调试基本完成后再放出来。这样才能及时发现问题。到目前
为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的AutoCAD图形文件中，以后打开这个文件时代码才会加载。ACADV
BA还有一种工程叫“通用式工程”，程序可以在不同用户、不同的图形文件中共享。在CAD中按Alt+F11打开vba编辑器后，再按F7
代码窗口，粘贴代码后按下Ctrl+S保存为DVB文件。使用时需要加载。在管理菜单中加载运用程序，然后选择DVB文件加载。思考题：1
.监视下列代码中的i和j的值注意，此题虽然要监视2个变量，但是在代码窗口中只要设置1个断点就足够了。sub?test2()for?
i=2?to?4?step?0.6?for?j=-5?to?2?step?5.5??next?jnext?iend?sub?2.
画30个圆，圆心x坐标:x1=0,xn=3n，y坐标为0;半径r1=3,rn=r1+3n第五课画函数曲线先画一组下图抛物线下面是
源码：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?=?-2
4?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?aEnd?sub为了鼓励大家积极思考
，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句做些解释，也许你一时很难明白，建议结合编程参考手册，用上一课提到的
跟踪变量、添加断点的办法领悟每一条语句的作用。在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化
。ACAD没有现成的画抛物线命令，我们可以用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正
负24之间。程序第二行：Dim?myl?As?Object?''声明引用曲线对象变量本例中myl变量将引用多段线，定义为通用的Obj
et类型即可。二维多段线对象也可以声明为AcadLWPolyline类型：Dim?myl?as?AcadLWPolyline在我们
的例程中，这2种写法运行结果是一样的。Object对象是各种图元的通用类型，更好记，方便初学者。而AcadLWPolyline对象
只能是2维多段线，这样声明的好处有2个：1.可以省略注释，明眼人一看就知道这货是条2维多段线，2.如果不小心把这个变量赋值成其他类
型图元时，程序运行会报错提示，这有利于编写更复杂的程序。画多段线命令：Set?myl?=?ThisDrawing.ModelSpa
ce.AddLightWeightPolyline(p)?''画多段线其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元
素分别是一个点坐标的XY值。等号前面部分“Setmyl”的作用就将myl变量去引用画好的多段线。myl.Color?=?co?''
设置颜色属性color是CAD对象的一种属性，顾名思义，它是对象的颜色属性。在ACAD中，颜色可以用数字表示，本例中每画1次抛物线
co都会增值，这样就会产生五彩缤纷的效果。Autocad常用颜色对应数值：1-红色2-黄色3-绿色4-青色5-蓝色6-洋红7-白色
本课第二张图：画正弦曲线Sub?sinl()Dim?p(0?To?719)?As?Double?''定义点坐标For?i?=?0?T
o?718?Step?2?''开始画多段线p(i)?=?i??2??3.1415926535897?/?360?''横坐标p(i?
+?1)?=?2??Sin(p(i))?''纵坐标Next?iThisDrawing.ModelSpace.AddLightWei
ghtPolyline?(p)?''画多段线ZoomExtents?''显示整个图形End?Subp(i)?=?i??2??3.1
415926535897?/?360?''横坐标用角度计算横坐标，后面表达式的作用是把角度转化弧度p(i?+?1)?=?2??Si
n(p(i))?''纵坐标Sin(x)、cos(x)、tan(x)都是VBA标准的数学函数，下面再补充几个VBA常用数学公式函数：A
BS(x):绝对值Atn(x):反正切值Log(x):自然对数值Sqr(x):平方根思考题：1.画1条黄色抛物线：y=0.1x
x+3，其中x取值范围在正负50之间2.画1条红色直线，以原点为起点，终点极坐标为（10,3.14159/4）第六课数据类型的转
换上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。下表列出了更多数据类
型类型含义Integer整数类型Long长整型Single单精度类型Double双精度数值Variant可变类型String字符串
类型Object对象类型Date日期类型Boolean布尔类型我们举例说明：jd=ThisDrawing.Utility.An
gleToReal(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.D
istanceToReal("1.25E+01",1)temp2=ThisDrawing.Utility.DistanceT
oReal("12.5",2)temp3=ThisDrawing.Utility.DistanceToReal("121/
2",5)而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数第一个参数是一个实数，第二个参数表示数
据格式，含义同上，最后一个参数表示精确到几位小数。temp1=ThisDrawing.Utility.RealToString(
12.5,1,3)得到这个字符串：“1.250E+01”下面介绍一些VB数型转换函数：Int，获得一个整数，例：Int(3.1
4159)，得到3。注意Int函数取整规则并不是传统意义的四舍五入法，而是舍弃小数点后面的小数。Int(10.9999)的计算结
果是10而不是11Cvar，获得一个Variant类型的数值，例：Cvar(123&"00")，得到“12300”Cdate，
转换为date数据类型，例：happyday=CDate("09-02-1945")Year，获得日期中的年份,例：Year(
"09-02-1945")month，获得日期中的月份,例：Month("09-02-1945")day，获得日期中的日期,例：
day("09-02-1945")下面的例题写出一串数字，从000-099。Sub?testtxt()Dim?add0?As?St
ringDim?text?As?StringDim?p(0?To?2)?As?Doublep(1)?=?0?''Y坐标为0''?p(2
)?=?0?''Z坐标为0For?i?=?0?To?99?''开始循环If?i?"?''需要加00Else?''否则add0?=?"0"?''需要加0End?Iftext?=?add0?&?CStr(i)?''加零，并
转换数据p(0)?=?i??100?''X坐标Call?ThisDrawing.ModelSpace.AddText(text,?
p,?4)?''写字Next?iEnd?Sub重点解释条件判断语句：If条件表达式Then……Else……Endif如果满足
条件那么程序往下执行，到else时不再往下执行，直接跳到Endif后面如果不满足条件，程序跳到else后往下运行。If和Th
en之间的条件表达式非常丰富，这里的大于号是比较符号的一种，很多函数都可以用作条件表达式，以后结合实例详解。Call?ThisDr
awing.ModelSpace.AddText(text,?p,?4)?''写字这是写单行文本方法，需要三个参数，分别是:写的内容
、位置、字高下一个实例是经典的时间训练器，游戏规则：用户在弹出窗口后第10秒按确定键为赢，允许偏差±1秒。Sub?timegame
()msgstring0?=?"请在等待10秒后立即点确定键"?&?vbCr?&?vbCrmsgstring?=?msgstrin
g0winnum?=?10?''等待时间win?=?0?''赢几把lose?=?0?''输几把Do?time1?=?Now()?''获取当
前时间?gameover?=?MsgBox(msgstring,?1,?"时间训练器")?If?gameover?=?2?Then
?Exit?Do?''点了取消，退出循环?time2?=?Now()?waitsec?=?Int((time2?-?time1)?
?100000)?''计算时间差的秒数并取整?If?waitsec?=?winnum?Or?waitsec?=?winnum?-?1
?Then?win?=?win?+?1?msgstring1?=?"我等了"?&?waitsec?&?"秒，你赢了!!!!!!"?
Else?lose?=?lose?+?1?msgstring1?=?"我等了"?&?waitsec?&?"秒，你输了......"
?End?If?msgstring?=?msgstring0?&?msgstring1?&?vbCr?&?vbCr?&?"赢了"?
&?win?&?"次，输了"?&?lose?msgstring?=?msgstring?&?"次，胜率："?msgstring?=
?msgstring?&?Round(win?/?(win?+?lose),?2)?&?"%"?msgstring?=?msgst
ring?&?vbCrLoopEnd?Sub看这一行：?time1?=?Now()?''获取当前时间片断now()是VB常用的函数，
其作用是获取电脑日期与时间变量如果要把今天的日期赋值给today变量，这样写：today?=?Date下一条语句给等待秒数wait
sec变量赋值：?waitsec?=?Int((time2?-?time1)??100000)?''计算时间差的秒数并取整time
2-time1获得时间差，但是这个时间差非常小，本例中的表达式可以将得到两者相差的秒数。gameover?=?MsgBox(ms
gstring,?1,?"时间训练器")Mgbox显示一个对话框，第1个参数是对话框内显示的内容,第3个参数是对话框标题第2个参数
可以控制对话框上的按钮。0只有确认按钮1确认、取消2终止、重试、忽略3是、否、取消4是、否MsgBox获得值如下：确认：
1取消：2终止：3重试：4忽略：5是：6否7在本例中，如果用户对话框中点确定则gameover=1，选取消则gameover=2初
学者不需要死记硬背，能有所了解就行了，需要用到这个对话框的时候回到这来查询即可。本课还有1个重点在这里：条件判断逻辑运算?If?w
aitsec?=?winnum?Or?waitsec?=?winnum?-?1?Then这条语句中白色的OR是“或运算”，它是一个
典型的逻辑运算符Or两边各有1个蓝色表达式，只要2个表达式满足任意1个，即可判断该表达式成立本例中，waitsec的值等于10或9
，则判断表达式成立更简单的例子：?If?a>0?Or?a<0?Then此例中，只要a为非零数都可以判断条件成立另1个常用的逻辑运算
符是“And”,与运算要求and左右的表达式全部成立，判断条件才会成立举例：If?a?>=?-10?And?a?<=?10?The
n?此例中a必须介于-10到10之间,判断条件成立思考题：1.显示1个对话框，提示今天距离高考（6月7日）还有几天第七课写文字客
观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是先定义文字样式，用样式来控制文字的特性。我们还是用
实例来学习，看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。Sub?wtxt()Dim?mytxt
?As?AcadTextStyle?''定义mytxt变量为文本样式Dim?p(0?To?2)?As?Double?''定义坐标变量p
(0)?=?100:?p(1)?=?100:?p(2)?=?0?''坐标赋值Set?mytxt?=?ThisDrawing.Text
Styles.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?''将当前文字样式设置为mytxtSet?
txtobj?=?ThisDrawing.ModelSpace.AddMText(p,?100,?"{做到老，学到老}\P"?&?
"此心自光明正大，过人远矣")txtobj.LineSpacingFactor?=?2?''指定行间距txtobj.Attachme
ntPoint?=?3?''右对齐（?1为左对齐，?2为居中）ZoomExtents''缩放到显示全部对象End?Sub虽然文本样式
不是标准的CAD图元，但它是1个独立的对象，其类名是AcadTextStyleSet?mytxt?=?ThisDrawing.Te
xtStyles.Add("mytxt")?''添加mytxt样式添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名fo
ntfile(文字文件)、height（高度）、width（宽度）、ObliqueAngle（倾斜）是文本样式最常用的属性Set?
txtobj?=?ThisDrawing.ModelSpace.AddMText(p,?100,?"{做到老，学到老}\P"?&?
"此心自光明正大，过人远矣")这条语句是写文本，需要三个参数。第一个参数p是坐标，100是宽度，最后一个参数是文本内容，其中\p是
一个回车符扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3倍，n取值范围是0.75-3在论坛中有一个经常被同好提
及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
\C是颜色格式字符，C后面跟一个数字表示颜色\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐最后，再来1
个实例：写九九乘法表Sub?multiplication99()Dim?mytxt?As?Object?''文字Dim?txtp(
2)?As?Double?''文字位置坐标xstep?=?30?''列间距ystep?=?10?''行间距txtp(0)?=?0?''起始
点横坐标txtp(1)?=?85?''起始点纵坐标For?i?=?1?To?9?For?j?=?1?To?9?txt?=?j?&?"
×"?&?i?&?"="?&?i??j?''文字内容?If?i?>=?j?Then?Set?mytxt?=?ThisDrawing
.ModelSpace.AddMText(txtp,?25,?txt)?''写文字?mytxt.Height?=?4.5?''改变文字
大小?mytxt.color?=?3?''绿色?End?If?txtp(0)?=?txtp(0)?+?xstep?''计算下1列的横坐
标?Next?j?txtp(0)?=?0?''横坐标回到第1列?txtp(1)?=?txtp(1)?-?ystep?''纵坐标向下移动
1行Next?iZoomExtentsEnd?Sub思考题：1.写出1-100平方表第八课图层操作先简单介绍两个方法：1、这条语
句可以建立图层：ThisDrawing.Layers.Add("新建图层")在括号中填写图层的名称。2、设置为当前的图层ThisD
rawing.ActiveLayer=图层对象注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量以下一些属性在操作图层
时比较常用：LayerOn打开关闭Freeze冻结Lock锁定Color颜色Linetype线型看一个例题：1、先在已有的
图层中寻找一个名为“新建图层”的图层2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置
为当前图层。3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层Sub?
mylay()Dim?lay0?As?ACADLayer?''定义作为图层的变量Dim?lay1?As?ACADLayerfindl
ay?=?0?''寻找图层的结果的变量，?0没有找到，?1找到For?Each?lay0?In?ThisDrawing.Layers
?''在所有的图层中进行循环?If?lay0.Name?=?"新建图层"?Then?''如果找到图层名?findlay?=?1?''把变
量改为1标志着图层已经找到?msgstr?=?lay0.Name?+?"已经存在"?+?vbCrLf?msgstr?=?msgst
r?+?"图层状态：?"?+?IIf(lay0.LayerOn?=?True,?"打开",?"关闭")?+?vbCrLf?msgs
tr?=?msgstr?+?"图层"?+?IIf(lay0.Freeze?=?True,?"已经",?"没有")?+?"冻结"?+
?vbCrLf?msgstr?=?msgstr?+?"图层"?+?IIf(lay0.Lock?=?True,?"已经",?"没有"
)?+?"锁定"?+?vbCrLf?msgstr?=?msgstr?+?"图层颜色号：?"?+?CStr(lay0.Color)?
+?vbCrLf?msgstr?=?msgstr?+?"图层线型：?"?+?lay0.Linetype?+?vbCrLf?msgs
tr?=?msgstr?+?"图层线宽：?"?+?CStr(lay0.Lineweight)?+?vbCrLf?msgstr?=?
msgstr?+?"打印开关"?+?IIf(lay0.Plottable?=?False,?"关闭",?"打开")?+?vbCrL
f?+?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?IfNext?lay0If?findlay?=?0?Then?''没有找到图层?Set?lay1?=?ThisD
rawing.Layers.Add("新建图层")?''增加一个名为“临时图层”的图层?lay1.Color?=?2?''图层设置为黄
色?ltfind?=?0?''找到线型的标志，?0没有找到，?1找到?For?Each?entry?In?ThisDrawing.L
inetypes?''在现有的线型中进行循环?If?StrComp(entry.Name,?"HIDDEN")?=?0?Then?''
如果线型名为"HIDDEN"?ltfind?=?1?''标志为已找到线型?Exit?For?''退出循环?End?If?Next?en
try?''结束循环?If?ltfind?=?0?Then?''没有找到线型?ThisDrawing.Linetypes.Load?"
HIDDEN",?"aCADiso.lin"?''加载线型?End?If?lay1.Linetype?=?"HIDDEN"?''设置线
型?ThisDrawing.ActiveLayer?=?lay1?''将当前图层设置为新建图层End?IfEnd?Sub在寻找图层时
我们用到foreach……next语句它的语法是这样的：ForEach变量In数组或集合对象……exitfor……
next变量它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循
环，每循环一次layo变量就代表一个图层在循环体中遇到exitfor语句则退出循环，如果没有exitfor，循环将在所有的
元素都操作一遍后结束。?If?lay0.Name?=?"新建图层"?Then?''如果找到图层名lay0.name代表这处图层的图层
名,lay0是对象名称，name是它的属性这条代码用到了iif（）函数?msgstr?=?msgstr?+?"图层状态：?"?+?
IIf(lay0.LayerOn?=?True,?"打开",?"关闭")?+?vbCrLfiif（）函数是1个判断语句，语法：ii
f（判断表达式，返回值1，返回值2）当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2ACAD图层中线型问题比较麻烦
，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：?ThisDrawing.Linetypes.Load?"
HIDDEN",?"aCADiso.lin"?''加载线型ThisDrawing.Linetypes.Load后需要两个参数，一个是
线型的名称，另外一个是线型文件的名称。这本是一个入门级的简单程序，但这么长的代码，在初学者眼里可能有点绕圈，没关系，您只要看懂一些
关键点就可以继续下一课了，认真看完这套教程后再回头看这段代码，你就不会头痛了。思考题：新建3个图层，图层名和颜色分别是红色、黄色、
绿色，把当前图层设置为红色图层第九课创建选择集1.在创建对象时给变量赋值，然后引用对象变量。以前的例程中已经做过多次了,现在复习
一下。看例程:先随机画300个圆,同时把对象存储到myselect数组中，然后引用此数组,把这些圆根据大小修改颜色。Sub?c30
0()Dim?myselect(1?To?300)?As?ACADEntity?''定义选择集数组Dim?pp(0?To?2)?As
?Double?''圆心坐标For?i?=?1?To?300?''循环300次?pp(0)?=?3000??Rnd:?pp(1)?=
?3000??Rnd:?pp(2)?=?0?''设置圆心坐标?Set?myselect(i)?=?ThisDrawing.Mode
lSpace.AddCircle(pp,?Rnd??30?+?1)?''画不同大小的圆Next?iFor?i?=?1?To?300
?If?myselect(i).Radius?>?10?Then?''判断圆的直径是否大于10?myselect(i).color?
=?Int(255??Rnd?+?1)?''大圆颜色改为随机数?Else?myselect(i).color?=?0?''小圆改为白
色?End?IfNext?iZoomExtents?''缩放到显示全部对象End?Sub?pp(0)?=?3000??Rnd:?p
p(1)?=?3000??Rnd:?pp(2)?=?0?''设置圆心坐标这一行实际上应该是三条语句,将三行合并为一行,用冒号分开，
看上去简洁点。Rnd是随机数函数,它的数值为大于等于0且小于1的随机小数,300rnd得到的数值就是大于等于0且小于300的随机
数。?Set?myselect(i)?=?ThisDrawing.ModelSpace.AddCircle(pp,?Rnd??3
0?+?1)?''画不同大小的圆这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择
集。2.提示用户在屏幕中选取这样写：Setsset=ThisDrawing.SelectionSets.Add("ss1")
其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了。下面的例程是让用户选择对象,然后把选中的对象改为绿色
,最后把选择集删除。Sub?mysel()Dim?sset?As?ACADSelectionSet?''定义选择集对象Dim?ele
ment?As?ACADEntity?''定义选择集中的元素对象Set?sset?=?ThisDrawing.SelectionSe
ts.Add("ss1")?''新建一个选择集sset.SelectOnScreen?''提示用户选择For?Each?element
?In?sset?''在选择集中进行循环?element.color?=?acGreen?''改为绿色Nextsset.Delete?
''删除选择集End?Sub3.选择全部对象可以用select方法,参数为acSelectionSetAll。看例程,这个程序选择全
部对象,显示选中的对象,并计算对象数量。Sub?allsel()Dim?sel1?As?ACADSelectionSet?''定义选
择集对象Set?sel1?=?ThisDrawing.SelectionSets.Add("s")?''新建一个选择集Call?se
l1.Select(acSelectionSetAll)?''全部选中sel1.Highlight?(True)?’显示选择的对象s
co=?sel1.Count’计算选择集中的对象数量MsgBox?"选中对象数:"?&?CStr(sco)?''显示对话框End?S
ub4.更多的select方法：上面的例题已经运用了select方法,下面讲一下select的5种选择方式:1:择全部对象(acs
electionsetall)2.选择上次创建的对象(acselectionsetlast)3.选择上次选择的对象(acselec
tionsetprevious)4.选择矩形窗口内对象(acselectionsetwindow)5.选择矩形窗口内以及与边界相交
的对象(acselectionsetcrossing)看下面的例程代码，其中选择语句是:Call?sel1.Select(Mode
,?p1,?p2)’选择对象Mode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标Sub?seln
ew()Dim?sel1?As?ACADSelectionSet''定义选择集对象Dim?p1(0?To?2)?As?Double''
坐标1Dim?p2(0?To?2)?As?Double''坐标2p1(0)?=?0:?p1(1)?=?0:?p1(2)?=?0''设置
坐标1p2(0)?=?300:?p2(1)?=?300:?p2(2)?=?0''设置坐标1Mode?=?5''把选择模式存入mode变
量中Set?sel1?=?ThisDrawing.SelectionSets.Add("sel3")''新建一个选择集Call?se
l1.Select(Mode,?p1,?p2)''选择对象sel1.Highlight?(ture)''显示已选中的对象End?Sub
?思考题：1.假设一张图里有1堆大大小小的圆圈，找出半径小于10的圆，删掉第十课画多段线和样条线1.画二维多段线这样写：set
lobj=ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)只要一个
fitpoint参数，存放顶点坐标的数组2.画三维多段线这样写：Setlobj=ThisDrawing.ModelSpace
.Add3DPoly(fitpoint)Add3dpoly后面需一个参数，就是顶点坐标数组3.画二维样条线这样写：Setlobj
=ThisDrawing.ModelSpace.AddSpline(fitPoints,startT,endT)Addspl
ine后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。下面看例题。这个程序是第三课例程的改进版。原题是这样的
：绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。先分析一下编程细路：用动态数组存放多段线的所有顶点坐标，获得新坐标后
就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：Sub?myl()Dim?
p1?As?Variant?''声明端点坐标Dim?p2?As?VariantDim?l()?As?Double?''声明一个动态数组
Dim?templ?As?Objectp1?=?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
?''将第二点的端点保存为下一条直线的第一个端点坐标LoopErr_Control:End?Sub我们学一学动态数组，这是非常有用的
。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。这样定义数组：ReDim?l(0?To?2)?''定义动态数组赋值语句：l(0
)?=?p1(0)l(1)?=?p1(1)l(2)?=?z重新定义数组元素语句：?lub?=?UBound(l)?''获取当前l数组
中元的元素个数?ReDim?Preserve?l(lub?+?3)重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub
+3。给数值赋值的语句是一样的。再看画多段线语句：?Set?templ?=?ThisDrawing.ModelSpace.Add3
DPoly(l)?''画多段线在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ
变量，这样下面的删除语句就可以直接引用这个变量了。删除语句：?templ.Delete?''删除上次画的多段线因为已经知道对象是te
mpl，所以只要在对象后面用delete方法就可以了。下面的例程是把样条线转化为多段线（注：我最初编写这个教程时用的是CAD200
0，那个版本没有现成的转化方法）。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组
画多段线。Sub?sp2pl()Dim?getsp?As?Object?''获取样条线的变量Dim?newl?As?Object?''
新的多段线Dim?newlp()?As?Double?''多段线端点Dim?po()?As?Double?''获取点位Dim?p1?A
s?Variant?''获得拟合点点坐标ThisDrawing.Utility.GetEntity?getsp,?po,?"本程序将
样条曲线转为多段线。请选择样条曲线"sumctrl?=?getsp.NumberOfControlPoints?''计算样条线中一共
有多少拟合点ReDim?newlp(0?To?sumctrl??3?-?1)?''重定义数组For?i?=?0?To?sumctr
l?-?1?p1?=?getsp.GetControlPoint(i)?''把拟合点坐标存到p1变量中?For?j?=?0?To?2
?newlp(i??3?+?j)?=?p1(j)?Next?jNext?iSet?newl?=?ThisDrawing.Mode
lSpace.Add3DPoly(newlp)?''画多段线End?Sub下面的语句是让用户选择样条线：ThisDrawing.Ut
ility.GetEntity?getsp,?po,?"本程序将样条曲线转为多段线。请选择样条曲线"ThisDrawing.Uti
lity.GetEntity后面需要三个参数：第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，
第三个是一段字符串，显示在提示栏。AutoCADVBA没有现成的画闭合样条线方法，我们可以用Sendcommand方法间接画图语
法：ThisDrawing.Sendcommand命令字符串这个方法可以向CAD文档发送括号里的命令字符串。这串字符可以很长很长
，写这类程序的关键是要设计出正确的字符串。也许新手不知道怎么玩这个字符串，建议跟CAD命令窗口学。先在模型空间里画个简单点的图元，
然后按下F2键，那么这个命令行窗口里的内容就是应该最终出现在括号里的字符串。用Sendcommand方法可以完成大部分作图任务，它
能补充VBA的某些不足之处，但它的缺点是速度慢效率低，而且对于复杂问题，设计出正确的命令字符串不是想象中的那么简单。下面的代码用1
0个随机数拟合点画出闭合样条线Sub?newspl()Dim?splfitp(29)?As?Double?''此样条线含10个拟合点
Randomize?''初始化随机数种子For?i?=?0?To?29?Step?3?''坐标赋值为随机数?splfitp(i)?=?
Rnd?splfitp(i?+?1)?=?Rnd?splfitp(i?+?2)?=?RndNext?icommandstring?
=?commofspl(splfitp)?''用自定义函数获得命令字符串ThisDrawing.SendCommand?comman
dstring?''发送样条线命令字符串ZoomExtentsEnd?SubFunction?commofspl(csplfitpo
int()?As?Double)?As?Stringcommofspl?=?"spl"?&?vbCr?''样条线命令字符串For?i
?=?0?To?UBound(csplfitpoint)?-?1?Step?3?''坐标值加入字符串?commofspl?=?com
mofspl?&?csplfitpoint(i)?&?","?commofspl?=?commofspl?&?csplfitpoi
nt(i?+?1)?&?","?commofspl?=?commofspl?&?csplfitpoint(i?+?2)?&?vbC
rNext?icommofspl?=?commofspl?&?"c"?&?vbCr?''闭合End?Function这个例程里用到了
1个自定义函数：commofspl函数通常自定义函数是这样的格式Function?函数名(参数1?As?数据类型,参数2?As
?数据类型，……)?As?数据类型……End?Function必须有1个函数名，此例中commofspl就是函数名，注意不能跟VB
A内置函数重复，也不能用纯数字。自定义函数可以有参数，也可以不用参数，如果不用参数，函数名后加1个空的括号就可以了;如果参数多于
1个，则参数之间要用逗号分开。本例用了1个参数：csplfitpoint数组，通过一通计算，最后获得commofspl的返回值，这
就是程序需要的命令字符串。第一行里的AsDouble和AsString分别限定了参数和返回值的数据类型。有时候数据类型也可以
省略不写，简化代码。下面这条语句调用了这个自定义函数，并把返回值赋予commandstring变量commandstring?=?
commofspl(splfitp)?''用自定义函数获得命令字符串这个程序还有1个难点在变量commofspl值的变化。在此我不想
多解释，建议在合适的位置给程序多设置几个断点，查看一下cspl变量后继续，运行完成后按F2看一下命令窗口发生的变化。思考题:1.用
多段线画红色五角星，其外接圆的圆心为原点，半径为10下图为画法提示：2.用Sendcommand方法画100个同心圆第十一课动画
基础说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的
竞争实力，想象一下您用ACAD动画向老板演示零件的装配方法……移动方法:move语法：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?mov
y?As?Variant?''y轴增量Dim?getobj?As?Object?''移动对象Dim?movtimes?As?Integ
er?''移动次数ThisDrawing.Utility.GetEntity?getobj,?po,?"请选择移动对象"p0?=?T
hisDrawing.Utility.GetPoint(,?"起点:")p1?=?ThisDrawing.Utility.GetP
oint(p0,?"终点:")pe?=?p0pc?=?p0motimes?=?300movx?=?(p1(0)?-?p0(0))?
/?motimesmovy?=?(p1(1)?-?p0(1))?/?motimesFor?i?=?1?To?motimes?pe(
0)?=?pc(0)?+?movx?pe(1)?=?pc(1)?+?movygetobj.Move?pc,?pe?''移动一段get
obj.Update?''更新对象NextEnd?Sub先让用户选择移动的对象、起点、终点，motimes是设置动画帧数，这个例程是
让对象移动300小段，movx和movy是每一段移动的距离，然后进行一个300次的循环，每一次循环移动一小段距离。看第2个例题：做
一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹。编程思路：先画好圆和横轴，然后画山坡，偏移
获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。旋转方法：object.rotate基点,角度
偏移方法：object.offset(偏移量)Sub?moveball()Dim?ccball?As?Variant?''圆Dim
?ccline?As?Variant?''圆轴Dim?cclinep1(0?To?2)?As?Double?''圆轴端点1Dim?cc
linep2(0?To?2)?As?Double?''圆轴端点2Dim?cc(0?To?2)?As?Double?''圆心Dim?hi
ll?As?Variant?''山坡线Dim?moveline?As?Variant?''移动轨迹线Dim?lay1?As?ACADL
ayer?''放轨迹线的隐藏图层Dim?vpoints?As?Variant?''轨迹点Dim?movep(0?To?2)?As?Do
uble?''移动目标点坐标cclinep1(0)?=?-0.1:?cclinep2(0)?=?0.1?''定义圆轴坐标Set?ccl
ine?=?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.1415926535897?/?360?''横坐标?p(i?+?1)?=?Sin(p(i))?''纵坐标Nex
t?iSet?hill?=?ThisDrawing.ModelSpace.AddLightWeightPolyline(p)?''画
正弦线即山坡曲线hill.Update?''显示山坡线moveline?=?hill.Offset(-0.1)?''球心运动轨迹线vp
oints?=?moveline(0).Coordinates?''获得规迹点Set?lay1?=?ThisDrawing.Laye
rs.Add("hidelay")?''创建名为"hidelay"的图层lay1.LayerOn?=?False?''关闭图层move
line(0).Layer?=?"hidelay"?''将轨迹线放到关闭的图层中ZoomExtents?''显示整个图形For?i?=
?0?To?UBound(vpoints)?-?1?Step?2?movep(0)?=?vpoints(i)?''计算移动的轨迹?m
ovep(1)?=?vpoints(i?+?1)?ccline.Rotate?cc,?-0.05?''旋转直线?ccline.Mov
e?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?iEnd?Su
b下面的代码用开关图层的原理获得动画效果1.画出30个彩色圆，每个圆放在1个新建图层中，关闭这个图层2.进行30次循环，依次打开1
个图层3.再来30次循环，依次关闭1个图层4.回到第2步，共重复5次，最后1次不再关闭图层Private?Declare?PtrS
afe?Sub?Sleep?Lib?"kernel32"?(ByVal?dwMilliseconds?As?Integer)?''调
用API函数Sub?greenwave()Dim?cc(0?To?2)?As?DoubleDim?c(1?To?30)?As?Ac
adCircleDim?movelay(1?To?30)?As?AcadLayerDim?newlayname(1?To?30)F
or?i?=?1?To?30?''开始循环?newlayname(i)?=?"newlay"?&?i?Set?movelay(i)?
=?ThisDrawing.Layers.Add(newlayname(i))?movelay(i).LayerOn?=?Fals
e?''关闭图层?Set?c(i)?=?ThisDrawing.ModelSpace.AddCircle(cc,?i??10)?''
画圆?c(i).Layer?=?newlayname(i)?c(i).color?=?i?+?59Next?iZoomExtent
s?''显示整个图形For?j?=?1?To?5?For?i?=?1?To?30?movelay(i).LayerOn?=?True
?Sleep?(5)?''暂停5ms?c(i).Update?Next?i?If?j?=?5?Then?Exit?For?''最后1次
显示图层后立即退出循环?For?i?=?30?To?1?Step?-1?movelay(i).LayerOn?=?False?Sl
eep?(5)?c(i).Update?Next?iNext?jEnd?Sub这个程序用到了1个API函数:sleep,在Sub前
先调用这个函数Private?Declare?PtrSafe?Sub?Sleep?Lib?"kernel32"?(ByVal?dw
Milliseconds?As?Integer)?''调用API函数注意这行第3个单词“PtrSafe”，它是64位操作系统属性，如
果您的Windows系统低于64位，请删除它。在图层变化后暂停5毫秒，用这条语句：?Sleep?(5)?''暂停如果需要改变动画效果
的速度，请把这个毫秒值改成你想要的数字。思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，
尺寸自定。?第十二课参数化设计基础简单讲，参数化设计就是根据参数进行精确绘图，所需要的参数可以由用户手工输入。真正的参数化设计往
往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。本课的例程是画一个标准足球场。足球场长度90～120米，宽度
45～90米，下图红色标注的尺寸是默认值，绿色标注固定不变。Sub?court()Dim?courtlay?As?AcadLaye
r?''球场图层Dim?ent?As?AcadEntity?''镜像对象Dim?linep1(0?To?2)?As?Double?''线
条端点1Dim?linep2(0?To?2)?As?Double?''线条端点2Dim?linep3(0?To?2)?As?Doub
le?''罚球弧端点1Dim?linep4(0?To?2)?As?Double?''罚球弧端点2Dim?centerp?As?Vari
ant?''中心坐标xjq?=?11000?''小禁区尺寸djq?=?33000?''大禁区尺寸fqd?=?11000?''罚球点位置fq
r?=?9150?''罚球弧半径fqh?=?14634.98?''罚球弧弦长jqqr?=?1000?''角球区半径zqr?=?9150?
''中圈半径On?Error?Resume?Nextchang?=?ThisDrawing.Utility.GetReal("长度(
90000～120000)<105000>")If?Err.Number?<>?0?Then?''用户输入的不是有效数字?chang
?=?105000?Err.Clear?''清除错误End?Ifkuan?=?ThisDrawing.Utility.GetReal
("宽度(45000～90000)<68000>")If?Err.Number?<>?0?Then?kuan?=?68000End
?Ifcenterp?=?ThisDrawing.Utility.GetPoint(,?"定位球场中心:")Set?courtla
y?=?ThisDrawing.Layers.Add("足球场")?''设置图层ThisDrawing.ActiveLayer?=?
courtlay?''把当前图层设为足球场图层''画小禁区linep1(0)?=?centerp(0)?+?chang?/?2line
p1(1)?=?centerp(1)?+?xjq?/?2linep2(0)?=?centerp(0)?+?chang?/?2?-?
xjq?/?2linep2(1)?=?centerp(1)?-?xjq?/?2Call?drawbox(linep1,?linep
2)?''调用画矩形子程序''画大禁区linep1(0)?=?centerp(0)?+?chang?/?2linep1(1)?=?ce
nterp(1)?+?djq?/?2linep2(0)?=?centerp(0)?+?chang?/?2?-?djq?/?2lin
ep2(1)?=?centerp(1)?-?djq?/?2Call?drawbox(linep1,?linep2)''?画罚球点li
nep1(0)?=?centerp(0)?+?chang?/?2?-?fqdlinep1(1)?=?centerp(1)Call?
ThisDrawing.ModelSpace.AddPoint(linep1)''ThisDrawing.SetVariable?"
PDMODE",?32?''点样式ThisDrawing.SetVariable?"PDSIZE",?30?''点的尺寸''画罚球弧，罚
球弧圆心就是罚球点linep1linep3(0)?=?centerp(0)?+?chang?/?2?-?djq?/?2linep3
(1)?=?centerp(1)?+?fqh?/?2linep4(0)?=?linep3(0)?''两个端点的x轴相同linep4(
1)?=?centerp(1)?-?fqh?/?2ang1?=?ThisDrawing.Utility.AngleFromXAxi
s(linep1,?linep3)?''计算角度ang2?=?ThisDrawing.Utility.AngleFromXAxis(
linep1,?linep4)Call?ThisDrawing.ModelSpace.AddArc(linep1,?zqr,?an
g1,?ang2)?''画弧''角球弧ang1?=?ThisDrawing.Utility.AngleToReal(90,?0)?''角
度转换为弧度ang2?=?ThisDrawing.Utility.AngleToReal(180,?0)linep1(0)?=?c
enterp(0)?+?chang?/?2?''角球弧圆心linep1(1)?=?centerp(1)?-?kuan?/?2Call
?ThisDrawing.ModelSpace.AddArc(linep1,?jqqr,?ang1,?ang2)?''画弧ang1?
=?ThisDrawing.Utility.AngleToReal(270,?0)linep1(1)?=?centerp(1)?+
?kuan?/?2Call?ThisDrawing.ModelSpace.AddArc(linep1,?jqqr,?ang2,?a
ng1)''镜像轴linep1(0)?=?centerp(0)linep1(1)?=?centerp(1)?-?kuan?/?2li
nep2(0)?=?centerp(0)linep2(1)?=?centerp(1)?+?kuan?/?2''镜像If?ThisDr
awing.GetVariable("MIRRTEXT")?=?1?Then?ThisDrawing.SetVariable?"M
IRRTEXT",?0End?IfFor?Each?ent?In?ThisDrawing.ModelSpace?''所有模型空间的对
象进行一次循环?If?ent.Layer?=?"足球场"?Then?''对象在"足球场"图层中?ent.Mirror?linep1,
?linep2?''镜像?End?IfNext?ent''画中线Call?ThisDrawing.ModelSpace.AddLine
(linep1,?linep2)''画中圈Call?ThisDrawing.ModelSpace.AddCircle(centerp
,?zqr)''画外框linep1(0)?=?centerp(0)?-?chang?/?2linep1(1)?=?centerp(1
)?-?kuan?/?2linep2(0)?=?centerp(0)?+?chang?/?2linep2(1)?=?centerp
(1)?+?kuan?/?2Call?drawbox(linep1,?linep2)ZoomExtents?''显示整个图形End?
SubPrivate?Sub?drawbox(p1,?p2)?''根据对角线坐标画矩形的子程序Dim?boxp(0?To?7)?As
?Doubleboxp(0)?=?p1(0):boxp(1)?=?p1(1)boxp(2)?=?p1(0):boxp(3)?=?p
2(1)boxp(4)?=?p2(0):boxp(5)?=?p2(1)boxp(6)?=?p2(0):boxp(7)?=?p1(1
)Dim?tempobj?As?ObjectSet?tempobj?=?ThisDrawing.ModelSpace.AddLig
htWeightPolyline(boxp)tempobj.Closed?=?True?''闭合多段线End?Sub?下面开始分析源
码：On?Error?Resume?Nextchang?=?ThisDrawing.Utility.GetReal("长度(900
00～?120000)<105000>")If?Err.Number?<>?0?Then?''用户输入的不是有效数字?chang?=
?105000?Err.Clear?''清除错误End?If这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能
输入数字，如果输入其他字符程序就会报错，所以先要去掉错误提示On?Error?Resume?Next虽然错误不再提示，但是出错代码
err.number值会改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，
这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。在画小禁区的最后一行这样写：Call?drawbox(li
nep1,?linep2)?''调用画矩形子程序Drawbox并不是AutoCAD提供的方法，它是一个带参数的自定义子程序。由于画足
球场要画好几次矩形，而VBA没有提供一个现成的对角线画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这段代码写到一个
子程序中，在需要时只有写一条调用语句就行了。这个子程序在最后几行：Private?Sub?drawbox(p1,?p2)?''根据对
角线坐标画矩形的子程序……End?Subp1,p2是参数，调用时也必须写两个参数：linep1、linep2，这里就是对角线坐标。
请注意，在调用子程序时参数的数据类型不能用错。本例题中，p1和p2参数必须都是含点坐标值的数组。?ang1?=?ThisDrawi
ng.Utility.AngleFromXAxis(linep1,?linep3)?''计算角度ang2?=?ThisDrawing
.Utility.AngleFromXAxis(linep1,?linep4)这2行用了AngleFromXAxis方法计算直线与
X轴的夹角，括号中的参数就是直线2个端点Call?ThisDrawing.ModelSpace.AddArc(linep1,?zq
r,?ang1,?ang2)?''画弧画圆弧用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度下面看镜像操作：If?T
hisDrawing.GetVariable("MIRRTEXT")?=?1?Then?ThisDrawing.SetVariab
le?"MIRRTEXT",?0End?IfMIRRTEXT是CAD的系统变量，控制镜像命令是否需要保留源对象。重点学习2个方法：
读取和设置系统变量系统值读取系统变量:ThisDrawing.GetVariable(变量名)设置系统变量:ThisDrawi
ng.SetVariable变量名,新的变量值本例中，如果MIRRTEXT=1，则改为0For?Each?ent?In?Thi
sDrawing.ModelSpace?''所有模型空间的对象进行一次循环?If?ent.Layer?=?"足球场"?Then?''对
象在"足球场"图层中?ent.Mirror?linep1,?linep2?''镜像?End?IfNext?ent本例对“足球场”图层
中的对象进行镜像，所以要在图层里全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。镜像方法：Mirro
r只能用2点坐标为镜像轴语法：Object.Mirror(第1点,第2点)本课思考题：设计一张简单的平面图，用户输入2个参数，其他
尺寸写进程序中??第十三课块操作1.定义块方法：Setblocksobj=ThisDrawing.Blocks.Add(基点,
块名)2.把选择集加入块中的方法：ThisDrawing.CopyObjects(选择集,块)3.插入块方法：4.ThisDra
wing.ModelSpace.InsertBlock(插入点,块名,X轴比例,Y轴比例,Z轴比例,旋转角度)画块属性方法：
5.ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符,插入点,显示字符,默认值
)一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式?下面的例题是利用属性块画
足球场的阵型图。程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一
课内容。编程思路：1.如果块已经存在，跳到第6步2．新建一个空块3．在块中画一段弧（球服衣领）4．画多段线，镜像画出球衣5．画块属
性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归
零，所以不得不再次更改对齐点属性6．把多段线和属性复制到块中7．提示用户点选球员位置和姓名8．插入11个球员块，修改球衣号码属性、
球员姓名属性以下是源码，附有详细的注释。Option?ExplicitSub?team()Dim?playerlay?As?Aca
dLayer?''球员图层Dim?playerblock?As?AcadBlock?''块变量Dim?arcc(0?To?2)?As?
Double?''圆弧圆心Dim?line1?As?Object?''线条儿1Dim?line2?As?Object?''线条儿2Dim
?linep1(0?To?2)?As?Double?''线条端点1Dim?linep2(0?To?2)?As?Double?''线条端
点2Dim?pline(0?To?20)?As?Double?''队服右侧多段线7个顶点Dim?basep(0?To?2)?As?D
ouble?''块基点Dim?playernumberpoint(0?To?2)?As?Double?''块属性插入点Dim?p1?A
s?Variant?''块插入点位置Dim?mytxt?As?AcadTextStyle?''文本样式Dim?blockRef?As?
AcadBlockReference?''块属性变量Dim?Attr1?As?Variant?''插入块属性变量1Dim?Attr2?
As?Variant?''插入块属性变量2Dim?Attr3?As?Variant?''获取属性变量Dim?element?As?Va
riant?''选择集遍历对象Dim?pstring?As?String?''定点提示词Dim?nstring?As?String?''
球员名Dim?i,?i1i1?=?1?''起始号码For?i?=?0?To?ThisDrawing.Blocks.Count?-?1
?''查找旧块?Set?playerblock?=?ThisDrawing.Blocks.Item(i)?If?playerbloc
k.Name?=?"球员"?Then?GoTo?insblock?''球员块已存在，跳转到插入快Next?iSet?playerbl
ock?=?ThisDrawing.Blocks.Add(basep,?"球员")?''新建一个"球员"块arcc(0)?=?0:?
arcc(1)?=?430Call?playerblock.AddArc(arcc,?50,?ThisDrawing.Utilit
y.AngleToReal(180,?0),?0)?''画弧并加入块中pline(0)?=?0:?pline(1)?=?20''多段线
坐标pline(3)?=?100:?pline(4)?=?20pline(6)?=?100:?pline(7)?=?250plin
e(9)?=?125:?pline(10)?=?207pline(12)?=?212:?pline(13)?=?257pline(
15)?=?112:?pline(16)?=?430pline(18)?=?50:?pline(19)?=?430Set?line
1?=?ThisDrawing.ModelSpace.AddPolyline(pline)?''画队服右侧多段线linep2(1)?
=?1?''镜像轴第二点位于Y轴上任一点Set?line2?=?line1.Mirror(linep1,?linep2)?''镜像获得
另一半多段线Dim?p(0?To?2)?As?Double?''定义坐标变量Set?mytxt?=?ThisDrawing.Text
Styles.Add("mytxt")?''添加mytxt样式mytxt.fontFile?=?"c:\windows\fonts\
simfang.ttf"?''设置字体文件为仿宋体ThisDrawing.ActiveTextStyle?=?mytxt?''将当前文
字样式设置为mytxtplayernumberpoint(0)?=?0?''块属性位置playernumberpoint(1)?=?
200Set?Attr1?=?ThisDrawing.ModelSpace.AddAttribute(100,?acAttribu
teModeNormal,?"号码",?playernumberpoint,?"X",?0)?''画块属性Attr1.Alignme
nt?=?7?''居中Attr1.TextAlignmentPoint?=?playernumberpoint?''重定义对齐点Set
?Attr2?=?ThisDrawing.ModelSpace.AddAttribute(100,?acAttributeMode
Normal,?"姓名",?playernumberpoint,?"???",?0)?''画块属性Attr2.Alignment?=
?7?''居中Dim?objCollection(0?To?3)?As?Object?''创建选择集Set?objCollection
(0)?=?line1?''线条1加入选择集Set?objCollection(1)?=?line2?''线条2加入选择集Set?ob
jCollection(2)?=?Attr1?''属性1加入选择集Set?objCollection(3)?=?Attr2?''属性2
加入选择集Call?ThisDrawing.CopyObjects(objCollection,?playerblock)?''把选
择集加入块中For?Each?element?In?objCollection?''在选择集中进行循环?element.Delete
?''删除线条和属性(此操作并不影响已创建的块)NextSet?playerlay?=?ThisDrawing.Layers.Add
("球员")?''新建图层playerlay.color?=?2?''为黄色ThisDrawing.ActiveLayer?=?pla
yerlay?''将当前图层设置为球员图层''插入块insblock:On?Error?Resume?NextFor?i?=?i1?T
o?i1?+?11?pstring?=?CStr(i)?&?"号球员位置："?p1?=?ThisDrawing.Utility.G
etPoint(,?pstring)?''点选球员位置坐标?If?Err.Number?<>?0?Then?''如果输入有误，退出?E
rr.Clear?Exit?For?End?If?nstring?=?ThisDrawing.Utility.GetString(
30,?"球员姓名：")?Set?blockRef?=?ThisDrawing.ModelSpace.InsertBlock(p1
,?"球员",?1,?1,?1,?0)?''插入块?Attr3?=?blockRef.GetAttributes?''获取块属性?At
tr3(0).TextString?=?CStr(i)?''赋值球员号码?Attr3(1).TextString?=?nstring
?''赋值球员姓名Next?iEnd?Sub用这条语句遍历CAD文档中所有的块For?i?=?0?To?ThisDrawing.Bl
ocks.Count?-?1?''查找旧块?……NextiThisDrawing.Blocks是图形中所有块的集合集合里的对象就是
ThisDrawing.Blocks.Item(0)、ThisDrawing.Blocks.Item(1)……ThisDrawin
g.Blocks.Count是块集合的属性，获取集合或选择集中各项目的数量思考题：画一个简易路灯块，用属性块做为路灯编号，由用户点
选路灯位置，程序画路灯时自动为路灯编号第十四课读写Excel表格ACAD是优秀的画图软件，但是它的数据处理能力不够，工作中可以
用vba来读写Excel表。首先在ACADVBA编辑器菜单中点选“工具”—“引用”，然后在“引用”对话框中找到“Microsof
tExcel…”勾选确定。(如下图)如果您找不到MicrosoftExcel，那么可能您的Office没有安装VBA模块，据我
所知，很多精简版的office把它简掉了，因为大多数用户不考不学，也不用。有的朋友看上去正常引用了库文件，但仍然无法正常运行本课
例程，经本人查证，还是Excel的库文件有问题。我们在前面的课程中已经画了足球阵型图，下面的例程是把这个阵型图中的信息保存在Exc
el文件中。已有图块的名称是“球员”，他的两个属性值是“球员”、“号码”，在Excel表里，每一个球员的信息占用一行四列，1:球员
号码，2:球员姓名，3-4:坐标编程思路：先定义应用程序变量和工作表变量，然后激活Excel，再创建工作薄，提取块属性，在表格中
填写文字，最后保存退出。Sub?writeexcel()Dim?excelapp?As?Excel.Application?''定义
excle应用程序变量Dim?excelsheet?As?worksheet?''定义工作表变量Set?excelapp?=?Cre
ateObject("excel.application")??''激活excel程序excelapp.Workbooks.Add?
''创建新工作薄Set?excelsheet?=?excelapp.ActiveWorkbook.Sheets("sheet1")?
''当前工作表为sheet1yline?=?1?''写入行位置For?Each?ent?In?ThisDrawing.ModelSpa
ce?''在模型空间里循环?obname?=?ent.ObjectName?''提取对象类型?If?obname?=?"AcDbBlo
ckReference"?Then?''判断对象是否为块?xy?=?ent.InsertionPoint?''获取插入点坐标?vara
ttr?=?ent.GetAttributes?''?将属性标记和值复制到varattr变量?attrtxt0?=?varattr(
0).TextString?''属性值?attrtxt1?=?varattr(1).TextString??excelsheet.C
ells(yline,?1).Value?=?attrtxt0?''写入excle文件?excelsheet.Cells(yline
,?2).Value?=?attrtxt1?excelsheet.Cells(yline,?3).Value?=?xy(0)?ex
celsheet.Cells(yline,?4).Value?=?xy(1)?yline?=?yline?+?1?''位置加一行?E
nd?IfNextexcelsheet.SaveAs?"球员.xlsx"?''保存，文件名是"球员.xlsx"excelapp.Qu
it?''退出excel程序Set?excelapp?=?Nothing?''释放变量Set?excelsheet?=?Nothing
End?Sub?第2个例程是读取Excel表格，将Excel表中的数据导入dwg文件中。Sub?readxcel()Dim?blo
ckRef?As?ACADBlockReference?''定义块属性变量Dim?p(0?To?2)?As?Double?''插入点D
im?excelapp?As?Excel.Application?''定义excle应用程序变量Dim?excelsheet?As?
worksheet?''定义工作表变量Set?excelapp?=?CreateObject("excel.application"
)??''激活excel程序excelapp.Workbooks.Open?("球员.xlsx")?''打开工作薄Set?excels
heet?=?excelapp.ActiveWorkbook.Sheets("sheet1")?''当前工作表为sheet1coro
w?=?excelsheet.UsedRange.Rows.Count?''计算工作表的总行数For?i?=?1?To?corow?
attrtxt0?=?excelsheet.Cells(i,?1).Value?''属性1?attrtxt1?=?excelshee
t.Cells(i,?2).Value?''属性2?p(0)?=?excelsheet.Cells(i,?3).Value?''插入点
坐标?p(1)?=?excelsheet.Cells(i,?4).Value?Set?blockRef?=?ThisDrawing
.ModelSpace.InsertBlock(p,?"球员",?1,?1,?1,?0)?''插入块?Attr3?=?blockRe
f.GetAttributes?''获取块属性?Attr3(0).TextString?=?attrtxt0?''赋值球员号码?Att
r3(1).TextString?=?attrtxt1?''赋值球员姓名Next?iexcelapp.Quit?''退出excel程序
Set?excelapp?=?Nothing?''释放变量Set?excelsheet?=?NothingEnd?Sub虽然我不厌其
烦地把注释都写在源码中了，但是对初学者来讲，可能有些部分还是不好理解，涉及ExcelVBA，本课不便详细讲解，如果您看不懂，请参
阅ExcelVBA的帮助文件慢慢研究。再写1个例题：把第9课例程中画出的300个圈圈儿坐标、半径、颜色值存入1个新建的excel
表格Sub?writeballstoexcel()Dim?excelapp?As?Excel.ApplicationDim?exc
elsheet?As?worksheetDim?cc?As?VariantSet?excelapp?=?CreateObject(
"excel.application")excelapp.Workbooks.AddSet?excelsheet?=?excela
pp.ActiveWorkbook.Sheets("sheet1")yline?=?1For?Each?ent?In?ThisDr
awing.ModelSpace?cc?=?ent.Center?cr?=?ent.Radius?co?=?ent.color?e
xcelsheet.Cells(yline,?1).Value?=?cc(0)?excelsheet.Cells(yline,?2
).Value?=?cc(1)?excelsheet.Cells(yline,?3).Value?=?cr?excelsheet.
Cells(yline,?4).Value?=?co?yline?=?yline?+?1?''位置加一行Nextexcelsheet
.SaveAs?"圈圈.xlsx"excelapp.QuitSet?excelapp?=?NothingSet?excelshee
t?=?NothingEnd?Sub思考题：根据“圈圈.xlsx”文件中记录的数据画出圆圈第十五课创建CAD表格1.创建表格用A
ddTable方法语法：object.AddTable(InsertionPoint,NumRows,NumColumns,
RowHeight,ColWidth)其中有5个参数，咱们一个一个来1.InsertionPoint:插入表格左上角坐标2.Nu
mRows=行数（从0开始计数）3.NumColumns=列数（从0开始计数）4.RowHeight=行高5.ColWidth
=列宽2.填表用SetText方法语法：object.SetText(第几行,第几列,文字内容)注意表格中所有的行和列的起始数都
是03.修改表格文字方向用SetTextRotation方法object.SetTextRotation(第几行,第几列,方向
常数)其中方向参数可以填以下四种选项：acDegrees000acDegrees090acDegrees180acDegr
ees2704.合并单元格用MergeCells方法语法：object.MergeCells(起始行数,最后行数,起始列数,最后
列数)5.读取表格内容用GetText方法语法：object.GetText(第几行,第几列)6.表格列数Columns属性语
法：object.Columns7.表格行数Rows属性语法：object.Rows8.每列宽度ColumnWidth语法：o
bject.ColumnWidth9.每列行高RowHeight语法：object.RowHeight下面的实例创建1张表格，分类
统计本教程第9课画的300个圈圈儿大小，注意运行这个程序之前必须先画出圈圈，不然没数据就白忙乎了。Sub?countcircle(
)Dim?allobj?As?AcadSelectionSet?''定义选择集对象Dim?countr(1?To?4)?As?Int
eger?''此数组存放4种规格数量Dim?MyTable?As?AcadTable?''定义表格Dim?pt1(2)?As?Doub
le?''表格插入点Dim?pt2(2)?As?Double?''表格右下角坐标Dim?sizetxt(1?To?4)?As?Stri
ng?''定义标题文字Set?allobj?=?ThisDrawing.SelectionSets.Add(CStr(Now()))
?''新建一个选择集Call?allobj.Select(acSelectionSetAll)?''选中全部图元objnum?=?al
lobj.Count?''计算选择集中的图元数sumball?=?0?''合计For?i?=?0?To?objnum?-?1?objn
ame?=?allobj(i).ObjectName?''获取当前图元名称?If?objname?=?"AcDbCircle"?Th
en?''确认这货是圆圈儿?r?=?allobj(i).Radius??''获取半径值?circlesize?=?Rsize(r)?''
调用自定函数计算规格?countr(circlesize)?=?countr(circlesize)?+?1?''规格数量+1?En
d?IfNext?ipt1(0)?=?2000?''左上角坐标pt1(1)?=?-50Set?MyTable?=?ThisDrawi
ng.ModelSpace.AddTable(pt1,?7,?3,?100,?300)Call?MyTable.SetColumn
Width(0,?70)?''修改第1列宽度Call?MyTable.SetAlignment(1,?acMiddleCenter)
?''居中对齐For?i?=?1?To?6?For?j?=?0?To?2?Call?MyTable.SetCellTextHeigh
t(i,?j,?20)?''修改表内文字高度?Next?jNext?i''写入标题栏Call?MyTable.SetText(0,?0
,?"尺寸统计表")Call?MyTable.SetCellTextHeight(0,?0,?30)Call?MyTable.Se
tText(1,?0,?"序号")Call?MyTable.SetText(1,?1,?"规格")Call?MyTable.Set
Text(1,?2,?"数量")Call?MyTable.SetText(6,?0,?"合计")sizetxt(1)?=?"小号（
<5）"sizetxt(2)?=?"中号(5-15)"sizetxt(3)?=?"大号(15-25)"sizetxt(4)?=?"
特大号(>25)"For?i?=?1?To?4?''写入表格数据?Call?MyTable.SetText(i?+?1,?0,?i)
?''写序号?Call?MyTable.SetText(i?+?1,?1,?sizetxt(i))?''写规格?Call?MyTabl
e.SetText(i?+?1,?2,?countr(i))?''写数量Next?iFor?i?=?2?To?5?sumball?=
?sumball?+?MyTable.GetText(i,?2)?''合计Next?iCall?MyTable.MergeCells
(6,?6,?0,?1)?''合并单元格Call?MyTable.SetText(6,?2,?sumball)pt2(0)?=?pt
1(0)?+?MyTable.Width?''表格宽度pt2(1)?=?pt1(1)?-?MyTable.Height?''表格高度Z
oomWindow?pt1,?pt2?''窗口绽放，以表格尺寸为准ZoomScaled?0.8,?acZoomScaledRelat
ive?''显示80%比例End?SubFunction?Rsize(r?As?Variant)?As?Integer?''计算型号R
size?=?1?''小If?r?>?5?Then?Rsize?=?2?''中If?r?>?15?Then?Rsize?=?3?''大I
f?r?>?25?Then?Rsize?=?4?''特大End?Function本例最后要视图缩放到显示表格，用窗口缩放的方法：Zo
omWindow语法：ZoomWindow左下角点，右上角点比例缩放方法：ZoomScaled语法：ZoomScaled缩放
比例,缩放类型缩放类型它有3种：acZoomScaledAbsolute：相对于图形界限acZoomScaledRelativ
e：相对于当前视口acZoomScaledRelativePSpace：相对于图纸空间以中心点缩放用ZoomCenter方法语法：
ZoomCenter中心点,倍数缩放到最近使用过的缩放视图用ZoomPrevious方法语法：ZoomPrevious这个方
法不需要参数，这条语句每运行1次，缩放视图就会往前推1次，不过Autocad最多只能保留最近10个缩放视图。如果不需要读取表格中的
数据，那么创建CAD表格还可以用简单粗暴的解决方案：直接划线。通常有2种画法：阵列直线、计算坐标。下面的代码给第7课例题99乘法表
划线，由于表格线长度不同，所以选用计算坐标法。Sub?table99()Dim?mytxt?As?Object?''文字Dim?tx
tp(2)?As?Double?''文字位置坐标xstep?=?30?''列间距ystep?=?10?''行间距txtp(0)?=?0?
''起始点横坐标txtp(1)?=?85?''起始点纵坐标For?i?=?1?To?9?For?j?=?1?To?9?txt?=?j?
&?"×"?&?i?&?"="?&?i??j?''文字内容?If?i?>=?j?Then?Set?mytxt?=?ThisDraw
ing.ModelSpace.AddMText(txtp,?25,?txt)?''写文字?mytxt.Height?=?4.5?''改
变文字大小?mytxt.color?=?3?''绿色?End?If?txtp(0)?=?txtp(0)?+?xstep?''计算下1列
的横坐标?Next?j?txtp(0)?=?0?''横坐标回到第1列?txtp(1)?=?txtp(1)?-?ystep?''纵坐标向
下移动1行Next?iCall?drawlines?''划表格线ZoomExtentsEnd?SubFunction?drawlin
es()Dim?p0(2)?As?Double,?p1(2)?As?Double,?p2(2)?As?Doublep0(0)?=?
-4.3:?p0(1)?=?98?''原点坐标xspace?=?30:?yspace?=?10?''表格间距For?i?=?1?To?
9?''画9根横线?p1(0)?=?p0(0)?p1(1)?=?p0(1)?-?yspace??i?p2(0)?=?p1(0)?+
?xspace??i?p2(1)?=?p1(1)?Call?ThisDrawing.ModelSpace.AddLine(p1,
?p2)?''横线Next?ip1(1)?=?p1(1)?-?yspacep2(1)?=?p1(1)Set?temp?=?ThisD
rawing.ModelSpace.AddLine(p1,?p2)?''最后1根横线p1(0)?=?p0(0):?p1(1)?=?p
0(1)?-?yspacep2(0)?=?p1(0):?p2(1)?=?p1(1)?-?yspace??9Call?ThisDr
awing.ModelSpace.AddLine(p1,?p2)?''第1根竖线For?i?=?1?To?9?''画9根竖线?p1(0
)?=?p0(0)?+?xspace??i?p1(1)?=?p0(1)?-?yspace??i?p2(0)?=?p1(0)?c
allThisDrawing.ModelSpace.AddLine(p1,?p2)?''竖线Next?iEnd?Function
思考题：1.参考本课例程画颜色统计表，统计红黄绿(色号分别为1，2，3)等3种颜色圈圈第十六课各种修改先回顾一下前面用过的修改方
法1.移动move语法：object.move起点坐标,端点坐标2.旋转rotate语法：object.rotate基点,
角度3.偏移offset语法：object.offset(偏移量)4.镜像：Mirror语法：Object.Mirror(第1点
,第2点)5.删除：Delete语法：object.Delete再介绍几个比较常用的修改图元方法1.缩放对象ScaleEntity
语法：object.ScaleEntity基点坐标,倍率2.矩形阵列ArrayRectangular语法：retval=ob
ject.ArrayRectangular(行数,列数,层数,行间距,列间距,层间距)Retval要声明为变体数组，存放所有
阵列后产生的对象。3.环形阵列语法：retval=object.line1.ArrayPolar(阵列个数,环形角度,环形中
心)与CAD正常操作不一样，这里的陈列个数参数含原始对象环形角度是非零数，正逆时转，负值顺时针旋转4.复制Copy语法：obje
ct.copy5.创建RGB颜色对象GetInterfaceObject语法：Setcoloroobject=AcadAppl
ication.GetInterfaceObject("AutoCAD.AcCmColor."&Left(AcadApplic
ation.Version,2))注意括号里面的单词是不可修改参数，使用时不要改，复制等号后面的全部单词即可。修改颜色用SetR
GB属性修改颜色对象的颜色属性：colorobject.SetRGB(红色,绿色,蓝色)这里的colorobject是指用GetI
nterfaceObject方法创建出来的颜色对象三种颜色参数是0-255之间的整数给对象修改RGB颜色这样写:object.T
rueColor=colorobject前面的Object是用CAD画出来的对象，比如圆，线，弧等等6.修剪和延伸很可惜，Au
toCADVBA没有现成的修剪和延伸方法，我们可以用VBA算法来解决问题：先获得交点，然后用重新构建图元来模拟修剪和延伸。获取对
象交点方法：IntersectWith,语法：retval=object.IntersectWith(输入对象,扩展选项)Ob
ject和输入对象可以是圆、弧、直线、多段线等等各种图元扩展选项有4种：选项含义acExtendNone两个对象均不延伸。acEx
tendThisEntity延伸object对象。acExtendOtherEntity延伸输入对象。acExtendBoth两个
对象都延伸。这个方法把计算出的交点坐标存入retval数组，判断有没有交点这样写：If?UBound(retval)?<>?-1?
Then?…………''有交点下面的例程演示一些修改方法,它干了这些活1.画30个同心圆2.给每个圆换不同的RGB颜色，形成渐变效果
3.随机方向画1条线4.环形阵列为3根线条5.延长其中1根线条6.第2条线缩放到0.5倍7.剪切夹在2条线里的圆，根据编号的奇偶
性保留方向相反的1段弧8.删除多余的1根线Sub?modifytest()Dim?mycircle(29)?As?AcadCirc
leDim?cc(0?To?2)?As?Double?''圆心坐标Dim?line1?As?AcadLine?''线条儿Dim?lin
ep1(2)?As?Double,?linep2(2)?As?Double?''线条端点Dim?p1?As?Variant?''声明端
点坐标Dim?p2?As?VariantFor?i?=?0?To?29?Set?mycircle(i)?=?ThisDrawing
.ModelSpace.AddCircle(cc,?(i?+?1)??10)?''画圆Next?iZoomExtents?''显示整
个图形Call?ThisDrawing.Utility.GetPoint(,?"30个圆已画好，点击任意位置变色")Dim?new
color?As?AcadAcCmColor?''颜色对象Dim?greencolor?As?Integer?''RGB色彩中绿色值D
im?bluecolorcolor?As?Integer?''蓝色值Set?newcolor?=?AcadApplication.G
etInterfaceObject("AutoCAD.AcCmColor."?&?Left(AcadApplication.Ver
sion,?2))?''创建颜色对象固定用法，需要时请整条复制For?i?=?1?To?30?greencolor?=?i??8?
''改变深度值?bluecolor?=?255?-?greencolor?Call?newcolor.SetRGB(0,?green
color,?bluecolor)?''修改newcolor色彩值?mycircle(i?-?1).TrueColor?=?newc
olor?''修改圆们的RGB色属性Next?ip1?=?ThisDrawing.Utility.GetPoint(,?"已修改为渐
变色，点击任意位置画线")ang?=?ThisDrawing.Utility.AngleToReal(Rnd()??360,?0
)p1(0)?=?200??Cos(ang)''最大圆内取随机点坐标p1(1)?=?200??Sin(ang)Set?line1
?=?ThisDrawing.ModelSpace.AddLine(cc,?p1)line1.color?=?2line1.Upd
ateCall?ThisDrawing.Utility.GetPoint(,?"线条已画好，点击任意位置阵列")mylines?=
?line1.ArrayPolar(4,?3.14159??2,?cc)?''环形阵列，3条线，360度，CC点为中心line1.
Deletep2?=?ThisDrawing.Utility.GetPoint(,?"已阵列3根线，点击任意位置延伸")''修改端点
坐标，获得延伸效果intersectsp?=?mylines(0).IntersectWith(mycircle(29),?acE
xtendBoth)?''获得延长线与最大圆交点p1(0)?=?intersectsp(0)p1(1)?=?intersectsp(
1)mylines(0).StartPoint?=?p1mylines(0).EndPoint?=?ccCall?ThisDraw
ing.Utility.GetPoint(,?"已延伸1根线，点击任意位置缩放")mylines(1).ScaleEntity?c
c,?0.5Call?ThisDrawing.Utility.GetPoint(,?"线条已缩放到0.5倍，继续")For?i?=
?0?To?29?intersectsp?=?mylines(1).IntersectWith(mycircle(i),?acEx
tendNone)?''获得第1条线与圆不延长线交点?If?UBound(intersectsp)?<>?-1?Then?''圆与第1
根线存在交点?p1(0)?=?intersectsp(0)?p1(1)?=?intersectsp(1)?intersectsp?
=?mylines(2).IntersectWith(mycircle(i),?acExtendNone)?''获得第1条线与圆不延
长线交点?If?UBound(intersectsp)?<>?-1?Then?''圆与第2根线存在交点?p2(0)?=?inters
ectsp(0)?p2(1)?=?intersectsp(1)?If?i?Mod?2?=?0?Then?''计算i除以2的余数，判断
i的奇偶性?Set?myarc?=?addarcbycpp(cc,?p1,?p2)?Else?Set?myarc?=?addarc
bycpp(cc,?p2,?p1)?''反向剪切，形成错开效果?End?If?myarc.color?=?mycircle(i).c
olor?''弧、圆同色?mycircle(i).Delete?''删除圆留下弧，形成剪切效果?End?If?End?IfNext?i
Call?ThisDrawing.Utility.GetPoint(,?"已完成修剪，继续")mylines(0).Delete?
''删除多余线条End?SubFunction?addarcbycpp(centerpt,?startpt,?endpt)?As?A
cadArc?''用圆心端点法画弧arcradius?=?distance(centerpt,?startpt)?''计算半径star
tang?=?ThisDrawing.Utility.AngleFromXAxis(centerpt,?startpt)?''计算角
度endang?=?ThisDrawing.Utility.AngleFromXAxis(centerpt,?endpt)Set?
addarcbycpp?=?ThisDrawing.ModelSpace.AddArc(centerpt,?arcradius,?
startang,?endang)?''画弧End?FunctionFunction?distance(pt1,?pt2)?''计算2
点间距离x?=?pt1(0)?-?pt2(0)y?=?pt1(1)?-?pt2(1)distance?=?Sqr((Sqr((x?
^?2)?+?(y?^?2))?^?2))End?Function有更简单的办法：用Sendcommand命令来修剪。为了把对象转
化为命令字符串的一部分。需要用到VBA对象的Handle属性，它称为对象句柄。可以用handent函数转化句柄为lisp对象。它是
1个lisp函数，VBA新手也不需要懂太多，您在编程时可以直接用下面的obj2lsp自定义函数。建议有兴趣的朋友自己找资料学一下
,其实只要学好了VBA再学习lisp就很容易了。Function?obj2lsp(myobj?As?AcadEntity)?As?
StringDimobjhandle?As?Stringobjhandle?=?myobj.Handleobj2lsp?=?"(h
andent?"?&?Chr(34)?&objhandle?&?Chr(34)?&?")"End?Function下面的自定义函数
把1个对象和1个点转换为lisp对象Function?objpnt2lsp(myobj?As?AcadEntity,?Pnt?As
?Variant)?As?StringDim?objhandle?As?Stringobjhandle?=?myobj.Handl
eobjpnt2lsp?=?"(list(handent?"?&?Chr(34)?&?objhandle?&?Chr(34)?&?
")(list?"?&?Str(Pnt(0))?&?Str(Pnt(1))?&?Str(Pnt(2))?&?"))"End?Fun
ction补充1个剪切实例：用sendcommand方法把2个圆互切，变成2段圆弧。先画出1根辅助线连接2个圆心，然后把辅助线与圆
的交点作为剪切圆的选择点。Sub?trimbycomm()Dim?mycircle1?As?AcadCircleDim?cc1(2
)?As?DoubleDim?mycircle2?As?AcadCircleDim?cc2(2)?As?DoubleDim?myl
ine?As?AcadLine?''辅助线Dim?intersectsp?As?Variant?''交点Set?mycircle1?=
?ThisDrawing.ModelSpace.AddCircle(cc1,?3)?''画圆1cc2(0)?=?5Set?mycir
cle2?=?ThisDrawing.ModelSpace.AddCircle(cc2,?3)?''画圆2Set?myline?=?
ThisDrawing.ModelSpace.AddLine(cc1,?cc2)''画连接圆心的辅助线mycommand?=?"tr
im"?&?vbCrmycommand?=?mycommand?&?obj2lsp(mycircle1)?&?vbCr?''选择第1
个圆mycommand?=?mycommand?&?obj2lsp(mycircle2)?&?vbCr?&?vbCr?''选择第2个
圆intersectsp?=?myline.IntersectWith(mycircle1,?acExtendNone)?''计算圆
线交点mycommand?=?mycommand?&?objpnt2lsp(mycircle1,?intersectsp)?&?v
bCr?''第1个圆和圆内点intersectsp?=?myline.IntersectWith(mycircle2,?acExte
ndNone)?''计算圆线交点mycommand?=?mycommand?&?objpnt2lsp(mycircle2,?inte
rsectsp)?&?vbCr?&?vbCr?''第2个圆和圆内点ThisDrawing.SendCommand?(mycomman
d)?''开始干活儿myline.Delete??''删除辅助线End?SubFunction?obj2lsp(myobj?As?Ac
adEntity)?As?String?''将VBA对象转为lsp对象Dim?objhandle?As?Stringobjhandl
e?=?myobj.Handleobj2lsp?=?"(handent?"?&?Chr(34)?&?objhandle?&?Chr
(34)?&?")"End?FunctionFunction?objpnt2lsp(myobj?As?AcadEntity,?Pn
t?As?Variant)?As?String?''转换对象和点Dim?objhandle?As?Stringobjhandle?=
?myobj.Handleobjpnt2lsp?=?"(list(handent?"?&?Chr(34)?&?objhandle?
&?Chr(34)?&?")(list?"?&?Str(Pnt(0))?&?Str(Pnt(1))?&?Str(Pnt(2))?&
?"))"End?Function最后是多段线的修改方法1.给多段线添加顶点方法：AddVertex语法：object.AddVe
rtex插入点序号（从0开始计数），点坐标2.删除顶点方法：DeleteFitPoint语法：object.DeleteFitP
oint删除点的序号（从0开始计数）3.修改多段线宽度方法：SetWidth语法：object.SetWidth点序号（从0开
始计数）,起点宽度,终点宽度4.修改多段线弯度方法：SetBulge语法：object.SetBulge点序号（从0开始计数）,弯
度弯度参数是0-1之间的小数值，0代表直线，1代表弯曲成1个半圆弧下面的实例3次修改多段线画出1根弯箭头1.获取箭头两端坐标，画出
直线和多段线2.确认多段线弯曲方向，弯曲多段线3.确认箭头长度4.以箭头尖点为圆心，箭头长度为半径画辅助圆，计算圆和多段线交点5.
把交点坐标增加到弯曲多段线中6，修改多段线宽度，箭头尾部为最宽处，箭头尖点宽度为0Sub?arrawbypl()Dim?arrow
line?As?AcadLWPolylineDim?myline?As?AcadLine?''计算长度和角度的辅助线Dim?myci
rcle?As?AcadCircle?''辅助圆Dim?spoint?As?Variant?''线起点Dim?epoint?As?Va
riant?''线终点Dim?fitpts(0?To?3)?As?Double?''多段线顶点坐标Dim?arrp?As?Varian
t?''箭头位置spoint?=?ThisDrawing.Utility.GetPoint(,?"箭头起点:")epoint?=?T
hisDrawing.Utility.GetPoint(spoint,?"箭头终点:")fitpts(0)?=?spoint(0)
:?fitpts(1)?=?spoint(1)?''多段线坐标fitpts(2)?=?epoint(0):?fitpts(3)?=?
epoint(1)Set?myline?=?ThisDrawing.ModelSpace.AddLine(spoint,?epoi
nt)?''画参考线lineang?=?myline.Angle?''获取线条角度Set?arrowline?=?ThisDrawin
g.ModelSpace.AddLightWeightPolyline(fitpts)?''画多段线ThisDrawing.SetV
ariable?"OSMODE",?0?''关闭对象捕捉arrp?=?ThisDrawing.Utility.GetPoint(ep
oint,?"弯曲方向:")rl?=?rightorleft(myline,?arrp)?''用自定义函数计算左弯还是右弯arrow
line.SetBulge?0,?0.2??rl?''弯曲多段线myline.Visible?=?False''不要显示辅助线ge
tarrp:arrp?=?ThisDrawing.Utility.GetPoint(epoint,?"箭头长度:")myline.
StartPoint?=?arrp?''修改辅助线起点坐标arrdist?=?myline.Length?''获取箭头端长度If?ar
rdist?=?0?Then?GoTo?getarrp?''箭头长度为零不行，重来arrwidth?=?arrdist??Tan(
0.5)?''计算多段线宽度Set?mycircle?=?ThisDrawing.ModelSpace.AddCircle(epoi
nt,?arrdist)?''画辅助圆Dim?intersectsp?As?Variantintersectsp?=?arrowli
ne.IntersectWith(mycircle,?acExtendNone)?''计算圆线交点Dim?addpoint(1)?A
s?Doubleaddpoint(0)?=?intersectsp(0)addpoint(1)?=?intersectsp(1)a
rrowline.AddVertex?1,?addpoint?''以圆线点为顶点添加到多端线arrowline.SetWidth?1
,?arrwidth,?0?''改变多段线宽度myline.Delete?''删除辅助线mycircle.Delete?''删除辅助圆E
nd?SubFunction?rightorleft(oneline?As?AcadLine,?pnt?As?Variant)?''
判断点线位置Dim?linep1?As?Variant,?linep2?As?Variantlinep1?=?oneline.St
artPointx1?=?linep1(0)y1?=?linep1(1)linep2?=?oneline.EndPointx2?=
?linep2(0)y2?=?linep2(1)x?=?pnt(0)y?=?pnt(1)rorl?=?(y1?-?y2)??x?
+?(x2?-?x1)??y?+?x1??y2?-?x2??y1If?rorl??1Else?rightorleft?=?-1End?IfEnd?Function思考题：1.用随机色在500500空间内随机画
100个半径为5的圆，随机选择其中50个圆切割成半圆，切割方向也选用随机数。2.以（1,2）为圆心，半径为10画圆，以（20,30
）（40,-50）为端点画线，然后画出圆和线的红色公切圆。第十七课填充在AutoCAD中，填充是1种图元对象，称为Hatch对
象，其类名是AcadHatch。用VBA方法进行填充操作要分2步走：先创建填充再给它添加边界。1.创建填充对象：AddHatch方
法语法：object.AddHatch(填充类型,填充图案名称,与对象是否关联)图案填充类型一般用内置图，这个参数可以设为数字0填
充图案名称，在CAD中有显示，我相信你能找到与对象是否关联有2种选项：True或False,如果以后填充要跟随对象修改，那就是Tr
ue。2.给填充添加内边界：AppendInnerLoop语法：object.AppendInnerLoop封闭边界的对象数组这
里的object为AddHatch方法创建的填充对象3.给填充添加外边界：AppendOuterLoop方法语法：object.A
ppendOuterLoop封闭边界的对象数组注意，封闭边界的对象必须是数组，就算只给1个对象填充，也要用1个元素的数组4.给填
充插入边界：InsertLoopAt方法语法：object.InsertLoopAt插入位置序号（从零开始）,类型，插入对象数组其
中的类型有5种：acHatchLoopTypeDefault（默认）acHatchLoopTypeExternal（外界）acHa
tchLoopTypePolyline（多段线）acHatchLoopTypeDerived（获取）acHatchLoopTyp
eTextbox（文字框）5.修改填充图案：SetPattern语法：object.SetPattern（填充类型,填充图案名称)
6.填充图案比例属性：PatternScale语法：object.PatternScale7.修改填充角度：PatternAngl
e属性语法：object.PatternAngle=角度值8.修改填充间距：PatternSpace属性语法：object.P
atternSpace=间距值9.修改填充笔宽：Lineweight属性语法：object.Lineweight=笔宽选项
笔宽选项能且只能用这些值：acLnWtByLayer随层acLnWtByBlock随块acLnWtByLwDefault默认
还有各种宽度值：acLnWt000,acLnWt005,acLnWt009,acLnWt013,acLnWt015,acLn
Wt018,acLnWt020,acLnWt025,acLnWt030,acLnWt035,acLnWt040,acLnW
t050,acLnWt053,acLnWt060,acLnWt070,acLnWt080acLnWt090,acLnWt1
00,acLnWt106,acLnWt120,acLnWt140,acLnWt158,acLnWt200,acLnWt21
1从最简单的实例开始吧，画个椭圆然后填充砖头图案（AR-B816）Sub?brickinellipse()Dim?hobj?As?
AcadHatch?''填充Dim?mye(0)?As?AcadEllipse?''椭圆Dim?ec(0?To?2)?As?Doubl
e?''椭圆中心点Dim?majoraxis(0?To?2)?As?Double?''椭圆长轴端点''先画个椭圆majoraxis(0)
?=?-100:?majoraxis(1)?=?-100?''长轴端点坐标rr?=?0.5?''长短轴比率Set?mye(0)?=?T
hisDrawing.ModelSpace.AddEllipse(ec,?majoraxis,?rr)''开始填充Set?hobj?
=?ThisDrawing.ModelSpace.AddHatch(0,?"AR-B816",?True)?''建填充对象hobj.
AppendInnerLoop?mye?''以mye数组为边界hobj.PatternScale?=?0.1?''修改填充比例hobj
.PatternAngle?=?3.14159?/?4?''修改填充角度ZoomExtentsEnd?Sub画椭圆方法：AddEll
ipseSet?mye(0)?=?ThisDrawing.ModelSpace.AddEllipse(ec,?majoraxis,
?rr)语法：AddEllipse（中心点，1个长轴点，长短轴比）下面的代码画出1个小零件，演示了更多填充的用法Sub?holes
inbox()Dim?hobj?As?AcadHatchDim?c1(0)?As?AcadCircle,?cc1(2)?As?Do
ubleDim?c2?As?AcadCircle,?cc2(2)?As?DoubleDim?box(0)?As?AcadLWPol
ylineDim?p1(2)?As?Double,?p2(2)?As?DoubleDim?mycircle(0)?As?AcadC
ircleSet?c1(0)?=?ThisDrawing.ModelSpace.AddCircle(cc1,?60)?''画圆p1(
0)?=?-100:?p1(1)?=?-100p2(0)?=?100:?p2(1)?=?100Set?box(0)?=?drawb
ox(p1,?p2)?''画正方形Set?hobj?=?ThisDrawing.ModelSpace.AddHatch(0,?"an
si32",?True)?''建填充对象hobj.AppendInnerLoop?box?''以c1数组为内边界hobj.Append
OuterLoop?c1?''以box数组为外边界cc2(1)?=?80?''小圆y坐标Set?c2?=?ThisDrawing.Mo
delSpace.AddCircle(cc2,?10)?''画1个小圆arraycircle?=?c2.ArrayPolar(5,?
3.14159??2,?cc1)?''阵列成4个c2.DeleteFor?i?=?0?To?3?Set?mycircle(0)?=
?arraycircle(i)?hobj.InsertLoopAt?0,?acHatchLoopTypeDefault,?myci
rcle?''在填充里挖掉小孔Next?ihobj.PatternSpace?=?2?''修改间距ZoomExtentsEnd?Sub
Function?drawbox(p1,?p2)?As?AcadLWPolyline?''用对角线画矩形Dim?boxp(0?To?
7)?As?Doubleboxp(0)?=?p1(0):?boxp(1)?=?p1(1)boxp(2)?=?p1(0):?boxp
(3)?=?p2(1)boxp(4)?=?p2(0):?boxp(5)?=?p2(1)boxp(6)?=?p2(0):?boxp(
7)?=?p1(1)Set?drawbox?=?ThisDrawing.ModelSpace.AddLightWeightPoly
line(boxp)drawbox.Closed?=?TrueEnd?Function在挖出小圆的时候，不能直接用arraycir
cle数组，因为这4个小圆不能形成1个封闭区间，我的算法是用mycircle数组过渡，1个1个挖掉。第3个实例：画红月亮。这个程序
的关键是要画好2条弧形成闭合区间，然后存放到1个数组中作为确定填充边界的参数。Sub?redmoon()Dim?hobj?As?A
cadHatchDim?c1?As?AcadCircle,?c2?As?AcadCircle?''圆Dim?cc1(2)?As?Do
uble,?cc2(2)?As?Double?''圆心Dim?moonarc(0?To?1)?As?AcadArc?''弧Dim?ar
cp1(2)?As?Double,?arcp2(2)?As?Double?''弧端点cc2(0)?=?500Set?c1?=?Thi
sDrawing.ModelSpace.AddCircle(cc1,?1000)?''画圆Set?c2?=?ThisDrawing.
ModelSpace.AddCircle(cc2,?1000)intersectsp?=?c1.IntersectWith(c2,
?acExtendNone)?''找2圆交点arcp1(0)?=?intersectsp(0)arcp1(1)?=?intersec
tsp(1)arcp2(0)?=?intersectsp(3)arcp2(1)?=?intersectsp(4)Set?moona
rc(0)?=?rightarcbycpp(cc1,?arcp1,?arcp2)?''画弧Set?moonarc(1)?=?righ
tarcbycpp(cc2,?arcp1,?arcp2)moonarc(0).color?=?1:moonarc(1).col
or?=?1Set?hobj?=?ThisDrawing.ModelSpace.AddHatch(0,?"solid",?True
)?''建填充对象hobj.color?=?1hobj.AppendOuterLoop?moonarc?''圈定填充边界c1.Dele
tec2.DeleteZoomExtentsEnd?SubFunction?leftarcbycpp(centerpt,?pt1,
?pt2)?As?AcadArc?''用圆心端点法画左旋弧arcradius?=?distance(centerpt,?pt1)?''
计算半径arcang1?=?ThisDrawing.Utility.AngleFromXAxis(centerpt,?pt1)?''
计算角度arcang2?=?ThisDrawing.Utility.AngleFromXAxis(centerpt,?pt2)If
?arcang1?>?arcang2?Then?''角度互换?temp?=?arcang1?arcang1?=?arcang2?ar
cang2?=?tempEnd?IfSet?leftarcbycpp?=?ThisDrawing.ModelSpace.AddAr
c(centerpt,?arcradius,?arcang1,?arcang2)?''画弧End?FunctionFunction?
rightarcbycpp(centerpt,?pt1,?pt2)?As?AcadArc?''用圆心端点法画右旋弧arcradius
?=?distance(centerpt,?pt1)?''计算半径arcang1?=?ThisDrawing.Utility.Ang
leFromXAxis(centerpt,?pt1)?''计算角度arcang2?=?ThisDrawing.Utility.Ang
leFromXAxis(centerpt,?pt2)If?arcang1?arcang1?arcang1?=?arcang2?arcang2?=?tempEnd?IfSet?rightarcbycpp?=
?ThisDrawing.ModelSpace.AddArc(centerpt,?arcradius,?arcang1,?arca
ng2)?''画弧End?FunctionFunction?distance(pt1,?pt2)?''计算2点间距离x?=?pt1(0
)?-?pt2(0)y?=?pt1(1)?-?pt2(1)distance?=?Sqr((Sqr((x?^?2)?+?(y?^?2
))?^?2))End?Function在工作中我们可能需要填充一些边界很复杂的图案，如果强行用VBA去找出准确的边界需要进行大量
的计算，这对于初学者来说非常麻烦，而且也容易出错。这种情况我们可以考虑调用CAD的hatch命令来解决问题。下面的代码是填充三原色
叠加圆，请重点关注自定义过程的算法Sub?hatch3circles()Dim?c1?As?AcadCircle,?c2?As?A
cadCircle,?c3?As?AcadCircleDim?a1?As?AcadArcDim?cc1(2)?As?Double,
?cc2?As?Variant,?cc3?As?VariantDim?o(2)?As?Double''画3个圆cc1(1)?=?10
:?r?=?15Set?c1?=?ThisDrawing.ModelSpace.AddCircle(cc1,?r)Set?c2?=
?c1.Copy?''复制roangle1?=?ThisDrawing.Utility.AngleToReal(-120,?0)c2
.Rotate?o,?roangle1?''转120度Set?c3?=?c1.Copyroangle1?=?ThisDrawing.
Utility.AngleToReal(120,?0)c3.Rotate?o,?roangle1ZoomExtentshdmode
?=?ThisDrawing.GetVariable("HPDLGMODE")?''先记住对话框开关状态ThisDrawing.Se
tVariable?"HPDLGMODE",?0?''关闭填充对话框o(0)?=?0:?o(1)?=?0Call?hatchbypo
int(o)?''填充3圆相交层Call?modifyhatch("solid",?255)?''给填充上白色o(0)?=?0:?o(
1)?=?11Call?hatchbypoint(o)?''填充红圆外层Call?modifyhatch("solid",?1)?''
上红色o(0)?=?-10:?o(1)?=?5Call?hatchbypoint(o)?''填充红+绿Call?modifyhatc
h("solid",?2)??''上黄色o(0)?=?10:?o(1)?=?5Call?hatchbypoint(o)?''填充红+蓝
Call?modifyhatch("solid",?6)''上紫色o(0)?=?0:?o(1)?=?-10Call?hatchbyp
oint(o)?''填充绿+蓝Call?modifyhatch("solid",?4)??''上青色o(0)?=?-20:?o(1)?
=?0Call?hatchbypoint(o)?''填充绿圆外层Call?modifyhatch("solid",?3)??''上绿色
o(0)?=?20:?o(1)?=?0Call?hatchbypoint(o)?''填充蓝圆外层Call?modifyhatch("
solid",?5)?''上蓝色c1.Delete:?c2.Delete:?c3.Delete?''删除白色圆ThisDrawing.
SetVariable?"HPDLGMODE",?hdmode?''恢复对话框初始状态End?SubSub?hatchbypoint
(pnt)?''以点坐标填充hatchstring?=?"hatch"?&?vbCr?&?pnt(0)?&?","?&?pnt(1)
?&?vbCr?&?vbCrThisDrawing.SendCommand?(hatchstring)End?SubSub?mod
ifyhatch(pname,?hcolor)?''修改填充图案和颜色Dim?sel1?As?AcadSelectionSet?''定
义选择集对象Set?sel1?=?ThisDrawing.SelectionSets.Add("selhatch")?''新建一个选
择集Call?sel1.Select(acSelectionSetLast)?''选择上次画的图元sel1.Item(0).SetP
attern?0,?pname?''改填充图案sel1.Item(0).color?=?hcolor?''改填充颜色sel1.Dele
te?''用后即删，以免重复End?Sub本例用到了1个系统变量：HPDLGMODE，涉及以下3行hdmode?=?ThisDraw
ing.GetVariable("HPDLGMODE")?''先记住对话框开关状态ThisDrawing.SetVariable?"
HPDLGMODE",?0?''关闭填充对话框……ThisDrawing.SetVariable?"HPDLGMODE",?hdmo
de?''恢复对话框初始状态为了正常调用hatch命令，在发送填充命令前要关闭填充对话框。CAD用系统变量HPDLGMODE控制这个
对话框的开关，1开0关。本例题先读取这个系统变量初始值，然后关闭对话框，程序最后恢复对话框初始状态。再说一下选择集操作Call?s
el1.Select(acSelectionSetLast)?''选择上次画的图元sel1.Item(0).SetPattern?0
,?pname?''改填充图案用Select方法结合acSelectionSetLast参数，选择当前文档中最后画出的图元，所以se
l1.Item(0)就是这个选择集中的唯一图元，而我们在调用这个子程序时就已经设定此图元必须是填充对象，可以直接修改其属性。关于选
择集的更多用法请参阅本教程第九课。思考题：1.修改本教程第1课画100个圆的代码，填充蓝绿相间的颜色2.画标准的五星红旗下图是根据
官方画法的作出的算法提示，请正确填充国旗颜色，不必画出绿色辅助线第十八课自动标注VBA设计程序时加上标注很容易实现，但是要在已画
好的图纸上实现完善的自动标注却很困难。本课结合3个例题演示标注的初级玩法。如果你是有能力的程序员，建议用基于数据库的参数化设计进行
自动标注。1.画引线：AddLeader语法：AddLeader(三维多段线或样条线的顶点数组,注释文字对象,类型)第1个参
数的顶点数组至少要含2个点第2个参数注释文字不能用字符串，推荐用文字对象，如果你喜欢用块对象也行，如果不想写文字，这里可以用1个空
变量，这样写：变量=nothing第3个参数是引线类型，有下列4种选项：1.acLineNoArrow无箭头的直线段2.acLi
neWithArrow带箭头的直线段3.acSplineWithArrow带箭头的样条曲线4.acSplineNoArrow无箭头
的样条曲线2.对齐标注：AddDimAligned语法：object.AddDimAligned(尺寸界线第1点,尺寸界线第2点
,文字位置)3.旋转标注object.AddDimRotated语法：object.AddDimRotated(尺寸界线第1点
,尺寸界线第2点,尺寸线点位置,弧度)4.标注直径：AddDimDiametric语法：object.AddDimRadia
l(第1点，第2点，字线距离)5.标注半径AddDimRadial语法：object.AddDimRadial(圆心,Cho
rdPoint,LeaderLength)6.标注弧长object.AddDimArc(ArcCenter,FirstEnd
Point,SecondEndPoint,ArcPoint)7.标注角度：AddDimAngular语法：object.A
ddDimAngular(圆心弧线或顶点,端点1,端点2,文字位置)第1个例题：画经典游戏吃豆人,标注尺寸Sub?anydi
m()Dim?oldlay?As?AcadLayer,?newlay?As?AcadLayerDim?myarc?As?AcadA
rc,?mycircle?As?AcadCircleDim?line1?As?AcadLine,?line2?As?AcadLin
eDim?o(2)?As?Double,?o1(2)?As?DoubleDim?dimpoint1(2)?As?Double,?d
impoint2(2)?As?Double,?dimpoint3(2)?As?Doubleo(0)?=?10:?o(1)?=?10
r?=?10ang1?=?ThisDrawing.Utility.AngleToReal(45,?0)ang2?=?ThisDra
wing.Utility.AngleToReal(-10,?0)Set?myarc?=?ThisDrawing.ModelSpac
e.AddArc(o,?r,?ang1,?ang2)myarc.color?=?2Set?line1?=?ThisDrawing.
ModelSpace.AddLine(o,?myarc.startpoint)ang1?=?line1.Angleline1.co
lor?=?2Set?line2?=?ThisDrawing.ModelSpace.AddLine(o,?myarc.endpoi
nt)line2.color?=?2o1(0)?=?12:?o1(1)?=?17Set?mycircle?=?ThisDrawin
g.ModelSpace.AddCircle(o1,?0.5)mycircle.color?=?2Set?oldlay?=?Thi
sDrawing.ActiveLayerSet?newlay?=?ThisDrawing.Layers.Add("标注")newl
ay.color?=?3ThisDrawing.ActiveLayer?=?newlay''把图层设为新建的“标注”图层For?Ea
ch?dstyle?In?ThisDrawing.DimStyles?''将当前标注样式设为ISO-25?If?dstyle.Nam
e?=?"ISO-25"?Then?ThisDrawing.ActiveDimStyle?=?dstyle?Exit?For?En
d?IfNext''标注直径dimang1?=?ThisDrawing.Utility.AngleToReal(-30,?0)dim
point1(0)?=?o(0)?+?r??Cos(dimang1)dimpoint1(1)?=?o(1)?+?r??Sin(
dimang1)dimang2?=?ThisDrawing.Utility.AngleToReal(150,?0)dimpoint
2(0)?=?o(0)?+?r??Cos(dimang2)dimpoint2(1)?=?o(1)?+?r??Sin(diman
g2)Set?dimObj?=?ThisDrawing.ModelSpace.AddDimDiametric(dimpoint1,
?dimpoint2,?1)''对齐标注dis?=?11ang3?=?(ang1?+?ang2)?/?2?+?3.14159dimp
oint3(0)?=?o(0)?+?dis??Cos(ang3)dimpoint3(1)?=?o(1)?+?dis??Cos(
ang3)Call?ThisDrawing.ModelSpace.AddDimAligned(myarc.startpoint,?
myarc.endpoint,?dimpoint3)''标注角度dis?=?6.8dimpoint1(0)?=?o(0)?+?dis
??Cos(ang1)dimpoint1(1)?=?o(1)?+?dis??Sin(ang1)dimpoint2(0)?=?o
(0)?+?dis??Cos(ang2)dimpoint2(1)?=?o(1)?+?dis??Sin(ang2)dimpoin
t3(0)?=?o(0)?+?dis??Cos(ang3)dimpoint3(1)?=?o(1)?+?dis??Sin(ang
3)Call?ThisDrawing.ModelSpace.AddDimAngular(o,?dimpoint1,?dimpoin
t2,?dimpoint3)''标注半径dis?=?0.5dimpoint1(0)?=?o1(0)?-?dis??Cos(ang1
)dimpoint1(1)?=?o1(1)?+?dis??Sin(ang1)Call?ThisDrawing.ModelSpac
e.AddDimRadial(o1,?dimpoint1,?1)''标注圆心坐标Dim?txtobj?As?AcadMTextDim
?pointsarray(0?To?5)?As?Doublepointsarray(0)?=?o1(0):?pointsarray
(1)?=?o1(1)pointsarray(3)?=?o1(0)?+?8:?pointsarray(4)?=?o1(1)?+?8
dimpoint1(0)?=?o1(0)?+?12:?dimpoint1(1)?=?o1(1)?+?12Set?mtxt?=?Th
isDrawing.ModelSpace.AddMText(dimpoint1,?20,?"x="?&?o1(0)?&?"?y="
?&?o1(1))mtxt.Height?=?2.5Call?ThisDrawing.ModelSpace.AddLeader(p
ointsarray,?mtxt,?acLineNoArrow)mtxt.Width?=?8ThisDrawing.ActiveL
ayer?=?oldlay?''当前图层改回原图层End?Sub第2个实例：自动标注图纸中所有块参照的外框尺寸这个例程关键是要计算对
象边框的坐标。用GetBoundingBox方法语法：object.GetBoundingBox左下角坐标,右上角坐标理论上，这
个object是所有图元对象。而事实上，块参照和块用不了这个方法。本例的算法是遍历块中的图元，比较块中所有图元的左下角和右上角，取
最值。编程思路：1.建标注图层2.找出块参照3.计算原始块的边框最值坐标4.画辅助线，根据块参照的数据把辅助线移动、缩放到位5.以
辅助线的起点和终点标注外框尺寸Dim?p1(2)?As?Double,?p2(2)?As?Double,?p3(2)?As?Dou
bleDim?o(2)?As?Double,?move?As?Variant,?blko(2)?As?DoubleDim?temp
point?As?VariantDim?leftlowerp?As?Variant,?rightupperp?As?Variant
Sub?dimoutermostofblk()''建标注图层Dim?newlay?As?AcadLayerSet?newlay?=?
ThisDrawing.Layers.Add("标注")newlay.color?=?3ThisDrawing.ActiveLay
er?=?newlayFor?Each?ent?In?ThisDrawing.ModelSpace?''遍历模型空间对象?If?en
t.ObjectName?=?"AcDbBlockReference"?Then?''找到块参照?If?getblkminmax(e
nt.EffectiveName)?=?1?Then?''找到最值?Set?templine?=?ThisDrawing.Model
Space.AddLine(p1,?p2)?''画辅助线?templine.move?o,?ent.InsertionPoint?''
把辅助线移动到块位置?temppoint?=?ent.InsertionPoint?''块基点坐标?Set?templine1?=?
templine.Copy?''x方向的辅助线?templine1.ScaleEntity?temppoint,?ent.Xeffe
ctiveScaleFactor''x方向比例?templine1.ScaleEntity?temppoint,?ent.InsU
nitsFactor''单位因子?leftlowerp?=?templine1.StartPoint?''X最小值?rightupp
erp?=?templine1.EndPoint?''X最大值?p1(0)?=?leftlowerp(0):?p2(0)?=?rig
htupperp(0)?templine1.Delete?Set?templine1?=?templine.Copy?''Y方向辅助
线?templine1.ScaleEntity?temppoint,?ent.YEffectiveScaleFactor?temp
line1.ScaleEntity?temppoint,?ent.InsUnitsFactor?leftlowerp?=?temp
line1.StartPoint?''Y最小值?rightupperp?=?templine1.EndPoint??''Y最大值?p1
(1)?=?leftlowerp(1):?p2(1)?=?rightupperp(1)?templine1.Delete?temp
line.Delete?p3(0)?=?p2(0):?p3(1)?=?p1(1)?''右下角坐标?Dim?txtp?As?Varia
nt?txtp?=?midpoint(p1,?p3)?txtp(1)?=?txtp(1)?-?10?Call?ThisDrawin
g.ModelSpace.AddDimAligned(p1,?p3,?txtp)?''标注?txtp?=?midpoint(p3,?
p2)?txtp(0)?=?txtp(0)?+?10?Call?ThisDrawing.ModelSpace.AddDimAlig
ned(p3,?p2,?txtp)?End?If?End?IfNext?entEnd?SubFunction?getblkminm
ax(EffName)?''给块找最值getblkminmax?=?1?''如果找到最值则返回1On?Error?Resume?Nex
tSet?blkcoll?=?ThisDrawing.Blocks?For?i?=?1?To?blkcoll.Count?-?1?
''要计算块里每个图元的最值坐标?If?blkcoll.Item(i).Name?=?EffName?Then?blkcoll.It
em(i).Item(0).GetBoundingBox?leftlowerp,?rightupperp?''第1个图元的左下和右上
角坐标值?If?Err.Number?<>?0?Then?Err.Clear?blkcoll.Item(i).Item(1).Ge
tBoundingBox?leftlowerp,?rightupperp?''跳过第1个图元再试1次?If?Err.Number?<
>?0?Then?''找最值失败，返回0?Err.Clear?getblkminmax?=?0?Return?End?If?End?
If?p1(0)?=?leftlowerp(0):?p1(1)?=?leftlowerp(1)?p2(0)?=?rightuppe
rp(0):?p2(1)?=?rightupperp(1)?For?j?=?1?To?blkcoll.Item(i).Count?
-?1?blkcoll.Item(i).Item(j).GetBoundingBox?leftlowerp,?rightupper
p?p1(0)?=?IIf(leftlowerp(0)?p1(1)?=?IIf(leftlowerp(1)?IIf(rightupperp(0)?>?p2(0),?rightupperp(0),?p2(0))?''取最大值?p2(1)?=?
IIf(rightupperp(1)?>?p2(1),?rightupperp(1),?p2(1))?Next?j?End?If?
Next?iEnd?FunctionFunction?midpoint(pt1,?pt2)?''2点间的中点Dim?temp(2)?
As?Doubletemp(0)?=?(pt1(0)?+?pt2(0))?/?2temp(1)?=?(pt1(1)?+?pt2(1
))?/?2temp(2)?=?(pt1(2)?+?pt2(2))?/?2midpoint?=?tempEnd?Function接
下来说说比较复杂的问题：修改标注。AutoCAD标注有各种类型和属性，可以修改的内容实在太多，1个个改标注属性太累了，建议用标注样
式统一修改各种标注。跟图层样式一样，标注样式本身也是一种对象，其类型为AcadDimStyle1.创建标注样式这样写：Set标注
样式对象=ThisDrawing.DimStyles.Add(标注样式名称)2.复制标注样式这样写：新标注样式对象.CopyF
rom源标注样式对象3.将当前标注样式赋值给标注样式对象Set标注样式对象=ThisDrawing.ActiveDimSt
yle4.将新建样式设为当前标注样式ThisDrawing.ActiveDimStyle=标注样式对象VBA不能直接修改标注样
式中的具体数值。我们可以用变通算法：先修改标注样式的系统变量，然后把系统变量复制到新建标注样式中。实例3：新建1个名为“新新标注”
的标注样式,然后把图纸中所有标注的样式设为“新新标注”Sub?addnewdimstyle()Dim?newdimstyle?As
?AcadDimStyledimsize?=0.8Set?newdimstyle?=?ThisDrawing.DimStyles.
Add("新新标注")With?ThisDrawing?.SetVariable?"DIMLFAC",?1?''全局比例因子?.Se
tVariable?"DIMSCALE",?1?''线性比例因子?.SetVariable?"DIMTXSTY",?"STANDAR
D"?''文字样式?.SetVariable?"DIMDEC",?3?''文字小数位数?.SetVariable?"DIMDSEP",
?"."?''文字分隔符用小数点?.SetVariable?"DIMTIH",?0?''文字与尺寸线对齐?.SetVariable?
"DIMTXT",?2.5??dimsize?''文字高度?.SetVariable?"DIMASZ",?2.5??dimsiz
e?''箭头大小?.SetVariable?"DIMDLI",?3.75??dimsize?''基线尺寸线的间距?.SetVaria
ble?"DIMEXE",?1.25??dimsize?''尺寸界线超出尺寸线的距离?.SetVariable?"DIMEXO",
?0.625??dimsize''尺寸界线偏移量?.SetVariable?"DIMGAP",?0.625??dimsize
''文字偏移量End?Withnewdimstyle.CopyFrom?ThisDrawing''复制系统变量到标注样式ThisDr
awing.ActiveDimStyle?=?newdimstyle''设为当前标注样式For?Each?ent?In?ThisD
rawing.ModelSpaceIf?InStr(ent.ObjectName,?"Dim")?>?0?Then''对象类型名称
中含有Dim，可视其为标注对象?ent.StyleName?=?"新新标注"End?IfNextEnd?Sub在这个程序中用到了w
ith块，其作用是简化代码,本例中相当于给with和endwith之间的代码前加上“Thisdrawing”。在本例题中，只要修改
一下dimsize值就能统一修改文字和箭头的尺寸。您可以根据实际需要修改各种系统变量。Autocad帮助文件里可以查到系统变量的名
称。下表列出了与标注相关的系统变量。实不相瞒，我也记不住那么多洋文，咱们只要记住一些常用的变量，然后懂得需要干什么、查什么、查到后
怎么用，足够了。变量说明DIMSCALE全局比例DIMTOLJ公差位置垂直DIMTFAC公差文字比例因子DIMTOL公差极限偏差
DIMTP公差极限偏差上限DIMTM公差极限偏差下限DIMTZIN公差消零DIMLIM公差界限DIMTDEC公差精度DIMFRAC
分数格式DIMFXL固定的尺寸界线长度DIMCEN圆心标记大小DIMJOGANG大弧度标注折弯角度DIMDSEP小数分隔符DIML
TEX1尺寸界线1的线型DIMLTEX2尺寸界线2的线型DIMEXO尺寸界线偏移DIMLWE尺寸界线线宽DIMEXE尺寸界
线超出量DIMCLRE尺寸界线颜色DIMTOFL尺寸线强制DIMLTYPE尺寸线的线型DIMLWD尺寸线线宽DIMDLE尺寸线超出
量DIMDLI尺寸线间距DIMCLRD尺寸线颜色DIMFXLON已启用固定的尺寸界线DIMLDRBLK引线箭头DIMARCSYM弧
长符号DIMALTTZ换算公差消零DIMALTTD换算公差精度DIMAPOST换算前缀和后缀DIMALTU换算单位DIMALTF换
算比例因子DIMALTZ换算消零DIMALTD换算精度DIMALTRND换算舍入DIMALTMZS换算零后缀DIMALTMZF换算
零因子DIMTAD文字位置垂直DIMJUST文字位置水平DIMGAP文字偏移DIMPOST文字前缀和后缀DIMTIX文字在内DIM
TIH文字在内对齐DIMTOH文字外部对齐DIMTXSTY文字样式DIMTFILL文字背景已启用DIMTFILLCLR文字背景颜色
DIMCLRT文字颜色DIMTXT文字高度DIMSOXD无外侧尺寸线DIMSE1无尺寸界线1DIMSE2无尺寸界线2DIMSD
1无尺寸线1DIMSD2无尺寸线2DIMTXTDIRECTION标注文字的方向DIMZIN消零DIMSAH独立的箭头DIMBL
K箭头DIMBLK1箭头1DIMBLK2箭头2DIMASZ箭头大小DIMDEC精度DIMRND舍入DIMAUNIT角度格式DI
MAZIN角度消零DIMADEC角度精度DIMTMOVE调整文字移动DIMATFIT调整箭头和文字DIMLUNIT长度单位DIML
FAC长度比例DIMMZS零后缀DIMMZF零因子下表列出官方标注箭头的样式类型""实心闭合"_DOT"点"_DOTSMALL"小
点"_DOTBLANK"空心点"_ORIGIN"原点标记"_ORIGIN2"原点标记2"_OPEN"打开"_OPEN90"直角"
_OPEN30"30度角"_CLOSED"闭合"_SMALL"空心小点"_NONE"无"_OBLIQUE"倾斜"_BOXFILL
ED"实心框"_BOXBLANK"方框"_CLOSEDBLANK"空心闭合"_DATUMFILLED"实心基准三角形"_DATUM
BLANK"基准三角形"_INTEGRAL"完整标记"_ARCHTICK"建筑标记思考题：1.用三点法画圆，3点坐标分别为（0,0
）(1,2)（3,4），标注直径2.在300300空间内随机位置画10个半径为10的圆，标注圆心坐标第十九课打印布局和输出打
印到设备：PlotToDevice语法：ThisDrawing.Plot.PlotToDevice打印到文件：PlotToFile
语法：ThisDrawing.Plot.PlotToFile(文件名)第1个例题：打印指定窗口范围。Sub?testprint()
Dim?printdrvname?As?String?''打印机配置名Dim?p1(0?To?1)?As?Double?''打印窗口左
下角坐标Dim?p2(0?To?1)?As?Double?''打印窗口右上角坐标printdrvname?=?"无"printdrv
name?=?ThisDrawing.ActiveLayout.ConfigName?''获取打印机配置If?printdrvnam
e?=?"无"?Then?MsgBox?("未配置打印机")?Exit?SubEnd?Ifp1(0)?=?-100:?p2(1)?
=?-100p2(0)?=?100:?p2(1)?=?100ThisDrawing.ActiveLayout.SetWindowT
oPlot?p1,?p2?''设置窗口坐标ThisDrawing.ActiveLayout.PlotType?=?acWindow?
''设置为窗口打印范围ThisDrawing.Plot.PlotToDevice?''输出到用户配置的打印设备ThisDrawing.
Plot.PlotToFile("filename")?''打印到文件End?Sub这是个很简单的例题，不需要多解释。重点在这行：T
hisDrawing.ActiveLayout.PlotType?=?acWindow?''设置打印范围这里需要搞明白的是PlotT
ype属性，有6种选择，具体内容参阅下表acDisplay打印当前显示的所有对象acExtents打印当前选定空间范围内的所有对象
acLimits打印当前空间界限内的所有对象acView打印在ViewToPlot属性中命名的视口acWindow打印在SetWi
ndowToPlot方法中指定的窗口中的所有对象acLayout打印指定纸张尺寸边界内的所有对象下面的方法和属性是布局和视口的常用
操作1.切换模型空间和图纸空间用ActiveSpace属性ThisDrawing.ActiveSpace=选项这个属性只有2个
选项：acModelSpace模型空间、acPaperSpace图纸空间2.创建布局这样写：CallThisDrawing.La
youts.Add（布局名）3.创建视口这样写：CallThisDrawing.PaperSpace.AddPViewport(
中心点,宽度,高度)4.修改视口观察方向用Direction属性语法：Object.Direction=观察方向矢量点5.修改
视口比例用CustomScale属性语法：Object.CustomScale=比例值6.是否可以在浮动的图纸空间视口中编辑模
型，用Mspace属性语法：ThisDrawing.MSpace=选项有2个选项：True允许编辑，False禁止编辑下面的实
例把整个图形自动分割出4个布局，这样出图后可以拼合成1张较大的图纸Sub?splitlayouts()Dim?wplu(2)?As
?Double,?wprl(2)?As?DoubleThisDrawing.ActiveSpace?=?acModelSpace?
''先切换到模型空间ZoomExtentswpll?=?ThisDrawing.GetVariable("EXTMIN")?''获取左
下角坐标wpru?=?ThisDrawing.GetVariable("EXTMAX")?''获取右上角坐标wpmid?=?midp
oint(wpll,?wpru)?''计算中点wplu(0)?=?wpll(0):?wplu(1)?=?wpru(1)?''左上角坐标
wprl(0)?=?wpru(0):?wprl(1)?=?wpll(1)?''右下角坐标Call?addlayoutsby2p("l
eftupper",?wplu,?wpmid)?''左上布局Call?addlayoutsby2p("leftlower",?wpl
l,?wpmid)?''左下布局Call?addlayoutsby2p("rightlower",?wpmid,?wpru)?''右下
布局Call?addlayoutsby2p("rightupper",?wpmid,?wprl)?''右上布局ThisDrawing
.MSpace?=?False?''不再编辑浮动视口ThisDrawing.ActiveSpace?=?acModelSpace?''
回到模型空间End?SubFunction?addlayoutsby2p(layoutsname,?p1,?p2)''建布局和视口
Set?newlayout?=?ThisDrawing.Layouts.Add(layoutsname)?''新建布局ThisDra
wing.ActiveLayout?=?newlayout?''设为当前活动布局Set?newvport?=?ThisDrawing
.PaperSpace.Item(1)?''这是布局中的默认视口ThisDrawing.MSpace?=?True?''允许编辑浮动视
口ThisDrawing.ActivePViewport?=?newvport?''设为当前视口ZoomWindowp1,?p2?
''窗口缩放End?FunctionFunction?midpoint(pt1,?pt2)?''2点间的中点Dim?temp(2)?A
s?Doubletemp(0)?=?(pt1(0)?+?pt2(0))?/?2temp(1)?=?(pt1(1)?+?pt2(1)
)?/?2temp(2)?=?(pt1(2)?+?pt2(2))?/?2midpoint?=?tempEnd?Function下面
是关于输出的2个方法1.保存指定格式文件用SaveAs方法语法：ThisDrawing.SaveAs(文件名，文件类型值)第2
个参数文件类型值有20种选项，下表已更新至最新版文件类型值文件类型和后缀acR12_dxfAutoCADR12DXF(.
dxf)acR14_dwgAutoCADR14DWG(.dwg)ac2000_dwgAutoCAD2000DWG
(.dwg)ac2000_dxfAutoCAD2000DXF(.dxf)ac2000_TemplateAutoCAD
2000DrawingTemplateFile(.dwt)ac2004_dwgAutoCAD2004DWG(
.dwg)ac2004_dxfAutoCAD2004DXF(.dxf)ac2004_TemplateAutoCAD2
004DrawingTemplateFile(.dwt)ac2007_dwgAutoCAD2007DWG(.d
wg)ac2007_dxfAutoCAD2007DXF(.dxf)ac2007_TemplateAutoCAD200
7DrawingTemplateFile(.dwt)ac2010_dwgAutoCAD2010DWG(.dwg
)ac2010_dxfAutoCAD2010DXF(.dxf)ac2010_TemplateAutoCAD2010
DrawingTemplateFile(.dwt)ac2013_dwgAutoCAD2013DWG(.dwg)a
c2013_dxfAutoCAD2013DXF(.dxf)ac2013_TemplateAutoCAD2013Dr
awingTemplateFile(.dwt)ac2018_dwgAutoCAD2018DWG(.dwg)ac2
018_dxfAutoCAD2018DXF(.dxf)ac2018_TemplateAutoCAD2018Draw
ingTemplateFile(.dwt)2.输出文件用Export方法语法：ThisDrawing.Export文件名
,文件类型,选择集这里的文件类型有6中：WMF、SAT、EPS、DXF、DWF、BMP如果输出EPS、DXF格式文件，只能输出
全部内容，但这个选择集参数却不能空着输入文件用Import方法语法：ThisDrawing.Import文件名,插入点,比例下面的
实例给每个图层分别输出1个WMF文件Sub?exportlays()Dim?sset?As?AcadSelectionSet?''选
择集Dim?ftype(0)?As?Integer,?fdate(0)?''确定选择集用到的参数Dim?everyent?As?Ac
adEntity?''选择集中的图元For?Each?lay?In?ThisDrawing.Layers?layname?=?lay
.Name?Set?sset?=?ThisDrawing.SelectionSets.Add("mysset")?''创建选择集?f
type(0)?=?8:?fdate(0)?=?layname?sset.Select?acSelectionSetAll,?,?
,?ftype,?fdate?''选中图层中的所有对象?ThisDrawing.Export?ThisDrawing.FullNam
e?&?layname,?"WMF",?sset?''输出文件?sset.DeleteNext这里用到了1个小技巧：快速选中图层中的
所有对象ftype(0)?=?8:?fdate(0)?=laynameSSet.Select?acSelectionSetAl
l,?,?,?ftype,?fdate?''选中图层中的所有对象思考题1.新建1个名为“layoutO”的布局，设置其视口中心为原点
，比例为0.1第二十课设计窗体本课任务是做1个万花尺实例。在我学习算法期间曾研究过类似的程序，编程思路大同小异，都是用数学公式计
算坐标后再画图。而本课的算法免去了大部分公式，直接在CAD中画出圆和笔迹点，然后用旋转方法获取多段线坐标。事实上，它不是最优解，却
是一种更容易理解的算法，也可以发挥出AutoCAD的优势。为了让用户任意改变参数，产生千变万化的效果，需要填写的参数比较多，所以这
个实例更适合用窗体编程。下图是窗体界面和运行效果。下面的程序用一小段动画解释画图原理。1.画出内切的大小2个圆2.获取起始笔迹点坐
标3.创建笔迹点4.圆和笔迹点以大圆为圆心公转5.笔迹点以小圆为圆心自转6.以笔迹点旋转前后为坐标划出直线7.如果没转够30圈，回
到第4步Option?Explicit''Private?Declare?PtrSafe?Sub?Sleep?Lib?"kernel
32"?(ByVal?dwMilliseconds?As?Integer)?''调用API函数Sub?figure()Dim?big
circle?As?AcadCircle?''大圆Dim?smallcircle?As?AcadCircle?''小圆Dim?bigc
r,?smallcr?''两圆半径Dim?cc1(2)?As?Double?''大圆圆心坐标Dim?cc2(2)?As?Double?
''小圆圆心坐标Dim?cc2new?As?Variant?''移动后小圆圆心坐标Dim?roangle1?''小球公转角度Dim?ro
angle2?''小球自转角度Dim?movepoint?As?AcadPoint?''笔尖点Dim?startpoint?As?Va
riant?''笔尖起点Dim?newpoint?As?Variant?''旋转后笔尖点坐标Dim?roundn?''小球滚动圈数Dim
?nowlay(1?To?8)?As?AcadLayer?''颜色图层Dim?i?As?IntegerFor?i?=?1?To?8?
Set?nowlay(i)?=?ThisDrawing.Layers.Add(CStr(i))?''建颜色图层?nowlay(i).
color?=?i?''设置图层颜色Next?ii?=?Int((Rnd()?+?0.05)??8)?''i=0-8的随机整数Thi
sDrawing.ActiveLayer?=?nowlay(i)?''选择当前图层bigcr?=?100?''大圆半径smallcr?
=?30?''小圆半径Set?bigcircle?=?ThisDrawing.ModelSpace.AddCircle(cc1,?b
igcr)?''画大圆bigcircle.color?=?3''绿色cc2(0)?=?cc1(0)?''小圆圆心cc2(1)?=?bi
gcr?-?smallcrSet?smallcircle?=?ThisDrawing.ModelSpace.AddCircle(c
c2,?smallcr)?''画小圆smallcircle.color?=?2''黄色ZoomExtents?''显示整个图形start
point?=?ThisDrawing.Utility.GetPoint(cc2,?vbCr?&?"请在小圆内选起始轨迹点")Se
t?movepoint?=?ThisDrawing.ModelSpace.AddPoint(startpoint)?''创建笔尖点r
oangle1?=?ThisDrawing.Utility.AngleToReal(10,?0)?''自转10度roangle2?=
?roangle1?/?((bigcr?-?1)?/?smallcr)?''计算公转角度roundn?=?30?''小圆转30圈cc2
new?=?smallcircle.Center??''获取小圆的圆心坐标For?i?=?0?To?36??roundn''1次转
10度，转1圈要动36次?startpoint?=?movepoint.Coordinates?''获取笔尖点转前坐标?smallc
ircle.Rotate?cc1,?roangle2?''小圆公转?movepoint.Rotate?cc1,?roangle2?''
笔迹点公转?movepoint.Rotate?cc2new,?roangle1?''笔迹点自转?newpoint?=?movepoi
nt.Coordinates?''获取笔尖点转后坐标?Call?ThisDrawing.ModelSpace.AddLine(sta
rtpoint,?newpoint)''画出1小段轨迹线?cc2new?=?smallcircle.Center??''获取小圆公转
后圆心坐标?smallcircle.Update''更新小圆，显示动画效果?''Sleep?10?''暂停10毫秒Next?ibigc
ircle.Delete??''删除圆smallcircle.DeleteEnd?Sub我的电脑有点慢，所以把调用API函数的sle
ep()注释掉了，如果你的电脑太快以至于看不清动画效果，可以恢复这2条语句，然后修改sleep函数后面的参数控制暂停时间。设计空白
窗体可分4步走：1.在VBA编辑器中点“插入用户窗体”图标，窗体被自动命名为“UserForm1”2.拖动白色夹点改变窗体大小3.
左侧属性栏找到Caption属性，改为“万花尺”4.快捷键Ctrl+S保存工程接下来要给窗体插入控件：单击工具箱里的控件，然后在窗
体需要插入这个控件的位置拖出1个框，再把控件0属性改好，最后双击控件，写入相应代码。下面的2张图分别是控件工具箱和实例窗体，我划出
了相对应的彩色线框以便对照。建议您下载本教程网盘中的“万花尺.DVB”慢慢摸索，对比研究。绿色:标签蓝色:文字框橙色:旋转按钮
粉色:滚动条青色:选项按钮黑色:复合框黄色:命令按钮1.标签这是最简单的控件，只是在窗体里写点说明文字，一般告诉用户应该在
文字框里填点啥内容。下图是label1控件属性窗口的截图，其中最常用的属性里加上了中文字。2.文字框控件文字框的作用是输入或显示数
据，上面提过的属性不再重复，这个控件还需要搞明白以下属性Controltiptext:当鼠标移动到控件附近时显示的文字Enable
d:可以理解为控件的有效性开关，Ture有效，False无效TextAlign:文本对齐方式，有3个选项：常量值说明fmTextA
lignLeft1左边界对齐（默认值）fmTextAlignCenter2中央对齐fmTextAlignRight3右边界对齐。V
alue:初始值，通常是数字或字符串ScrollBars:滚动条常量值说明fmScrollBarsNone0不显示（默认值）fmS
crollBarsHorizontal1显示水平滚动条fmScrollBarsVertical2显示垂直滚动条fmScrollBa
rsBoth3显示垂直和水平滚动条Locked:可编辑开关，True不能编辑，False可编辑Visible:是否隐藏开关，Tr
ue不隐藏，False隐藏3.旋转按钮和滚动条控件这2个控件的作用类似，通常用于快捷修改数字，需要理解以下属性：Delay：调节
钮或滚动条上延迟时间,初始值为50毫秒LargeChange:最大修改值SmallChange:最小修改值Max：最大值Min:最
小值4.选项按钮控件其作用是获取用户选择的数值，每个选项按钮只有2种值：True或False5.复合框控件又称列表框，显示一些值的
列表，用户可以从中选择。如果没有绑定数据源，需要在代码里添加选项。6.命令按钮鼠标点这个按钮后就可以触发一些操作，称为Click
事件。接下来最关键的问题，控件事件代码，双击控件，会产生1个默认的事件代码，不过它不一定是正好我们需要编写的事件代码。这时候要在
代码窗口右上角选择合知的事件代码，如下图：下面列出几种最常用的事件1.Click事件：通常是用户鼠标单击控件时会触发这个事件2.D
blClick事件：用户双击鼠标触发3.Change事件：当Value属性被修改时触发4.SpinDown和SpinUp事件
：单击数值调节钮时触发5.initialize事件：初始化窗体事件，加载窗体时会执行这个Sub以下为万花尺代码，不知你能看懂多少？
Option?ExplicitDim?bigcircle?As?AcadCircle?''大圆Dim?smallcircle?As?
AcadCircle?''小圆Dim?cc1(2)?As?Double?''大圆圆心Dim?cc2(2)?As?Double?''小圆圆
心Dim?cc2new?As?Variant?''小圆转动后的圆心坐标Dim?bigcr,?smallcr?''两圆半径Dim?roa
ngle1?''小球公转角度Dim?roangle2?''小球自转角度Dim?roundn?''小球滚动圈数Dim?spl?As?Aca
dLWPolyline?''轨迹线Dim?fitpoint()?As?Double?''轨迹线点坐标Dim?movepoint?As?
AcadPoint?''笔尖点Dim?startpoint?As?Variant?''笔尖起点Dim?locusp?As?Varian
t?''笔尖点坐标Dim?newpoint?As?Variant?''旋转后笔尖点坐标Dim?colors(1?To?7)?As?St
ring?''7个色彩Dim?newcolor?As?AcadAcCmColor?''颜色对象Dim?winp1(2)?As?Doub
le,?winp2(2)?As?Double?''缩放窗口Dim?i??''循环专用Dim?j??''循环专用Dim?temp1?As?
Variant?''临时变量Dim?temp2?As?Variant?''临时变量Private?Sub?pickbigcc_Clic
k()?''拾取大圆圆心按钮UserForm1.Hidetemp1?=?ThisDrawing.Utility.GetPoint(,
?"大圆圆心:")TextBox1.Value?=?FormatNumber(temp1(0),?5)?&?","?&?Forma
tNumber(temp1(1),?5)UserForm1.showEnd?SubSub?getbigcc()?''计算大圆圆心坐标
temp1?=?TextBox1.Valuecc1(0)?=?Val(Left(temp1,?InStr(temp1,?",")?
-?1))cc1(1)?=?Val(Mid(temp1,?InStr(temp1,?",")?+?1))ZoomCenter?cc
1,?1?''中心缩放窗口End?SubPrivate?Sub?pickbigcr_Click()?''拾取大圆半径按钮UserFor
m1.HideCall?getbigcctemp1?=?ThisDrawing.Utility.GetPoint(cc1,?"大圆
半径:")TextBox2.Value?=?caldist(temp1,?cc1)Call?getbigcrUserForm1.s
howEnd?SubSub?getbigcr()?''获得大圆半径If?Val(TextBox2.Value)?>?0?Then?b
igcr?=?TextBox2.ValueEnd?SubPrivate?Sub?picksmllcc_Click()?''拾取小圆圆
心按钮UserForm1.HideCall?getbigccCall?getbigcrCall?zoomwinSet?temp2?
=?ThisDrawing.ModelSpace.AddCircle(cc1,?bigcr)temp1?=?ThisDrawing
.Utility.GetPoint(cc1,?"小圆圆心位置:")TextBox3.Value?=?FormatNumber(te
mp1(0),?5)?&?","?&?FormatNumber(temp1(1),?5)temp2.DeleteUserForm1
.showEnd?SubSub?getsmallcc()?''计算小圆圆心坐标temp1?=?TextBox3.Valuecc2(0
)?=?Val(Left(temp1,?InStr(temp1,?",")?-?1))cc2(1)?=?Val(Mid(temp1
,?InStr(temp1,?",")?+?1))End?SubSub?getsmallcr()?''计算小圆半径smallcr?=
?Abs(TextBox2.Value?-?(caldist(cc1,?cc2)))End?SubPrivate?Sub?pick
startp_Click()?''拾取起始点UserForm1.HideCall?getbigcc?''大圆圆心Call?getbig
cr?''大圆半径Call?getsmallcc?''小圆圆心Call?getsmallcr??''算出小圆半径Call?zoomwin
?''缩放窗口Set?temp1?=?ThisDrawing.ModelSpace.AddCircle(cc1,?bigcr)Set
?temp2?=?ThisDrawing.ModelSpace.AddCircle(cc2,?smallcr)temp1.colo
r?=?3temp2.color?=?3startpoint?=?ThisDrawing.Utility.GetPoint(cc2
,?"起始点:")CommandButton1.Enabled?=?True?''亮起开始按钮TextBox5.Value?=?Fo
rmatNumber(startpoint(0),?5)?&?","?&?FormatNumber(startpoint(1),?
5)temp1.Deletetemp2.DeleteUserForm1.showEnd?SubPrivate?Sub?Scroll
Bar1_Change()?''圈数滚动条TextBox4.Value?=?ScrollBar1.ValueEnd?SubPriva
te?Sub?SpinButton1_SpinUp()?''转数+1TextBox4.Value?=?TextBox4.Value?
+?10End?SubPrivate?Sub?SpinButton1_SpinDown()?''转数-1TextBox4.Value
?=?TextBox4.Value?-?10If?TextBox4.Value?<=?0?Then?TextBox4.Value?
=?10End?SubPrivate?Sub?TextBox4_Change()?''转几圈roundn?=?Val(TextBox
4.Value)End?SubPrivate?Sub?UserForm_Initialize()''列表框中填入颜色选项colors
(1)?=?"红色"colors(2)?=?"黄色"colors(3)?=?"绿色"colors(4)?=?"青色"colors(
5)?=?"蓝色"colors(6)?=?"粉色"colors(7)?=?"白色"For?i?=?1?To?7?ComboBox1
.AddItem?colors(i)Next?iEnd?SubSub?choosecolorchange()?''改变线条颜色cho
osecolor.Value?=?TrueIf?ComboBox1.Value?=?"红色"?Then?linecolor.Bac
kColor?=?RGB(255,?0,?0)If?ComboBox1.Value?=?"黄色"?Then?linecolor.B
ackColor?=?RGB(255,?255,?0)If?ComboBox1.Value?=?"绿色"?Then?linecol
or.BackColor?=?RGB(0,?255,?0)If?ComboBox1.Value?=?"青色"?Then?linec
olor.BackColor?=?RGB(0,?255,?255)If?ComboBox1.Value?=?"蓝色"?Then?l
inecolor.BackColor?=?RGB(0,?0,?255)If?ComboBox1.Value?=?"粉色"?Then
?linecolor.BackColor?=?RGB(255,?0,?255)If?ComboBox1.Value?=?"白色"?
Then?linecolor.BackColor?=?RGB(255,?255,?255)End?SubPrivate?Sub?c
hoosecolor_Click()?''选色Call?choosecolorchangeEnd?SubPrivate?Sub?Co
mboBox1_Change()?''选色列表框改变时给线条换色Call?choosecolorchangeEnd?SubSub?r
gbcolorchange()?''换RGB配色rgbcolor.Value?=?Truelinecolor.BackColor?=
?RGB(rgbred.Value,?rgbgreen.Value,?rgbblue.Value)End?SubPrivate?S
ub?rgbcolor_Click()?''给线条配RGB色If?rgbred.Value?>?255?Then?rgbred.Va
lue?=?255If?rgbred.Value?angeEnd?SubPrivate?Sub?rgbred_Change()Call?rgbcolorchangeEnd?SubP
rivate?Sub?rgbgreen_Change()If?rgbgreen.Value?>?255?Then?rgbgreen
?=?255Call?rgbcolorchangeEnd?SubPrivate?Sub?rgbblue_Change()temp1
?=?rgbblue.ValueIf?Not?IsNumeric(temp1)?Then?rgbblue.Value?=?""?r
gbblue.SetFocusElse?If?temp1?>?255?Then?rgbblue.Value?=?255?If?te
mp1?ivate?Sub?ScrollBarRed_Change()?''红色滚动条rgbred.Value?=?ScrollBarRed
.ValueEnd?SubPrivate?Sub?ScrollBarGreen_Change()?''绿色滚动条rgbgreen.V
alue?=?ScrollBarGreen.ValueEnd?SubPrivate?Sub?ScrollBarBlue_Chang
e()?''蓝色滚动条rgbblue.Value?=?ScrollBarBlue.ValueEnd?SubPrivate?Sub?C
ommandButton1_Click()?''开始按钮Call?figureEnd?SubPrivate?Sub?clearall
_Click()?''清空按钮UserForm1.HideIf?MsgBox("吾将平仓空归去,可乎??",?1,?"劝君行事多谨慎
!")?=?vbOK?Then?For?Each?temp1?In?ThisDrawing.ModelSpace?temp1.De
lete?Next?ThisDrawing.Regen?True?TextBox1.Value?=?"0,0"?''大圆圆心?Tex
tBox2.Value?=?100?''大圆半径?TextBox3.Value?=?"0,60"?''小圆圆心?TextBox4.Va
lue?=?100?''圈数?ScrollBar1.Value?=?100?TextBox5.Value?=?"?"?''开始点?Co
mboBox1.Value?=?"红色"?choosecolor?=?True?''选色?rgbred.Value?=?255?Sc
rollBarRed.Value?=?255?rgbgreen.Value?=?0?ScrollBarGreen.Value?=?
0?rgbblue.Value?=?0?ScrollBarBlue.Value?=?0?Call?choosecolorchang
e?CommandButton1.Enabled?=?False?''关闭开始按钮End?IfUserForm1.showEnd?S
ubPrivate?Sub?unloadwin_Click()?''退出按钮Unload?MeEnd?SubSub?zoomwin(
)?''缩放显示图案''获取大圆参数Call?getbigccCall?getbigcrwinp1(0)?=?cc1(0)?-?big
crwinp1(1)?=?cc1(1)?-?bigcrwinp2(0)?=?cc1(0)?+?bigcrwinp2(1)?=?cc
1(1)?+?bigcrZoomWindow?winp1,?winp2End?SubSub?figure()?''转起来UserFo
rm1.HideCall?getbigcc?''大圆圆心Call?getbigcr??''大圆半径Set?bigcircle?=?Th
isDrawing.ModelSpace.AddCircle(cc1,?bigcr)?''画大圆Call?getsmallcc?''小
圆圆心Call?getsmallcr??''小圆半径Set?smallcircle?=?ThisDrawing.ModelSpace
.AddCircle(cc2,?smallcr)?''画小圆cc2new?=?smallcircle.Center??''获取小圆坐标
Call?TextBox4_Change''转几圈儿Set?movepoint?=?ThisDrawing.ModelSpace.A
ddPoint(startpoint)?''创建笔尖点roangle1?=?ThisDrawing.Utility.AngleToR
eal(5,?0)?''每次自转15度roangle2?=?roangle1?/?((bigcr?-?2)?/?smallcr)?''
公转角度ReDim?fitpoint(0?To?72??roundn?+?1)For?i?=?0?To?72??roundn?
Step?2?newpoint?=?movepoint.Coordinates?''获取笔尖点坐标?fitpoint(i)?=?ne
wpoint(0)?''把笔尖坐标存入多段线坐标?fitpoint(i?+?1)?=?newpoint(1)?movepoint.R
otate?cc2new,?roangle1?''自转?movepoint.Rotate?cc1,?roangle2?''公转?sma
llcircle.Rotate?cc1,?roangle2?''小圆公转?cc2new?=?smallcircle.Center??
''获取小圆当前位置的圆心坐标Next?iSet?spl?=?ThisDrawing.ModelSpace.AddLightWeig
htPolyline(fitpoint)?''画线If?rgbcolor.Value?=?True?Then?''RGB配色?Set?
newcolor?=?AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.
"?&?Left(AcadApplication.Version,?2))?''创建颜色对象固定用法，需要时请整条复制?Call?n
ewcolor.SetRGB(rgbred.Value,?rgbgreen.Value,?rgbblue.Value)?''修改ne
wcolor色彩值?spl.TrueColor?=?newcolorElse?For?i?=?1?To?7?''七选一色彩?If?C
omboBox1.Value?=?colors(i)?Then?spl.color?=?i?Next?iEnd?Iftemp1?=
?linecolor.BackColorThisDrawing.Regen?Truebigcircle.Delete?''删除辅助线
smallcircle.Deletemovepoint.DeleteZoomExtentsThisDrawing.Regen?Tr
ueUserForm1.showEnd?SubFunction?caldist(point1,?point2)?''计算2点距离Di
m?x,?y,?z?x?=?point1(0)?-?point2(0)?y?=?point1(1)?-?point2(1)?z?=
?point1(2)?-?point2(2)?caldist?=?Sqr((Sqr((x?^?2)?+?(y?^?2))?^?2)
?+?(z?^?2))End?Function在窗体设计完成后，在左侧工程资源管理器窗口双击Thisdrawing，写1个通用Ru
n过程，以show方法打开它Sub?Run()?''显示窗体UserForm1.showEnd?Sub本课结束，本教程结束，希望大家
学习之路不会结束。思考题:设计1个窗体，植入您的12课思考题作业参考答案你懂的2.1以(4,2)为圆心，画5个同心圆，其半径为1-
5Sub?c5()?Dim?cc(0?To?2)?As?Doublecc(0)?=?4cc(1)?=?2For?i?=?1?To
?5?Call?ThisDrawing.ModelSpace.AddCircle(cc,?i)Next?iEnd?Sub3.1连续
画圆，由用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出Sub?anyc()Dim?p0?As?VariantDim?r?
As?VariantOn?Error?GoTo?Err_ControlDo?p0?=?ThisDrawing.Utility.Ge
tPoint(,?vbCr?&?"圆心:")?r?=?ThisDrawing.Utility.GetReal("半径：")?Cal
l?ThisDrawing.ModelSpace.AddCircle(p0,?r)LoopErr_Control:End?Sub3
.2画5根射线，第1点坐标（1，2），第2点坐标由用户依次输入Sub?l5()Dim?p1(0?To?2)?As?DoubleDi
m?p2?As?Variantp1(0)?=?1p1(1)?=?2For?i?=?1?To?5?p2?=?ThisDrawing.
Utility.GetPoint(p1,?vbCr?&?"第2点:")ThisDrawing.ModelSpace.AddRay
p1,?p2Next?iEnd?Sub4.1给程序设置正确的断点sub?test2()for?i=2?to?4?step?0.6?
for?j=-5?to?2?step?5.5??next?j''把断点设置在这行next?iend?subi=2j=-5,0
.5i=2.6j=-5,0.5……4.2画30个圆，圆心x坐标:x1=0,xn=3n，y坐标为0;半径r1=3,rn=r1+
3nSub?c30()Dim?cc(0?To?2)?As?DoubleFor?n?=?0?To?29?cc(i)?=?3??n?
r?=?3?+?3??n?Call?ThisDrawing.ModelSpace.AddCircle(cc,?r)Next?nE
nd?Sub5.1画一条黄色抛物线：y=0.5xx+3，其中x取值范围在正负50之间Sub?paraline()Dim?x?A
s?VariantDim?y?As?VariantDim?p(0?To?101)?As?Double?''共有51个点，需要102个
坐标值Dim?paral?As?AcadLWPolylineFor?i?=?0?To?100?Step?2?x?=?i?-?50?
y?=?0.1??x??x?+?3?p(i)?=?x?p(i?+?1)?=?yNext?iSet?paral?=?ThisDr
awing.ModelSpace.AddLightWeightPolyline(p)paral.color?=?2ZoomExte
ntsEnd?Sub5.2画1条红色直线，以原点为起点，终点极坐标为（10,3.14159/4）Sub?drawredline()
Dim?startpoint(2)?As?Double,?endpoint(2)?As?DoubleDim?redline?As?
AcadLinelingangle?=?3.14159?/?4endpoint(0)?=?endpoint(0)?+?Cos(li
ngangle)??10endpoint(1)?=?endpoint(1)?+?Sin(lingangle)??10Set?r
edline?=?ThisDrawing.ModelSpace.AddLine(startpoint,?endpoint)redl
ine.color?=?1End?Sub6.1显示1个对话框，提示今天距离高考（6月7日）还有几天Sub?calexamday()
today?=?Dateexamday?=?CDate("06-07-"?&?Year(Date))If?today?>?exam
day?Then?examday?=?CDate("06-07-"?&?Year(Date)?+?1)End?Ifdatestri
ng?=?Year(Date)?&?"年"?&?Month(Date)?&?"月"?&?Day(Date)?&?"日"txt?=?
"今天是"?&?datestring?&?vbCr?&?vbCrtxt?=?txt?&?"距离"?&?Year(examday)?
&?"年高考还有"txt?=?txt?&?examday?-?Date?&?"天"Call?MsgBox(txt,?0,?"加油吧
，骚年！")End?Sub7.1写出1-100平方表Sub?square100()Dim?mytxt?As?Object?''文字D
im?txtp(2)?As?Double?''文字位置坐标Dim?txtp2(2)?As?Double?''平方位置坐标xstep?=
?40?''列间距ystep?=?18?''行间距txtp(0)?=?0?''起始点横坐标txtp(1)?=?0?''起始点纵坐标For?
i?=?1?To?100?txt?=?i?&?"?"?&?"="?&?i??i?''文字内容?Set?mytxt?=?ThisDr
awing.ModelSpace.AddMText(txtp,?40,?txt)?''写文字?mytxt.Height?=?5?''改
变文字大小?mytxt.color?=?3?''绿色?txtp2(0)?=?txtp(0)?+?Len(i)??3.7?txtp2
(1)?=?txtp(1)?+?2?Set?mytxt?=?ThisDrawing.ModelSpace.AddMText(txt
p2,?6,?"2")?''写平方?txtp(0)?=?txtp(0)?+?xstep?''横坐标右移1列?mytxt.Height?
=?2.6?''改变文字大小?mytxt.color?=?3?''绿色?If?i?Mod?10?=?0?Then?''满10列换行?tx
tp(0)?=?0?''横坐标回到第1列?txtp(1)?=?txtp(1)?-?ystep?''纵坐标下移1行?End?IfNext
?iZoomExtentsEnd?Sub8.1新建3个图层，图层名和颜色分别是红色、黄色、绿色，把当前图层设置为红色图层Sub?a
dd3lays()Dim?nowlay?As?AcadLayerSet?nowlay?=?ThisDrawing.Layers.A
dd("黄色")nowlay.color?=?2Set?nowlay?=?ThisDrawing.Layers.Add("绿色")
nowlay.color?=?3Set?nowlay?=?ThisDrawing.Layers.Add("红色")nowlay.c
olor?=?1ThisDrawing.ActiveLayer?=?nowlayEnd?Sub9.1假设一张图里有1堆大大小小的圆
圈，找出半径小于10的圆，删掉Sub?delsmallball()Dim?allobj?As?AcadSelectionSetS
et?allobj?=?ThisDrawing.SelectionSets.Add("allobj")Call?allobj.Se
lect(acSelectionSetAll)objnum?=?allobj.CountFor?i?=?0?To?objnum?-
?1?If?allobj(i).Radius?色五角星，其外接圆的圆心为原点，半径为10Sub?star()Dim?lstar?As?ObjectDim?fitp(11)?As
?Doubler?=?10ang1?=?36ang2?=?18fitp(0)?=?0:?fitp(1)?=?r?''上顶点fitp(
2)?=?r??Sin(a2r(ang1))??-1?''左下角fitp(3)?=?r??Cos(a2r(ang1))??-
1fitp(4)?=?r??Cos(a2r(ang2))?''右上角fitp(5)?=?r??Sin(a2r(ang2))fit
p(6)?=?fitp(4)??-1:?fitp(7)?=?fitp(5)?''左上角fitp(8)?=?fitp(2)??-1
:?fitp(9)?=?fitp(3)?''右上角fitp(10)?=?fitp(0):?fitp(11)?=?fitp(1)?''最
后1点与上顶点重合Set?lstar?=?ThisDrawing.ModelSpace.AddLightWeightPolylin
e(fitp)lstar.color?=?1ZoomExtentsEnd?SubFunction?a2r(ang)?''转换角度的自
定义函数a2r?=?ang??3.14159?/?180End?Function10.2用Sendcommand方法画100个同
心圆Sub?c100bysendcommand()Dim?cc(2)?As?DoubleDim?commandstring?As?
Stringstringc0?=?"c"?&?vbCr?&?"0,0"?&?vbCrFor?i?=?1?To?100?comman
dstring?=?commandstring?&?stringc0?&?i??10?&?vbCrNext?iCall?This
Drawing.SendCommand(commandstring)End?Sub11.1在一条直线上画两个同样大小的圆，然后让这
两个圆沿直线相向而行，到互换位置后停下来，尺寸自定。Sub?moveball()Dim?bl?As?Object?''线Dim?c1
?As?Object,?c2?As?Object?''2个圆Dim?c1p(0?To?2)?As?Double?''第1个圆心Dim?
c2p(0?To?2)?As?Double?''第2个圆心Dim?c1startp?As?Variant?''移动时起点坐标Dim?c
1endp?As?Variant?''移动时终点坐标Dim?movx?As?Variant?''x轴增量Dim?movy?As?Var
iant?''y轴增量Dim?movetimes?As?Integer?''移动次数c1p(0)?=?1:??c1p(1)?=?1?''
圆心c2p(0)?=?20:?c2p(1)?=?3r?=?1?''半径Set?c1?=?ThisDrawing.ModelSpace
.AddCircle(c1p,?r)Set?c2?=?ThisDrawing.ModelSpace.AddCircle(c2p,?
r)Set?bl?=?ThisDrawing.ModelSpace.AddLine(c1p,?c2p)?''圆心连线bl.Offse
t?(0?-?r)?''往下偏移bl.Delete?''删除圆心连线ZoomExtentsmovetimes?=?100?''次数mov
x?=?(c2p(0)?-?c1p(0))?/?movetimesmovy?=?(c2p(1)?-?c1p(1))?/?movet
imesc1startp?=?c1p:?c1endp?=?c2pc2startp?=?c2p:?c2endp?=?c1pFor?i
?=?1?To?movetimes?''开始移动?c1endp(0)?=?c1startp(0)?+?movx?c1endp(1)?
=?c1startp(1)?+?movy?c1.Move?c1startp,?c1endp?c1.Update?c2endp(0)
?=?c2startp(0)?-?movx?c2endp(1)?=?c2startp(1)?-?movy?c2.Move?c2st
artp,?c2endp?c2.UpdateNextEnd?Sub12.1设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序
中用半圆法画近似螺旋线，由用户输入圈数和中心，圆弧起始半径为10，增量为5Sub?helixbyarc()Dim?c?As?Var
iantpi?=?3.14159arcwaver?=?1?''摇摆数r?=?10addr?=?5n?=?ThisDrawing.Ut
ility.GetReal("圈数")c?=?ThisDrawing.Utility.GetPoint(,?"中心:")For?i
?=?1?To?n??2?Call?ThisDrawing.ModelSpace.AddArc(c,?r,?IIf(arcwav
er?=?1,?0,?pi),?IIf(arcwaver?=?1,?pi,?0))?c(0)?=?c(0)?+?addr??ar
cwaver?arcwaver?=?arcwaver??-1?r?=?r?+?addrNext?iEnd?Sub13.1画一个简
易路灯块，用属性块作为路灯编号，由用户点选路灯位置，程序画路灯时自动为路灯编号Option?ExplicitSub?streetl
amp()Dim?lamplay?As?AcadLayer?''路灯图层Dim?lampblock?As?AcadBlock?''块变
量Dim?lc(0?To?2)?As?Double?''圆心Dim?pline(0?To?7)?As?Double?''多段线Dim?
basep(0?To?2)?As?Double?''块基点Dim?lampnumberpoint(0?To?2)?As?Double
?''块属性插入点Dim?p1?As?Variant?''块插入点位置Dim?mytxt?As?AcadTextStyle?''mytx
t变量为文本样式Dim?blockRef?As?AcadBlockReference?''定义块属性变量Dim?Attr1?As?V
ariant?''插入块属性变量1Dim?getAttr?As?Variant?''获取属性变量Dim?element?As?Vari
ant?''选择集遍历对象Dim?pstring?As?String?''定点提示词Dim?lampname?As?String?''块
名Dim?i?As?Integerlampname?=?"路灯"For?i?=?0?To?ThisDrawing.Blocks.C
ount?-?1?''查找旧块?Set?lampblock?=?ThisDrawing.Blocks.Item(i)?If?lamp
block.Name?=?lampname?Then?GoTo?insblock?''路灯块已存在，跳转到插入快Next?iSet?
lampblock?=?ThisDrawing.Blocks.Add(basep,?lampname)?''新建一个"路灯"块Cal
l?lampblock.AddCircle(lc,?5)?''块里画个圆代表灯pline(0)?=?0:?pline(1)?=?5p
line(2)?=?0:?pline(3)?=?8pline(4)?=?13:?pline(5)?=?8pline(6)?=?13
:?pline(7)?=?-52Call?lampblock.AddLightWeightPolyline(pline)??''电线
杆子Dim?p(0?To?2)?As?Double?''定义坐标变量Set?mytxt?=?ThisDrawing.TextStyl
es.Add("mytxt")?''添加mytxt样式mytxt.fontFile?=?"c:\windows\fonts\simf
ang.ttf"?''设置字体文件为仿宋体ThisDrawing.ActiveTextStyle?=?mytxt?''将当前文字样式设
置为mytxtlampnumberpoint(0)?=?3?''块属性位置lampnumberpoint(1)?=?-50Set?A
ttr1?=?ThisDrawing.ModelSpace.AddAttribute(10,?acAttributeModeNor
mal,?"号码",?lampnumberpoint,?"X",?0)?''画块属性Attr1.Alignment?=?7?''居中A
ttr1.TextAlignmentPoint?=?lampnumberpoint?''重定义对齐点Dim?objCollectio
n(0?To?0)?As?Object?''创建选择集Set?objCollection(0)?=?Attr1?''属性1加入选择集C
all?ThisDrawing.CopyObjects(objCollection,?lampblock)?''把选择集加入块中Fo
r?Each?element?In?objCollection?''在选择集中进行循环?element.Delete?''删除属性(此
操作并不影响已创建的块)NextSet?lamplay?=?ThisDrawing.Layers.Add(lampname)?''新
建图层lamplay.color?=?2?''为黄色ThisDrawing.ActiveLayer?=?lamplay?''将当前图层
设置为lampname图层insblock:?''开始插入块i?=?1On?Error?Resume?NextDo?pstring?
=?CStr(i)?&?"号路灯位置："?p1?=?ThisDrawing.Utility.GetPoint(,?pstring)
?''点选位置坐标?Set?blockRef?=?ThisDrawing.ModelSpace.InsertBlock(p1,?la
mpname,?1,?1,?1,?0)?''插入块?If?Err.Number?<>?0?Then?''如果输入有误，退出?Err.C
lear?Exit?Do?End?If?getAttr?=?blockRef.GetAttributes?''获取块属性?getAt
tr(0).TextString?=?CStr(i)?''赋值路灯编号?i?=?i?+?1LoopEnd?Sub14.1根据“圈圈.
xlsx”文件中记录的数据画出圆圈Sub?drawballfromxls()Dim?newball?As?AcadCircle?''
圆Dim?p(0?To?2)?As?Double?''插入点Dim?excelapp?As?Excel.Application?''定
义excle应用程序变量Dim?excelsheet?As?worksheet?''定义工作表变量Set?excelapp?=?Cr
eateObject("excel.application")??''激活excel程序excelapp.Workbooks.Ope
n?("圈圈.xlsx")?''打开工作薄Set?excelsheet?=?excelapp.ActiveWorkbook.Shee
ts("sheet1")?''当前工作表为sheet1corow?=?excelsheet.UsedRange.Rows.Count
?''计算工作表的总行数For?i?=?1?To?corow?p(0)?=?excelsheet.Cells(i,?1).Value
?''插入点坐标?p(1)?=?excelsheet.Cells(i,?2).Value?Set?newball?=?ThisDra
wing.ModelSpace.AddCircle(p,?excelsheet.Cells(i,?3).Value)?newbal
l.color?=?excelsheet.Cells(i,?4).ValueNext?iexcelapp.Quit?''退出exce
l程序Set?excelapp?=?Nothing?''释放变量Set?excelsheet?=?NothingEnd?Sub15.
1参考本课例程画颜色统计表，统计红黄绿(色号分别为1，2，3)等3种颜色圈圈Sub?countcirclecolor()Dim?a
llobj?As?AcadSelectionSet?''定义选择集对象Dim?countc(1?To?3)?As?Integer?''
此数组存放3种颜色数量Dim?MyTable?As?AcadTable?''定义表格Dim?pt1(2)?As?Double?''表格
插入点Dim?pt2(2)?As?Double?''表格右下角坐标Dim?colortxt(1?To?3)?As?String?''定
义标题文字Set?allobj?=?ThisDrawing.SelectionSets.Add(CStr(Now()))?''新建一
个选择集Call?allobj.Select(acSelectionSetAll)?''选中全部图元objnum?=?allobj.
Count?''计算选择集中的图元数sumball?=?0?''合计For?i?=?0?To?objnum?-?1?objname?=
?allobj(i).ObjectName?''获取当前图元名称?If?objname?=?"AcDbCircle"?Then?''确
认这货是圆圈儿?colorkide?=?allobj(i).color??''获取色号?If?colorkide?>?0?And?c
olorkide?+1?End?If?End?IfNext?ipt1(0)?=?2000?''左上角坐标pt1(1)?=?-50Set?MyTable
?=?ThisDrawing.ModelSpace.AddTable(pt1,?6,?3,?100,?300)Call?MyTab
le.SetColumnWidth(0,?70)?''修改第1列宽度Call?MyTable.SetAlignment(1,?acM
iddleCenter)?''居中对齐For?i?=?1?To?5?For?j?=?0?To?2?Call?MyTable.SetC
ellTextHeight(i,?j,?20)?''修改表内文字高度?Next?jNext?i''写入标题栏Call?MyTable.
SetText(0,?0,?"颜色统计表")Call?MyTable.SetCellTextHeight(0,?0,?30)Cal
l?MyTable.SetText(1,?0,?"序号")Call?MyTable.SetText(1,?1,?"颜色")Call
?MyTable.SetText(1,?2,?"数量")Call?MyTable.SetText(5,?0,?"合计")color
txt(1)?=?"红色"colortxt(2)?=?"黄色"colortxt(3)?=?"绿色"For?i?=?1?To?3?''
写入表格数据?Call?MyTable.SetText(i?+?1,?0,?i)?''写序号?Call?MyTable.SetTex
t(i?+?1,?1,?colortxt(i))?''写规格?Call?MyTable.SetText(i?+?1,?2,?coun
tc(i))?''写数量Next?iFor?i?=?2?To?4?sumball?=?sumball?+?MyTable.GetTe
xt(i,?2)?''合计Next?iCall?MyTable.MergeCells(5,?5,?0,?1)?''合并单元格Call?
MyTable.SetText(5,?2,?sumball)pt2(0)?=?pt1(0)?+?MyTable.Width?''表格
宽度pt2(1)?=?pt1(1)?-?MyTable.Height?''表格高度ZoomWindow?pt1,?pt2?''窗口绽放
，以表格尺寸为准ZoomScaled?0.8,?acZoomScaledRelative?''显示80%比例End?Sub16.1用
随机色在500500空间内随机画100个半径为5的圆，随机选择其中50个圆切割成半圆，切割方向也选用随机数。Sub?cutcir
cles()Dim?myc(0?To?99)?As?AcadCircle?''100个圆Dim?myarc?As?AcadArc?''
弧Dim?myline?As?AcadLine?''线Dim?cc(0?To?2)?As?Double?''圆心坐标Dim?cnum(
0?To?49)?''存放选出50个圆的编号For?i?=?0?To?99?''随机画100个圆cc(0)?=?490??Rnd?+
?5:?cc(1)?=?490??Rnd?+?5?''设置圆心xy坐标值为5-495之间Set?myc(i)?=?ThisDraw
ing.ModelSpace.AddCircle(cc,?5)myc(i).color?=?Int(Rnd??250)?''随机色
Next?i''开始选择待切圆编号Randomize?''先来个随机数种子For?i?=?0?To?49?''需要计算50个随机数?cn
um(i)?=?Int(Rnd??100)?''0-100随机整数为当前编号?For?j?=?0?To?i?-?1?''将当前编号与
已选编号比较?If?cnum(j)?=?cnum(i)?Then?''编号重复?i?=?i?-?1?''此编号无效，i再来1次?Exi
t?For?''跳出j循环?End?If?Next?jNext?i''开始切圆For?i?=?0?To?49?cc(0)?=?myc(
cnum(i)).Center(0)?''获取圆心坐标?cc(1)?=?myc(cnum(i)).Center(1)?bbb?=?m
yc(cnum(i)).color?''获取颜色?ang1?=?Rnd()??360?''随机角度?ang2?=?ang1?+?18
0?ang1?=?ThisDrawing.Utility.AngleToReal(ang1,?0)?''数据转换?ang2?=?Th
isDrawing.Utility.AngleToReal(ang2,?0)?Set?myarc?=?ThisDrawing.Mo
delSpace.AddArc(cc,?5,?ang1,?ang2)?''画弧?Set?myline?=?ThisDrawing.M
odelSpace.AddLine(myarc.StartPoint,?myarc.EndPoint)?''画线?myarc.col
or?=?myc(cnum(i)).color?''上色?myline.color?=?myarc.color?myc(cnum(i
)).Delete?''删除圆Next?iZoomExtentsEnd?Sub16.2以（1,2）为圆心，半径为10画圆，以（20,
30）（40,-50）为端点画线，然后画出圆和线的红色公切圆。Sub?cltan()Dim?cc(2)?As?Double,?cc
2?As?VariantDim?circle1?As?AcadCircle,?line1?As?AcadLineDim?circl
e2?As?AcadCircle,?line2?As?AcadLineDim?p1(2)?As?Double,?p2(2)?As?
Doublecc(0)?=?1:?cc(1)?=?2Set?circle1?=?ThisDrawing.ModelSpace.Ad
dCircle(cc,?10)p1(0)?=?20:?p1(1)?=?30p2(0)?=?40:?p2(1)?=?-50Set?l
ine1?=?ThisDrawing.ModelSpace.AddLine(p1,?p2)roang?=?ThisDrawing.
Utility.AngleFromXAxis(p1,?p2)?+?3.14156?/?2Set?line2?=?addlineby
polar(cc,?100,?roang)?''以极坐标画辅助线intersectsp?=?line2.IntersectWith(
circle1,?acExtendNone)?''圆线交点p1(0)?=?intersectsp(0):?p1(1)?=?inter
sectsp(1)intersectsp?=?line2.IntersectWith(line1,?acExtendNone)?''
线线交点p2(0)?=?intersectsp(0):?p2(1)?=?intersectsp(1)line2.startpoin
t?=?p1:?line2.endpoint?=?p2?''剪切一下cc2?=?midpinline(line2)?''它的中点即公切
圆的圆心Set?circle2?=?ThisDrawing.ModelSpace.AddCircle(cc2,?line2.Len
gth?/?2)?''公切圆circle2.color?=?acRedline2.DeleteEnd?SubFunction?mid
pinline(whichline?As?AcadLine)?''找出线儿的中点Dim?temp(2)?As?Doubletemp(
0)?=?(whichline.startpoint(0)?+?whichline.endpoint(0))?/?2temp(1)
?=?(whichline.startpoint(1)?+?whichline.endpoint(1))?/?2temp(2)?=
?(whichline.startpoint(2)?+?whichline.endpoint(2))?/?2midpinline?
=?tempEnd?FunctionFunction?addlinebypolar(p1,?dist,?ang)?As?AcadL
ine?''以极坐标画线Dim?tempp2(2)?As?Doubletempp2(0)?=?p1(0)?+?Cos(ang)??
disttempp2(1)?=?p1(1)?+?Sin(ang)??distSet?addlinebypolar?=?ThisD
rawing.ModelSpace.AddLine(p1,?tempp2)End?Function17.1修改本教程第1课的代码，
填充蓝绿相间的颜色Sub?hatchc100()Dim?cc(0?To?2)?As?Double,?mycircle(0?To?9
9)?As?AcadCircleDim?hatchannulus?As?AcadHatchDim?htemp1(0)?As?Obj
ect,?htemp2(0)?As?Objectcc(0)?=?1000:?cc(1)?=?1000:?cc(2)?=?0For?i?=?1?To?1000?Step?10?''开始循环?Set?mycircle((i?-?1)?/?10)?=?ThisDrawing.ModelSpace.AddCircle(cc,?i??10)?''画圆Next?iSet?hatchannulus?=?ThisDrawing.ModelSpace.AddHatch(0,?"solid",?True)''建填充对象hatchannulus.color?=?acGreen''最里层圆填绿色Set?htemp1(0)?=?mycircle(0)hatchannulus.AppendOuterLoop?htemp1?''最里层边界For?i?=?0?To?98?Set?htemp1(0)?=?mycircle(i)?Set?htemp2(0)?=?mycircle(i?+?1)?Set?hatchannulus?=?ThisDrawing.ModelSpace.AddHatch(0,?"solid",?True)?''建填充对象?If?i?Mod?2?=?0?Then?''以i值算颜色，奇蓝偶绿?hatchannulus.color?=?acBlue?Else?hatchannulus.color?=?acGreen?End?If?hatchannulus.AppendInnerLoop?htemp1?''内边界?hatchannulus.AppendOuterLoop?htemp2?''外边界Next?iZoomExtents?''显示整个图形End?Sub17.2画标准的五星红旗Sub?nationalflag()Dim?o(2)?As?Double?''原点Dim?flagp2(2)?As?Double?''旗子右下角Dim?flagbox(0)?As?AcadLWPolyline?''旗子框Dim?starc(2)?As?Double?''大星中心Dim?bigstar(0)?As?AcadLWPolyline?''大星Dim?smallstarc(2)?As?Double?''小星中心Dim?smallstar(3)?As?AcadLWPolyline?''4个小星Dim?regflag?As?AcadHatch,?yellowstar?As?AcadHatch?''2个填充fwidth?=?960?''宽度fheight?=?640?''高度Unit?=?fwidth?/?30?''小格子尺寸''旗子外框flagp2(0)?=?o(0)?+?fwidthflagp2(1)?=?o(1)?-?fheightSet?flagbox(0)?=?drawbox(o,?flagp2)flagbox(0).color?=?1''画大星starc(0)?=?o(0)?+?5??Unitstarc(1)?=?o(1)?-?5??UnitSet?bigstar(0)?=?star5(starc,?Unit??3)''画4个小星星smallstarc(0)?=?o(0)?+?10??Unitsmallstarc(1)?=?o(1)?-?2??UnitSet?smallstar(0)?=?drawsmallstar(starc,?smallstarc,?Unit)smallstarc(0)?=?o(0)?+?12??Unitsmallstarc(1)?=?o(1)?-?4??UnitSet?smallstar(1)?=?drawsmallstar(starc,?smallstarc,?Unit)smallstarc(1)?=?o(1)?-?7??UnitSet?smallstar(2)?=?drawsmallstar(starc,?smallstarc,?Unit)smallstarc(0)?=?o(0)?+?10??Unitsmallstarc(1)?=?o(1)?-?9??UnitSet?smallstar(3)?=?drawsmallstar(starc,?smallstarc,?Unit)''填色Set?redflag?=?ThisDrawing.ModelSpace.AddHatch(0,?"solid",?True)redflag.color?=?1Set?yellowstar?=?ThisDrawing.ModelSpace.AddHatch(0,?"solid",?True)yellowstar.color?=?2redflag.AppendOuterLoop?flagboxredflag.AppendInnerLoop?bigstaryellowstar.AppendOuterLoop?bigstarDim?tempstar(0)?As?ObjectFor?i?=?0?To?3?Set?tempstar(0)?=?smallstar(i)?redflag.AppendInnerLoop?tempstar?yellowstar.AppendOuterLoop?tempstar?tempstar(0).DeleteNext?ibigstar(0).DeleteZoomExtentsEnd?SubFunction?drawbox(p1,?p2)?As?AcadLWPolyline?''用对角线画矩形Dim?boxp(0?To?7)?As?Doubleboxp(0)?=?p1(0):?boxp(1)?=?p1(1)boxp(2)?=?p1(0):?boxp(3)?=?p2(1)boxp(4)?=?p2(0):?boxp(5)?=?p2(1)boxp(6)?=?p2(0):?boxp(7)?=?p1(1)Set?drawbox?=?ThisDrawing.ModelSpace.AddLightWeightPolyline(boxp)drawbox.Closed?=?TrueEnd?FunctionFunction?star5(staro,?r)''空心五角星Dim?p1(2)?As?Double,?p2(2)?As?DoubleDim?po1?As?AcadPoint,?po2?As?AcadPoint?''2个辅助点Dim?line1?As?AcadLine,?line2?As?AcadLine?''辅助线Dim?outsidepo?As?Variant,?insidepo?As?Variant?''5个外点，5个内点Dim?pnts(0?To?19)?As?Double?''需要10个顶点p1(0)?=?staro(0)?''上顶点p1(1)?=?staro(1)?+?rSet?po1?=?ThisDrawing.ModelSpace.AddPoint(p1)outsidepo?=?po1.ArrayPolar(6,?3.14159??2,?staro)?''阵列为五个外点Set?line1?=?ThisDrawing.ModelSpace.AddLine(outsidepo(1).Coordinates,?outsidepo(4).Coordinates)?''左斜线Set?line2?=?ThisDrawing.ModelSpace.AddLine(outsidepo(0).Coordinates,?outsidepo(3).Coordinates)?''水平线intersectsp?=?line1.IntersectWith(line2,?acExtendNone)?''两线交点为1个内点Set?po2?=?ThisDrawing.ModelSpace.AddPoint(intersectsp)insidepo?=?po2.ArrayPolar(6,?3.14159??2,?staro)?''阵列为五个内点j?=?0For?i?=?0?To?4?''将10个点坐标依次存入多段线数组?temp?=?outsidepo(i).Coordinates?pnts(j)?=?temp(0)?pnts(j?+?1)?=?temp(1)?temp?=?insidepo(i).Coordinates?pnts(j?+?2)?=?temp(0)?pnts(j?+?3)?=?temp(1)?insidepo(i).Delete?outsidepo(i).Delete?j?=?j?+?4Next?iSet?star5?=?ThisDrawing.ModelSpace.AddLightWeightPolyline(pnts)star5.Closed?=?Truepo1.Delete:?po2.Deleteline1.Delete:?line2.DeleteEnd?FunctionFunction?drawsmallstar(bigstarc,?smallstarc,?r)?''画小五角星Set?drawsmallstar?=?star5(smallstarc,?r)roangle?=?ThisDrawing.Utility.AngleFromXAxis(bigstarc,?smallstarc)?+?3.14159?/?2drawsmallstar.Rotate?smallstarc,?roangleEnd?Function18.1用三点法画圆，3点坐标分别为(0,0)(1,2)(3,4)，标注直径Sub?drawcircle()Dim?p1(2)?As?Double,?p2(2)?As?Double,?p3(2)?As?DoubleDim?dimp1(2)?As?Double,?dimp2(2)?As?Double,?o(2)?As?DoubleDim?mycircle?As?AcadCirclep2(0)?=?1:?p2(1)?=?2p3(0)?=?3:?p3(1)?=?4Set?mycircle?=?addcircleby3p(p1,?p2,?p3)r?=?mycircle.Radius?''半径o(0)?=?mycircle.Center(0)?''圆心o(1)?=?mycircle.Center(1)''标注直径dimp1(0)?=?o(0)?+?r:?dimp1(1)?=?o(1)dimp2(0)?=?o(0)?-?r:?dimp2(1)?=?o(1)Call?ThisDrawing.ModelSpace.AddDimDiametric(dimp1,?dimp2,?1)End?SubFunction?addcircleby3p(p1,?p2,?p3)?As?AcadCircleDim?cc(2)?As?Double,?newcircle?As?AcadCircleDim?line1p1?As?Variant,?line2p2?As?VariantDim?line1?As?AcadLine,?line2?As?AcadLinepi?=?ThisDrawing.Utility.AngleToReal(180,?0)line1p1?=?midpoint(p1,?p2)ang1?=?ThisDrawing.Utility.AngleFromXAxis(p1,?p2)?+?pi?/?2Set?line1?=?addlinebypolar(line1p1,?1,?ang1)?''1、2点的中垂线line2p1?=?midpoint(p1,?p3)ang1?=?ThisDrawing.Utility.AngleFromXAxis(p1,?p3)?+?pi?/?2?''1、3点的中垂线Set?line2?=?addlinebypolar(line2p1,?1,?ang1)intersectsp?=?line1.IntersectWith(line2,?acExtendBoth)?''中垂线交点为圆心cc(0)?=?intersectsp(0):?cc(1)?=?intersectsp(1)Set?addcircleby3p?=?ThisDrawing.ModelSpace.addcircle(cc,?distance(cc,?p1))line1.Deleteline2.Delete?''删除辅助线End?FunctionFunction?midpoint(pt1,?pt2)?''2点间的中点Dim?temp(2)?As?Doubletemp(0)?=?(pt1(0)?+?pt2(0))?/?2temp(1)?=?(pt1(1)?+?pt2(1))?/?2temp(2)?=?(pt1(2)?+?pt2(2))?/?2midpoint?=?tempEnd?FunctionFunction?addlinebypolar(p1,?dist,?ang)?As?AcadLine?''以极坐标画线Dim?tempp2(2)?As?Double,?newline?As?AcadLinetempp2(0)?=?p1(0)?+?Cos(ang)??disttempp2(1)?=?p1(1)?+?Sin(ang)??distSet?newline?=?ThisDrawing.ModelSpace.AddLine(p1,?tempp2)Set?addlinebypolar?=?newlineEnd?FunctionFunction?distance(pt1,?pt2)?''计算2点间距离x?=?pt1(0)?-?pt2(0)y?=?pt1(1)?-?pt2(1)distance?=?Sqr((Sqr((x?^?2)?+?(y?^?2))?^?2))End?Function18.2在300300空间内随机位置画10个半径为10的圆，标注圆心坐标Sub?dimcc()Dim?cc(0?To?2)?As?Double,?dimpoint1(2)?As?DoubleDim?txtobj?As?AcadMTextDim?pointsarray(0?To?8)?As?DoubleDim?oldlay?As?AcadLayer,?newlay?As?AcadLayerSet?oldlay?=?ThisDrawing.ActiveLayerSet?newlay?=?ThisDrawing.Layers.Add("标注")newlay.color?=?3r=10For?i?=?1?To?10?cc(0)?=?280??Rnd?+?10:?cc(1)?=?280??Rnd?+?10?Call?ThisDrawing.ModelSpace.AddCircle(cc,?r)?pointsarray(0)?=?cc(0):?pointsarray(1)?=?cc(1)?pointsarray(3)?=?cc(0)?+?8:?pointsarray(4)?=?cc(1)?+?8?pointsarray(6)?=?cc(0)?+?28:?pointsarray(7)?=?cc(1)?+?8?dimpoint1(0)?=?cc(0)?+?10:?dimpoint1(1)?=?cc(1)?+?12?ThisDrawing.ActiveLayer?=?newlay?string1?=?ThisDrawing.Utility.RealToString(cc(0),?2,?3)?string2?=?ThisDrawing.Utility.RealToString(cc(1),?2,?3)?txtstring?=?"x="?&?string1?&?"?y="?&?string2?Call?ThisDrawing.ModelSpace.AddMText(dimpoint1,?15,?txtstring)Set?txtobj?=?Nothing?Call?ThisDrawing.ModelSpace.AddLeader(pointsarray,?txtobj,?acLineNoArrow)?ThisDrawing.ActiveLayer?=?oldlayNext?iEnd?Sub19.1新建1个名为“layoutO”的布局，设置其视口中心点为原点，比例为0.1Sub?newlayoutoforigin()Dim?O(2)?As?DoubleSet?newlayout?=?ThisDrawing.Layouts.Add("layoutO")?''新建布局ThisDrawing.ActiveLayout?=?newlayout?''设为当前活动布局Set?newvport?=?ThisDrawing.PaperSpace.Item(1)?''这是布局中的默认视口ThisDrawing.MSpace?=?True?''允许编辑浮动视口ThisDrawing.ActivePViewport?=?newvport?''设为当前视口ZoomCenter?O,?1?''以原点为中心缩放newvport.CustomScale?=?2?''调整比例ThisDrawing.MSpace?=?False?''不再编辑浮动视口End?Sub20.1略AutoCAD初级教程AutoCAD初级教程102AutoCAD初级教程1 |
|
