AutoCAD VBA二次开发初级教程

bulish

一个AutoCAD VBA二次开发初级教程，包括一些基本知识以及简单的编程、数据转换、写文字、还有简单的参数化设计。是刚接触AutoCAD VBA二次开发时很好的入门教程。

powerpeak

正在打算学习二次开发的部分
+ S/ K) P6 s7 @1 m8 H- t% L1 m% e' N谢谢楼主

wordcad

下来学习一下先,多谢楼主分享.

xiaoship

谢谢楼主对初学者的照顾，呵呵

hqzoe

真是多谢正好需要

tanlihua

找了了久,终于找到了

sky121

下载了 看一看 是不是我想要的

wuqitao0000

下来学习学习,多谢楼主分享.

echo7411

谢谢哈   呵呵 很好用啊

ytcadtools

好久没有VB了，下来看看，谢谢楼主

wsj249201

Autocad VBA初级教程 (第一课:入门)

2 {4 _5 c: _6 f, h9 d第一课：入门
7 J: s3 Y& a+ w' z
1.为什么要写这个教程
# r' x$ z4 T& [) D" J7 E市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。

2.什么是Autocad VBA？
  g9 d) D& D: L5 R' ~VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。

& _, ^0 E9 U0 ?' F# l3、VBA有多难？
相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。

3 X0 ]0 }) m% Q4、怎样学习VBA？
9 q! G$ T& D; Y$ P, E) w介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。

5、现在我们开始编写第一个程序：画一百个同心圆
第一步：复制下面的红色代码
! }# \' Z: }2 a! M& }第二步：在模型空间按快捷键Alt+F8，出现宏窗口
第三步：在宏名称中填写C100，点“创建”、“确定”
7 P, t2 S: Y" e8 X0 C3 ]) N( T8 U3 ?/ N第四步：在Sub c100()和End Sub之间粘贴代码
第五步：回到模型空间，再次按Alt+F8，点击“运行”

2 @# N( A$ N$ Z# l3 M  p: g: `Sub c100()
. T" [  m0 W. R9 l+ WDim cc(0 To 2) As Double '声明坐标变量
* L+ u) k( F3 i( _: }3 z" C1 ncc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
& L! j8 u  {* `6 a" XFor i = 1 To 1000 Step 10 '开始循环
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
Next i
End Sub
" |- y3 A1 S  Z
也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

wsj249201

第二课  编程基础
8 N- m& K+ I8 M, y本课主要任务是对上一课的例程进行详细分析
下面是源码：
Sub c100()
Dim cc(0 To 2) As Double '声明坐标变量
! V+ ^/ a' v: n" Q! C+ F2 _0 j( E- acc(0) = 1000 '定义圆心座标
cc(1) = 1000
/ m- G4 H1 {' A, t. |3 gcc(2) = 0
* f* N2 L. m$ ]" t) H5 tFor i = 1 To 1000 Step 10 '开始循环
/ h) ?, Y* c- }" I5 e% v  Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
Next i
End Sub
! S- U; x/ h* S9 o8 y- I  r" X先看第一行和最后一行：
! i6 B1 A" ^9 }Sub C100()
7 `0 P3 h7 s$ b! W5 W: C……
: K% w9 Z' p! z; z2 IEnd Sub
/ `1 P" `5 ?. C2 T; j" k/ xC100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub　和end sub之间的所有指令。
& C# s( k' l/ z/ L! p第二行：
Dim cc(0 To 2) As Double '声明坐标变量
后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注释，越详细越好，对于程序员来说，这是一个好习惯。
0 _% a8 h# i" p7 a( e电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double
1 S/ m! ~0 ]2 t, e1 C! S; f* A; F它的作用就是声明变量。
" e4 ?3 z- W* n+ tDim是一条语句，可以理解为计算机指令。
' M) }% F5 Y3 T% t1 m7 ]) t0 _它的语法：Dim变量名 As 数据类型
本例中变量名为CC，而括号中的0 to 2声明这个CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、CC(2)，如果改为CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了这个数组，就可以把坐标数值放到这个变量之中。
- K& Y- N1 N" K) l) HDouble是数据类型中的一种。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD中数据类型的有很多，下面两个是比较常用的数据类型，初学者要有所理解。
2 T# K. B  }/ x' B7 kLong（长整型），其范围从 -2,147,483,648 到 2,147,483,647。
Variant  它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常用的。
下面三条语句
5 T# b4 a4 u2 s4 F# b7 u- Gcc(0) = 1000 '定义圆心座标
0 a  ~3 q. g) H1 T' C6 v' Qcc(1) = 1000
cc(2) = 0
它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z坐标。

5 t! C8 u* x& fFor i = 1 To 1000 Step 10 '开始循环
1 t& J* H! f4 S! ]……
Next i  '结束循环
这两条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到 1000时，结束循环。
i也是一个变量，虽然没有声明i变量，程序还是认可的，VB不是C语言，每用一个变量都要声明，不声明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很长，那就会出现一些意想不到的错误。
step后面的数值就是每次循环时增加的数值，step后也可以用负值。
例如：For i =1000 To 1 Step -10
- L0 L+ T0 U- q- M& A  i很多情况下，后面可以不加step 10
" c2 @/ U4 F# v; Y4 L# z如：For i=1 to 100，它的作用是每循环一次i值就增加1
Next i语句必须出现在需要结束循环的位置，不然程序没法运行。
$ s! C* l/ J1 Q0 ^4 `! W下面看画圆命令：
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
Call语句的作用是调用其他过程或者方法。
ThisDrawing.ModelSpace是指当前CAD文档的模型空间
. W* m8 p; l$ a+ T6 M: [. C0 AAddCircle是画圆方法
2 C0 x2 u. ~9 oAddcicle方法需要两个参数：圆心和半径
3 \( G7 b* V# ?1 t/ |; fCC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310……
本课到此结束，下面请完成一道思考题：
1.以(4,2)为圆心，画5个同心圆，其半径为1-5

wsj249201

第三课 编程基础二

9 P# I; P; y3 c( o5 K 有一位叫自然9172的网友提出了下面的问题：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入
2 I' ^1 x9 C$ K# `/ w0 D: {, k本课将讲解这个问题。

为了简化程序，这里用多条直线来代替多段线。以下是源码：
Sub myl()
! }. q" N# Y1 z; {/ U. H# oDim p1 As Variant '申明端点坐标
4 l% R7 o, [- M+ vDim p2 As Variant
+ y5 W4 ^& A2 [4 F) E" B3 a: Rp1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
9 S, |# V0 P4 Ep1(2) = z '将Z坐标值赋予点坐标中
( n: K- W8 T2 n3 P) U& COn Error GoTo Err_Control '出错陷井
: U9 u/ ~0 D7 j5 T" d' `9 YDo '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
# `4 M: E4 n. {/ ]8 r; }  p2(2) = z '将Z坐标值赋予点坐标中
% ]9 t4 e: b1 h! B% s" t  Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
6 c0 f! B, S- ?  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
/ U& ]1 I8 o& @. V4 j4 qLoop
' P# E* ~5 [- D# h+ @# HErr_Control:
End Sub

先谈一下本程序的设计思路：
1、获取第一点坐标
* _; c; U8 b  z/ l+ E/ p% }& G7 s2、输入第一点Z坐标
3、获取第二点坐标
7 j* q, A" w8 m8 e7 m; S7 V4、输入第二点Z坐标
2 v! a) p9 J, ~$ A! r3 u8 o5、以第一、二点为端点，画直线
% t, X, ~) [$ p, T7 p& A& R7 d6、下一条线的第一点=这条线的第二点
7、回到第3步进行循环
" N; f9 A4 q1 o; T2 _如果用户没有输入坐标或Z值，则程序结束。
3 q2 A* q7 t. B0 _2 q+ h2 d9 r
6 E: Y# s; a4 Y8 u$ g首先看以下两条语句：
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标
……
p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
) j1 G. A5 x# J' L  n' Z( e+ \# K这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。ThisDrawing.Utility.GetPoint（）在ACAD中这是最常用的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。
( m4 X- ]- C; \逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。
VbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”
9 e1 R, z3 d* q- X* W/ A&的作用是连接字符。举例：
“爱我中华 ”&”抵制日货 ”&”从我做起”
5 _4 O1 m2 I* z; D
) s* T# W7 _. G5 m2 t; q8 }, Fz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
. v# W; v/ e$ l! r& k2 w" x+ U) N3 l由用户输入一个实数
. r- q9 i8 X- A
+ I! M3 y% d" GOn Error GoTo Err_Control '出错陷井
& [& w" a6 C) z7 V! u……
Err_Control:
On Error是出错陷井语句，在程序出错时将执行On Error 后面的语句
' ?* S9 F" K2 {6 D: T* ^; D% qGoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句，本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。

Do '开始循环
……
Loop ‘结束循环
/ U) X  r8 D8 [% a) c, }) A这个循环就历害了，它会无休止地进行循环，好在本例中已经有了一个出错陷井，当用户输入回车时，由于程序没有得到点或坐标，程序出错，跳出循环，中止程序。如果要人为控制跳出循环，可以在代码中用Exit Do语句跳出循环。在For 变量 和Next 变量之间如果要跳出循环，那么只要在循环体内加一个Exit for 就可以跳出循环，关于这方面的例程以后会讲到。

3 i7 X( P% n8 {/ L  g) X$ ?! RCall ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
! i! {% g6 @/ V画直线方法也是很常用的，它的两个参数是点坐标变量
1 A7 ?9 e, M( |! M: e1 g: M
9 V/ U5 T" {) a: y本课到此结束，请做思考题：
9 N! Z3 \# H, }/ y+ S$ n( J连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出

( |2 @' n2 l$ s. @第四课 程序的调试和保存
# b* w' j2 j; Z

人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，随着学习的深入，以后我们需要经常进行程序调试。事实上，对于那些资深程序员来说，调试程序也是一项不可或缺的重要工作。
& t! X" S+ }, F
首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB键（它位于“Q”键左边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。
+ X! |& m8 X! t我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变化。下面我举一个简单的例子，先看源代码：
% f1 h6 u/ c( l/ Y3 Y8 Z: ~3 V. y& ysub test()
! G& [" u& K! {for i=2 to 4 step 0.6
8 u3 w( N- n: T1 l5 y( ?next i
. _" t! K9 ]/ T# k# Lend sub
这是一个非常简单的循环，每一次循环i便会增加0.6，当循环3次后i值就变为4.4，但问题是每一次循环时i值变为多少？
第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。
第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。
好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。
第三步：在next i行再按一次F9，清除断点。监视的表达式的右键菜单选择“删除监视”。
另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。

到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的Autocad图形文件中， 以后打开这个文件时代码才会加载，如果别的dwg文件也要使用，那就需要把代码导出为.bas文件，供其他dwg文件导入。在VBA编辑器的“文件”菜单中有这两个功能，一试便知。
ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图形文件中共享，但是由于VBA功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要这样做。

8 S; z8 a4 N% }+ u本课结束，请做思考题；监视下列代码中的i和j的值，注意，此题虽然要监视2个变量，但是在代窗口中只要设置1个断点就足够了。
sub test()
for i=2 to 4 step 0.6
  for j=-5 to 2 step 5.5  
  next j
next i
end sub

wsj249201

第五课 画函数曲线
先画一组下图抛物线。
) w3 o' t; Y" L  Y/ ~

; T1 u, `% l6 K
下面是源码：
Sub myl()
2 B0 a! m6 z: [8 s. t' mDim p(0 To 49) As Double '定义点坐标
( [' m! C) ?6 Q& S. nDim myl As Object '定义引用曲线对象变量
( o/ o+ i0 z3 e/ p1 F/ Sco = 15 '定义颜色
7 U  {# Q3 C9 lFor a = 0.01 To 1 Step 0.02 '开始循环画抛物线
) c8 L* K" K( p% y. F! f9 \$ u  For i = -24 To 24 Step 2 '开始画多段线
. o1 B+ ?6 `, U/ _    j = i + 24  '确定数组元素
    p(j) = i '横坐标
+ x8 b: J, n# N4 T+ N! r    p(j + 1) = a * p(j) * p(j) / 10 '纵坐标
( U( k5 a2 X3 @  Next i '至此p(0)-p(40)所有元素已定义，结束循环
  Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
9 S4 J6 x7 N$ f  myl.Color = co '设置颜色属性
# g4 Q. j" u4 L% y' C- s: F4 e  co = co + 1 '改变颜色，供下次定义曲线颜色
7 n0 F* l! _4 p' nNext a
End sub
为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如果有问题不懂请跟贴提问。
6 R+ J* V0 U3 d在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化。
& ~/ _2 p% p6 p' WACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正负24之间。
8 ]: O' t) Y9 N) g程序第二行：Dim myl As Object '定义引用曲线对象变量
( X/ W- b% l& L$ C3 W/ Z' A, mObject也是一种变量类型，它可以把变量定义为对象，本例中myl变量将引用多段线，所以要定义为Objet类型。
8 \0 J' J- p. _$ O; ^7 g" l看画多段线命令：
9 i. s  |4 ^0 C$ i# u. qSet myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。
等号前面部分“Set myl”的作用就将myl变量去引用画好的多段线。
myl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co会增值，这样就会有五彩缤纷的效果。
4 T' b0 P& k2 ?/ m4 o! b6 ]6 _本课第二张图：正弦曲线，下面是源码：
. ~7 H  u1 u8 T6 T9 r; ~# M( ESub sinl()
Dim p(0 To 719) As Double '定义点坐标
For i = 0 To 718 Step 2 '开始画多段线
! G" ]' Z. X: e/ P# c, @    p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
    p(i + 1) = 2 * Sin(p(i)) '纵坐标
Next i
. K5 q8 x" C" h/ r4 ?# l. L. cThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线
0 a  j3 t, m7 qZoomExtents '显示整个图形
- w/ J# O; @( V1 OEnd Sub
+ t2 Z3 }' Y8 M" t6 j8 E
p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
横坐标表示角度，后面表达式的作用是把角度转化弧度
  d+ f2 q8 A- o" n' @) ?ZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域
7 [5 ^: u9 G% H0 s% I+ A本课思考题：画一条抛物线：y=0.5*x*x+3，其中X取值范围在正负50之间
' r  Q+ \1 C5 E0 C( w第六课 数据类型的转换
上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。
我们举例说明：
: x: t$ T" \/ s9 F/ Cjd = ThisDrawing.Utility.AngleToReal(30, 0)
这个表达式把角度30度转化为弧度，结果是.523598775598299。
4 R2 {! X2 y; \AngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为0-4之间的整数，有如下意义：
! _% y8 y, Z+ n! D$ ]* _0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位
6 \4 }' C- D# M例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1)
这个表达式计算62度30分10秒的弧度
$ C! e4 k! N! ~' ]9 ^2 \( k再看将字符串转换为实数的方法：DistanceToReal
需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义：
1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。
例：以下表达式得到一个12.5的实数
temp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1)
' F' |9 c/ Z4 |. s: ~$ V1 S* Ttemp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2)
temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5)
而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数
2 C, t: I* x. p' l4 R" E第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。
temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3)
得到这个字符串：“1.250E+01”，
1 M2 m! k4 U, j2 k) A下面介绍一些数型转换函数：
Cint，获得一个整数，例：Cint(3.14159) ，得到3
Cvar，获得一个Variant类型的数值，例：Cvar("123" & "00")，得到”12300”
Cdate，转换为date数据类型，例：MyShortTime = CDate("11:13:14 AM")
下面的代码可以写出一串数字，从000-099。
- M+ {0 [4 S' U. x: o; T& {" ~5 kSub test()
Dim add0 As String
; {* B9 n! _. pDim text As String
Dim p(0 To 2) As Double
p(1) = 0 'Y坐标为0
p(2) = 0 'Z坐标为0
For i = 0 To 99 '开始循环
4 j* u6 _+ \9 z+ ?' h, L  If i < 10 Then '如果小于10
    add0 = "00" '需要加00
  Else '否则
    add0 = "0" '需要加0
  End If
0 T  H3 H. M% q+ q  text = add0 & CStr(i) '加零，并转换数据
  p(0) = i * 100 'X坐标
  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
  Next i
  
5 c, x4 J" M/ [. L) p" e. xEnd Sub

* {. t  h% A( {. X" S重点解释条件判断语句：
# f( E0 t0 N5 r7 KIf 条件表达式 Then
……
+ ]  U1 H& S9 _7 w1 W' X, _Else
. [4 V* t! O4 c5 r9 n3 I……
/ D7 n4 x2 ~" q, dEnd if
4 _' x7 E: m9 G$ J) K如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if后面
1 H1 h5 M" w+ u! A6 K& G6 x如果不满足条件，程序跳到else后往下运行。
; x* m$ ~5 C! o* ]. ]5 A  H7 v9 s  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
, U2 x+ `8 W' t- O3 b5 a. u这是写单行文本，需要三个参数，分别是:写的内容、位置、字高
. a' v' e' s2 q9 ^6 J  l第七课
( B) {1 x$ `5 n: K2 a3 W# x写文字
客观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是把定义文字样式，用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。
Sub txt()
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
  x0 q* B( [6 V  w* Q9 Z) X6 HDim p(0 To 2) As Double '定义坐标变量
p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值
% J* A, }) `' kSet mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
mytxt.f '设置字体文件为仿宋体
mytxt.Height = 100 '字高
mytxt.Width = 0.8 '宽高比
mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度）

" m: H( t) `+ bThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
( B0 ^5 N: j! \9 u' USet txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
% j: V  m  [* m0 g* z$ ?txtobj.LineSpacingFactor = 2 '指定行间距
5 {9 \% ^. X) p% d) ~6 i" m$ x1 v5 Stxtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2为居中）
End Sub
0 p* D# ?" G8 f/ `; x; R6 d2 p我们看这条语句
Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
7 F1 {: P3 f/ K( c! S添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名
. F5 R; X. e2 Hfontfile、height、width、ObliqueAngle是文本样式最常用的属性
. v9 I' e$ [6 G* XCall ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
& L! ]2 L$ i4 {  y9 |这条语句是写文本，需要三个参数。第一个参数p是坐标，1400是宽度，最后一个参数是文本内容，其中\p是一个回车符
" U% {+ r0 P4 v( M; m$ o$ j% ^扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3 部，n取值范围是0.75-3
/ b# o5 [, E. L3 a在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34
\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
. s8 o  y) T, l& S4 W5 R\C是颜色格式字符，C后面跟一个数字表示颜色
6 s: C+ U2 r# J\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐
第八课:图层操作
$ e7 k0 N% V7 N8 }# _先简单介绍两条命令：
1、这条语句可以建立图层：
ThisDrawing.Layers.Add("新建图层")
在括号中填写图层的名称。
2、设置为当前的图层
  |' h" X: h' Q1 ?$ n% Z- tThisDrawing.ActiveLayer=图层对象
1 F0 C8 g* w' ^- g; T注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量
# {) k- w. B/ i8 o- [以下一些属性在图层比较常用：
+ h/ s: y7 u; ~* i. p7 yLayerOn 打开关闭
' F9 A% z3 r. K$ J2 wFreeze 冻结
3 [/ D0 H1 x6 F- h0 j9 n" h1 oLock锁定
+ M0 p2 m) T+ j9 F) @" ?" G& BColor 颜色
Linetype 线型

看一个例题：
1、先在已有的图层中寻找一个名为“新建图层”的图层
: O# `! y0 q2 ~- j7 ^3 F9 Y( u2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置为当前图层。
0 X' h" m  U4 p# {3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层
Sub mylay()
Dim lay0 As AcadLayer '定义作为图层的变量
( D9 D6 M, B% J9 iDim lay1 As AcadLayer
findlay = 0 '寻找图层的结果的变量，0没有找到，1找到
$ H+ d9 u7 M5 U: T, v5 nFor Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环
  If lay0.Name = "新建图层" Then '如果找到图层名
  m6 D3 P/ V2 Z2 o4 |    findlay = 1 '把变量改为1标志着图层已经找到
/ z2 a" L5 B* `/ d    msgstr = lay0.Name + "已经存在" + vbCrLf
+ |; P& ~2 d7 D# l) Y. q! Q6 d( [    msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf
    msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf
! T1 E: c. O/ R9 k1 m    msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf
/ c; R$ B6 N( l! f1 y    msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf
    msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf
  N* Q; S, H7 Q/ S1 O    msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf
& Q3 @" G9 l: _/ t% G* e8 T. i    msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf
% l0 d9 g6 {( O7 C& C    msgstr = msgstr + "是否设置为当前图层？"
    If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定
       If Not lay0.LayerOn Then lay0.LayerOn = True '打开
( R/ i' i% A* a+ j4 J$ t       ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层
8 S) T" I& g. j& Z: C    End If
. b4 H8 |" I; p7 p+ e    Exit For '结束寻找
  End If
Next lay0
If findlay = 0 Then '没有找到图层
# B& g6 a9 O# [2 r; j4 D: }8 P  Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层
  lay1.Color = 2 '图层设置为黄色
  
# n9 V: v; f, P9 X( K* a2 x/ N! ^  ltfind = 0 '找到线型的标志，0没有找到，1找到
4 a: m* |4 M) }  }  n, A8 q1 s. L  For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环
    If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN"
      ltfind = 1 '标志为已找到线型
; S- v" H' ~0 l/ Q* g      Exit For '退出循环
    End If
; ^+ y% I  u3 H" V- m3 Y; z  c  Next entry '结束循环
; l$ \" a% G3 T' k2 a0 ~2 s  If ltfind = 0 Then '没有找到线型
' M- |' ~; z1 A) G0 r; w' a    ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型
$ ]% @. h% \# ]+ u! j) X$ Q  End If
; a$ i/ d$ i0 O9 \  lay1.Linetype = "HIDDEN" '设置线型
  ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层
/ X" r) q6 |# f' M  ]End If
End Sub
在寻找图时时我们用到for each……next 语句
它的语法是这样的：
For Each 变量 In 数组或集合对象
……
exit for
. x) q4 \$ o, d* c& R/ Q……
1 L& S5 A, {2 ?next 变量
7 ]' ?4 E3 W. r6 M它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层
4 W: C2 J3 D; [0 h) Q% }$ q在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。
If lay0.Name = "新建图层" Then
lay0.name代表这处图层的图层名
IIf(lay0.LayerOn = True, "打开", "关闭")
这是一个简单判断语句，语法如下：
iif（判断表达式，返回值1，返回值2）
: t8 I4 V7 Z$ i3 j, {当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2
MsgBox(msgstr, 1)
$ ], A, Y6 W1 ~Mgbox显示一个对话框，第一个参数是对话框显示的内容
3 m7 v- h, v2 m6 ?- Y第二个参数可以控制对话框上的按钮。
0 只有确认按钮
* Q+ m3 i# U% Q* t5 i# M/ L- |" h1 确认、取消
2 终止、重试、忽略
, E# T, w) J$ L. K( l3 是、否、取消
4 是、否
MsgBox获得值如下：
& n2 p. [2 {7 [6 L' V确认：1
取消：2
' o5 ~- H- X/ V; P4 G! |终止：3
重试：4
! ~. v% V1 M$ l4 T- |$ K忽略：5
是：6
; v7 T+ g) o) F; H否7
初学者不需要死记硬背，能有所了解就行了
ACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：
8 Q) N" f4 D, _  l7 H$ FThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin"
ThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。
% K9 @2 r/ j- [( A) `8 A+ q) W
1 l4 t5 b' ^: F
- K* X  l% b6 S% U% X% t) Z[ 本帖最后由 wsj249201 于 2008-6-21 14:39 编辑 ]

wsj249201

第九课:创建选择集
2 ^  \6 l/ q# E& o) m8 c1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
* _- r2 S5 v6 W9 gSub c300()
Dim myselect(0 To 300) As AcadEntity '定义选择集数组
( |) Z2 g/ E  Y- L; ~% IDim pp(0 To 2) As Double '圆心坐标
For i = 0 To 300 '循环300次
+ r5 o2 W% N8 h9 Z( w" E. Y7 Gpp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
& C4 Q! _  m( A) J! p6 Z# NSet myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
" [  Z- m3 |4 b) T" z$ uNext i
9 }  G3 e' `9 `+ K5 y! S- B+ lFor i = 1 To 300
" h% D9 J5 Q2 o. v. [/ r  hIf myselect(i).Radius > 10 Then '判断圆的直径是否大于10
+ N& a$ x6 t- y# vmyselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
9 L' v- [/ q4 \" m0 c; }; [Else
myselect(i).color = 0 '小圆改为白色
End If
Next i
" r" y- m$ O' |4 ~: c. zZoomExtents '缩放到显示全部对象
End Sub
/ U" G# p: l# C% w4 n
0 P6 K% B/ D% c6 ^: I1 |& {; Vpp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
8 ^6 R" w8 b' a8 }; @这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
7 ]% ~) S; B! A: O' V- m) J) J& jrnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
2.提标用户在屏幕中选取
2 y5 l$ W) t; g( q( V选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
Sub mysel()
Dim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
Set sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
7 c* z" ^' S/ ssset.SelectOnScreen '提示用户选择
For Each element In sset '在选择集中进行循环
  element.color = acGreen '改为绿色
1 k( }3 s6 i! l; L9 k7 w7 M5 ZNext
8 `  ~  ~: Y4 q, q3 K- e. f* Qsset.Delete '删除选择集
4 r6 Z, X* T; M: wEnd Sub
2 I1 b) N$ F& Q, \5 m3.选择全部对象
用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
1 Z3 K: u  H& J9 }# V! N/ {7 R* B) b7 j1 \Sub allsel()
Dim sel1 As AcadSelectionSet '定义选择集对象
6 k; l5 W9 @7 U/ kSet sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
9 f7 F7 q, E6 ^/ xCall sel1.Select(acSelectionSetAll) '全部选中
9 _3 N, L# S  y) Dsel1.Highlight (True) '显示选择的对象
5 v- G* b% x5 z3 N7 `sco= sel1.Count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
End Sub
" R$ @# }2 r, G0 G; r( c9 J
3.运用select方法
上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
6 a% [+ U3 S& o! h: F1:择全部对象(acselectionsetall)
2.选择上次创建的对象(acselectionsetlast)
% \3 S& Z  p/ ]3 f* B- m. \3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
还是看代码来学习.其中选择语句是:
! T3 T: M) d4 O0 nCall sel1.Select(Mode, p1, p2)
) H; \: k( s- F: ^% r1 D+ o$ F6 vMode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
6 w/ e, h9 V6 j" W3 t) P$ `3 RSub selnew()
9 d) Y( w0 U* i2 `  s5 `/ kDim sel1 As AcadSelectionSet '定义选择集对象
% @3 x- d- D( a2 Y- R+ MDim p1(0 To 2) As Double '坐标1
Dim p2(0 To 2) As Double '坐标2
# c$ O  G3 k" L0 E2 wp1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
' `5 k" \- k, M: h5 Qp2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
Mode = 5 '把选择模式存入mode变量中
Set sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
+ ?3 T5 n& _8 e9 {% I7 z, |Call sel1.Select(Mode, p1, p2) '选择对象
sel1.Highlight (ture) '显示已选中的对象
& B5 u8 x& f$ [8 qEnd Sub
. _4 N+ C1 f' Q5 f& z' ~第十课:画多段线和样条线
画二维多段线语句这样写：
set lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
AddLightweightPolyline后面需一个参数，存放顶点坐标的数组
  G, u- F+ u5 p! T! D2 ]画三维多段线语句这样写：
8 g# G2 [/ L; O. ^Set lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
. W6 l3 c2 I0 G: a' AAdd3dpoly后面需一个参数，就是顶点坐标数组
) U4 `& j8 s/ B6 J. w; Y+ m画二维样条线语句这样写：
Set lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
" i" R/ W) D& ^- s# i7 e$ [' V, pAddspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
下面看例题。这个程序是第三课例程的改进版。原题是这样的：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
Sub myl()
Dim p1 As Variant '申明端点坐标
Dim p2 As Variant
% m, R4 J0 X, q7 iDim l() As Double '声明一个动态数组
/ u$ j1 Z/ z$ O! E" EDim templ As Object
, G% m1 R: V" {) S" i) j9 C" h9 Sp1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
' Z; h$ W- w# ?* @9 ?3 Q8 W/ F0 [z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p1(2) = z '将Z坐标值赋予点坐标中
ReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
6 M0 ~: y! `7 u' nl(1) = p1(1)
l(2) = z
On Error GoTo Err_Control '出错陷井
Do '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
3 }: }4 e& w. a  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  p2(2) = z '将Z坐标值赋予点坐标中
3 Q4 a( a5 }* H- ?3 |  
  lub = UBound(l) '获取当前l数组中元的元素个数
  ReDim Preserve l(lub + 3)
  For i = 1 To 3
( I6 Q- B! u2 U4 D7 i    l(lub + i) = p2(i - 1)
5 j( X+ S" ^" U: {6 Y  Next i
2 C, x. h6 U4 i; e( ?8 E) x  Z6 O' }  If lub > 3 Then
    templ.Delete '删除前一次画的多段线
  End If
  H% c0 L  ]: }  Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
# A4 E! L0 P, Y1 k  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
Err_Control:
End Sub

我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
这样定义数组：Dim l( ) As Double
赋值语句：
ReDim l(0 To 2)
l(0) = p1(0)
2 F9 ]- @, t" C9 Q' zl(1) = p1(1)
l(2) = z
重新定义数组元素语句：
  lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
  ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
* P& R! O$ j. o再看画多段线语句：
0 u% C. t% E5 m; x7 lSet templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
% I+ s% A( @4 Y4 X4 u在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
2 {- V  N& `, M4 ?% ~删除语句：
templ.Delete
因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
) |: P3 s8 u9 n( H9 f  z7 ]下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
Sub sp2pl()
+ G* b1 r7 _' {# ]Dim getsp As Object ‘获取样条线的变量
# [7 l3 ]' f, J% B  wDim newl() As Double ‘多段线数组
Dim p1 As Variant ‘获得拟合点点坐标
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
; d7 h0 x" N5 W6 ~  ]8 M8 F) [sumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
ReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
/ k) Y" e6 a+ V( j2 x; y  
  For i = 0 To sumctrl - 1 ‘开始循环，
; b0 S# s! b. Q- h* G& ^+ T  p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
3 H& l4 I$ J7 q2 t      For j = 0 To 2
8 B* s8 `! U2 e  m, l  d; i    newl(i * 3 + j) = p1(j)
  Next j
0 I. H. }2 O% ~Next i
Set templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
2 v8 t. S5 R" C! BEnd Sub
下面的语句是让用户选择样条线：
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
ThisDrawing.Utility.GetEntity 后面需要三个参数：
第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。
第十一课:动画基础
说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
* m  @( [0 h' N9 j/ s    下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。
6 w6 B5 A3 H, ?6 }8 o! e
    移动方法：object.move 起点坐标,端点坐标
Sub testmove()
, _& ]2 {. F7 _! y1 TDim p0 As Variant       '起点坐标
Dim p1 As Variant       '终点坐标
/ {" P! f; |  }4 G0 ZDim pc As Variant       '移动时起点坐标
: U  t9 Z5 \- e3 n2 nDim pe As Variant       '移动时终点坐标
& `* ?1 Y; p$ T5 w2 q2 s) b  y$ M% B5 aDim movx As Variant     'x轴增量
Dim movy As Variant     'y轴增量
3 t+ c2 K& b: q. ?: uDim getobj As Object    '移动对象
3 R* E! M6 A- q4 p5 f$ G4 \Dim movtimes As Integer '移动次数
ThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象"
; L0 q) t( S, a: t( op0 = ThisDrawing.Utility.GetPoint(, "起点:")
( Q5 Y: i  N) b7 k; bp1 = ThisDrawing.Utility.GetPoint(p0, "终点:")
# B0 T' u' e  a# i& Tpe = p0
pc = p0
motimes = 3000
2 t7 F1 b3 v  x3 D" C8 emovx = (p1(0) - p0(0)) / motimes
8 V8 h3 q1 n1 ~* p* |: T, b- \movy = (p1(1) - p0(1)) / motimes
, d/ t! {( ]9 I5 t" @4 ^For i = 1 To motimes
1 D5 U. Z) r* o6 [  r! m4 W# O# t  pe(0) = pc(0) + movx
  pe(1) = pc(1) + movy
  getobj.Move pc, pe    '移动一段
/ H9 `5 s8 r9 I; `; H+ \8 O  getobj.Update         '更新对象
5 F5 R& q9 z& n2 xNext
4 g: D+ v5 w% d0 I9 u8 yEnd Sub
$ J7 Z4 w  A9 i$ G先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。
6 x6 M8 K1 K) ^4 q/ T$ ^看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。
% X9 |5 n6 q; c7 n' ~+ k7 R3 y2 n旋转方法：object. rotate 基点,角度
% B, D7 P7 b1 C- N偏移方法： object.offset(偏移量)
Sub moveball()
- ]1 _8 {7 Q2 C( O  Y1 U! IDim ccball As Variant '圆
Dim ccline As Variant '圆轴
7 m/ E. F7 W$ M0 @, O+ i5 ZDim cclinep1(0 To 2) As Double '圆轴端点1
. f% M% m2 o) N$ d# q2 ^Dim cclinep2(0 To 2) As Double '圆轴端点2
Dim cc(0 To 2) As Double '圆心
Dim hill As Variant '山坡线
8 ~. Z+ A2 i" g! O! @Dim moveline As Variant '移动轨迹线
5 |+ ]( f6 A1 z7 @$ L( v8 d* MDim lay1 As AcadLayer '放轨迹线的隐藏图层
Dim vpoints As Variant '轨迹点
Dim movep(0 To 2) As Double '移动目标点坐标
! }! A5 T. Y+ u; ycclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标
' H1 U( ^! f4 ?. t, hSet ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线
Set ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆
2 P  N5 ]$ J$ S9 l5 [& y
8 r( s1 {% u& l+ {% JDim p(0 To 719) As Double   '申明正弦线顶点坐标
) @/ `# M7 X! B& uFor i = 0 To 718 Step 2 '开始画多段线
    p(i) = i * 3.1415926535897 / 360  '横坐标
    p(i + 1) = Sin(p(i)) '纵坐标
3 ^# w" \; I/ O9 `9 F) QNext i
$ b1 @' {: n4 N& l4 J  
Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线
hill.Update '显示山坡线
* D% ^3 R$ o0 ?, ?) o/ t/ Ymoveline = hill.Offset(-0.1) '球心运动轨迹线
vpoints = moveline(0).Coordinates '获得规迹点
. h7 E' m7 c; x' X& A: z, B4 bSet lay1 = ThisDrawing.Layers.Add("hidelay") '创建名为"hidelay"的图层
# R& R9 [0 J: {0 F2 k1 [% d7 j  olay1.LayerOn = False '关闭图层
: _( D5 J0 }* [* x6 Zmoveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
( i2 X$ B3 v5 Q; U2 \ZoomExtents '显示整个图形
# e2 h7 w/ w& mFor i = 0 To UBound(vpoints) - 1 Step 2
# e) u/ x) E# O3 x8 e  movep(0) = vpoints(i) '计算移动的轨迹
  movep(1) = vpoints(i + 1)
6 V; p% _, @2 I* Q& S* H  ccline.Rotate cc, 0.05 '旋转直线
% C" B$ \' n5 j  ccline.Move cc, movep '移动直线
  ccball.Move cc, movep '移动圆
' E% X% Z* R. _% {4 o( H- y/ N/ r# n  cc(0) = movep(0) '把当前位置作为下次移动的起点
  cc(1) = movep(1)
  For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置
' H( M5 y. Y2 i0 ]+ H5 |5 O1 N   j = j * 1
: ]1 v( g- |2 O5 o  Next j
  s; F( n% }% U0 R! T( M  ccline.Update '更新
9 _! c. O2 u, t0 e  L- `( N7 _: y% A* hNext i
( \3 }9 _* c- J! l/ ]" x9 c2 UEnd Sub
' @" m4 M: K) V" I  W
本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定
4 q/ B' Z% I+ r5 s- ~第十二课:参数化设计基础
& g, h- v( k2 I# [) b' J, \5 I简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。
  j# D9 Q0 `% r$ \2 B0 k    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

1 B( P# Q9 |6 l8 n
Sub court()
Dim courtlay As AcadLayer '定义球场图层
0 A0 o! R, ^' b! V* d5 \& YDim ent As AcadEntity '镜像对象
2 b) a- @: R! K" XDim linep1(0 To 2) As Double '线条端点1
- }4 r8 p; J) I: aDim linep2(0 To 2) As Double '线条端点2
- q6 q& x9 f2 u5 LDim linep3(0 To 2) As Double '罚球弧端点1
# K8 N" \( L7 W# N" kDim linep4(0 To 2) As Double '罚球弧端点2
8 K5 |' \/ p$ F; ?' g) a, R; zDim centerp As Variant '中心坐标
. o& ]; c2 e( V. ?7 i% B1 mxjq = 11000 '小禁区尺寸
% Y* f7 ~4 T5 Y8 a. Rdjq = 33000 '大禁区尺寸
0 w( M3 N* i( S/ y6 |# A7 K6 Afqd = 11000 '罚球点位置
fqr = 9150 '罚球弧半径
fqh = 14634.98 '罚球弧弦长
jqqr = 1000 '角球区半径
zqr = 9150 '中圈半径
On Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
; v" N  W  s0 W3 V; I" dIf Err.Number <> 0 Then '用户输入的不是有效数字
  chang = 105000
4 I* G  c" t3 H9 N. I* v  Err.Clear '清除错误
End If
kuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
: [, O' |- @) G& ]If Err.Number <> 0 Then
  kuan = 68000
1 h3 u- }* x% a8 @End If
' f) n* T) A: z0 K8 |' jcenterp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
# F& h2 ]6 Z& I+ r) XSet courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
0 n) Q. [( {6 P% ]' w; T+ ~ThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
'画小禁区
linep1(0) = centerp(0) + chang / 2
# w2 h  J3 f4 Olinep1(1) = centerp(1) + xjq / 2
linep2(0) = centerp(0) + chang / 2 - xjq / 2
linep2(1) = centerp(1) - xjq / 2
2 \0 ^$ L+ q/ D9 X. ]4 e0 w- {6 k( ECall drawbox(linep1, linep2) '调用画矩形子程序
5 {3 X! O( }# [) V5 Z$ g( f
& e& M" q( }9 g( k* H( _9 i'画大禁区
+ ]5 P& R# @' V( u: l/ mlinep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
7 }( {# u9 `8 w& Y# ]linep2(0) = centerp(0) + chang / 2 - djq / 2
linep2(1) = centerp(1) - djq / 2
Call drawbox(linep1, linep2)

* W3 k0 y1 r' J( q8 Y  F  J1 Y' 画罚球点
8 _- ~& J& t+ z7 Glinep1(0) = centerp(0) + chang / 2 - fqd
. G% }6 a" n0 Q  j3 B) r9 m9 S5 m8 u. dlinep1(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddPoint(linep1)
6 |: b9 U( O7 l- S/ F'ThisDrawing.SetVariable "PDMODE", 32 '点样式
ThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸
'画罚球弧，罚球弧圆心就是罚球点linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
& P) I! I+ S$ U8 Flinep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '两个端点的x轴相同
linep4(1) = centerp(1) - fqh / 2
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧

'角球弧
ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
$ h" F8 K: J2 h  k0 ?5 D' Qang2 = ThisDrawing.Utility.AngleToReal(180, 0)
& @; c1 B0 d2 ]: a1 Ulinep1(0) = centerp(0) + chang / 2 '角球弧圆心
3 N/ z0 g7 j; h$ Qlinep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
* N: m+ I8 p! X. _8 p- Hlinep1(1) = centerp(1) + kuan / 2
& Z" y6 t  y$ {5 l  eCall ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

) |# @- h( D+ \" W% b8 f( `'镜像轴
linep1(0) = centerp(0)
linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2
'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
6 ?% Q1 [7 v( Q8 q! v, \    ent.Mirror linep1, linep2 '镜像
0 J2 |. f: t0 A0 {4 X  End If
$ L, K% I, J1 P" J: i6 ^Next ent
/ P) _6 _; E: w5 i7 b  R* L, I/ s'画中线
) X3 k1 l* p7 a7 \8 |: C  ^; Q2 JCall ThisDrawing.ModelSpace.AddLine(linep1, linep2)
'画中圈
  f5 d: e2 q" N) w/ ]Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)
'画外框
linep1(0) = centerp(0) - chang / 2
linep1(1) = centerp(1) - kuan / 2
( q) l( ^  U1 ~% L, f0 Plinep2(0) = centerp(0) + chang / 2
2 `6 S' V, j' D- i7 j6 b. |linep2(1) = centerp(1) + kuan / 2
Call drawbox(linep1, linep2)
0 N8 p) L: w' |( Z. L% I; K/ MZoomExtents '显示整个图形
End Sub
+ y2 M1 w# P9 QPrivate Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
Dim boxp(0 To 14) As Double
boxp(0) = p1(0)
( c! H4 b# N) T3 Z9 Zboxp(1) = p1(1)
' o9 ^* e# K% ^; f/ t' Tboxp(3) = p1(0)
9 U$ |6 Q& D: Jboxp(4) = p2(1)
boxp(6) = p2(0)
boxp(7) = p2(1)
boxp(9) = p2(0)
, q8 Y! l: U  ]& T* |% ]5 o) U/ \. ?% Qboxp(10) = p1(1)
boxp(12) = p1(0)
7 G* o5 X. F- S& L* q! K/ k$ qboxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub
, b3 p1 ]) I; s! f0 q$ n
' H9 g7 V) W9 E  ?" v4 U; L
$ v+ ^$ Q. a2 a3 A- N下面开始分析源码：
. x) k* D5 k, L* M7 I. FOn Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
If Err.Number <> 0 Then '用户输入的不是有效数字
$ e% }" h1 e# |) ^" r0 H1 d$ ]chang = 10500
Err.Clear '清除错误
End If
% I' C# y; s  j( }) Q    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。
0 D4 `* C$ |; E6 B* z. O
2 Q; K& j1 J; _    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
4 U3 q/ L% X: I4 m' U    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。
9 v( P" N3 d  q* ]  _
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
7 d( e7 P! `9 }/ x( y2 _) u下面看镜像操作：
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
1 E* q5 K0 Q+ s9 y4 K    ent.Mirror linep1, linep2 '镜像
$ H1 D6 W% e# q6 b3 d  End If
Next ent
    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。

' u1 n# n: q* k) W( Q本课思考题：
( }, q2 P6 p$ e' A1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入
% i7 `0 V/ w  Y" o. D2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中

jshailin

谢谢楼主，正想学习  ！

renweidave

不错的东西呀,正想学习一下呢

蓝色的海01

打印下来，好好研究一下。感谢楼主啊

inuyasha_pw

好贴，受了！！！VBA学过一点点，下来看看

dai8812312

真的很谢谢楼主    :lol:

no1sunshine

一直想找一些学习AUTOCAD二次开发方面的资料，真是不枉此点
我觉得我真的是找到了一个好的归宿-------三维网
8 U/ x2 ^: p: F1 D+ ?, W真的是我们这些学习机械专业的学生取经的好地方
: v$ w" a3 W4 w0 i& d% {+ q谢谢各位前辈对我们的关怀

tzydsfy

感谢楼主的奉献，就不知我们看得懂吗？

shirleykine1980

原帖由 wsj249201 于 2008-6-21 14:13 发表 http://www.3dportal.cn/discuz/images/common/back.gif
Autocad VBA初级教程 (第一课:入门)

第一课：入门

0 e) L) J6 ^6 u8 Y( l4 A) G2 c8 K, v1.为什么要写这个教程
7 m3 e8 M8 f7 |7 S+ |! H市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是 ...

7 e: ]. y0 H- r+ c* d0 A9 N
2 O& h! S$ G6 l0 ~- }' ]好像没有声明变量，我重新编了一下，多多指教，我已经运行了，都是同心圆，好眼晕呀
Option Explicit
Sub c100()
5 ]; A5 r5 u: Y4 H  s+ q% W/ f; B8 VDim c100 As AcadCircle
Dim i As Double
+ H# c# U% D/ X" a2 XDim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
4 p+ v8 U# m( v7 F  E6 c3 c' sFor i = 1 To 1000 Step 10 '开始循环
" o" K* [. R( w6 {* E: `Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
! T4 `+ }/ L8 t3 gNext i
End Sub

woaishuijia

Dim c100 As AcadCircle
- C) \, t5 _2 j& a( F* e& E: `这一行没有用处，程序中并没有把添加的圆对象赋值给变量。
* J% n6 ]5 t" [' b: @; V另外，不赞成变量名和过程名一样，容易出错的。

garychen

谢谢，真热心