AutoCAD VBA二次开发初级教程

bulish

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

powerpeak

正在打算学习二次开发的部分
* J8 \; @/ y6 P9 c0 M- t9 |/ a6 k谢谢楼主

wordcad

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

xiaoship

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

hqzoe

真是多谢正好需要

tanlihua

找了了久,终于找到了

sky121

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

wuqitao0000

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

echo7411

谢谢哈   呵呵 很好用啊

ytcadtools

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

wsj249201

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

第一课：入门
* Q6 u7 S+ m: i" G' r
9 p7 ~  X9 {9 O  p' E' ~8 _1.为什么要写这个教程
市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。

2.什么是Autocad VBA？
VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
4 _$ L3 |& s( x  A
3、VBA有多难？
& a( x, z, @4 O0 L1 _! W" U( L# y相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。

4、怎样学习VBA？
4 R) {; X( L) g) V# c. B5 E介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
. y+ C6 [6 \) U0 k" q: k
* C9 f& N" O2 {/ g5、现在我们开始编写第一个程序：画一百个同心圆
2 j, i$ L7 z0 k4 a第一步：复制下面的红色代码
第二步：在模型空间按快捷键Alt+F8，出现宏窗口
3 i0 C. O& g6 C  c- x第三步：在宏名称中填写C100，点“创建”、“确定”
5 Q! F+ T+ Q8 j" b5 S5 U第四步：在Sub c100()和End Sub之间粘贴代码
# I, P' p+ _8 J, P2 b* j; U- `* h第五步：回到模型空间，再次按Alt+F8，点击“运行”

3 j" n- z1 U" _0 \Sub c100()
Dim cc(0 To 2) As Double '声明坐标变量
  k5 M. `; R8 U( X0 [: n% D" P# u: J7 qcc(0) = 1000 '定义圆心座标
cc(1) = 1000
: @) c7 y& [/ l% s2 vcc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
9 o& s) t+ y) X9 Y7 M0 W; a3 C1 qCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
' }8 F) K: v  ]# e4 vNext i
; z9 ]$ Z  r# I8 i( J& b$ rEnd Sub
. o, r. J8 G% Y) J4 M% q  H
也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

wsj249201

第二课  编程基础
0 ~5 l- n* Z. M4 _0 ?本课主要任务是对上一课的例程进行详细分析
/ v$ x0 f5 R4 b& e: H下面是源码：
2 G! f. |( S; {/ n4 g# q( o* u0 W7 sSub c100()
( }9 G9 @" }  E. P4 F! ?Dim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
) s& N- q; D) t& ?# wFor i = 1 To 1000 Step 10 '开始循环
  Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
8 X% [* o0 @& ZNext i
End Sub
先看第一行和最后一行：
0 W4 K8 j: e% h6 b1 Y& {# D+ ~Sub C100()
) H# H. n7 ]: w; P……
End Sub
C100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub　和end sub之间的所有指令。
第二行：
2 A7 u$ `( f) y# ^, SDim cc(0 To 2) As Double '声明坐标变量
3 ]2 C% x0 p! Q3 r后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注释，越详细越好，对于程序员来说，这是一个好习惯。
* y. q% V8 R  d电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double
它的作用就是声明变量。
+ p3 B$ y5 Z$ e1 M# U' uDim是一条语句，可以理解为计算机指令。
) j& p0 X0 |6 }6 Q1 q+ X它的语法：Dim变量名 As 数据类型
本例中变量名为CC，而括号中的0 to 2声明这个CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、CC(2)，如果改为CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了这个数组，就可以把坐标数值放到这个变量之中。
Double是数据类型中的一种。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD中数据类型的有很多，下面两个是比较常用的数据类型，初学者要有所理解。
' B; W9 A  G+ C& d" M# @Long（长整型），其范围从 -2,147,483,648 到 2,147,483,647。
% ?! i9 i1 E$ r) [Variant  它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常用的。
下面三条语句
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
! I% l$ z: V6 e它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z坐标。
( w) V% @! M0 {0 E
For i = 1 To 1000 Step 10 '开始循环
* S5 i- Z* D2 B/ o& x, B7 O0 @% s……
$ D" o. w% [( w2 BNext i  '结束循环
这两条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到 1000时，结束循环。
i也是一个变量，虽然没有声明i变量，程序还是认可的，VB不是C语言，每用一个变量都要声明，不声明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很长，那就会出现一些意想不到的错误。
step后面的数值就是每次循环时增加的数值，step后也可以用负值。
1 y" H8 C/ h1 e5 B7 A/ |9 u; |例如：For i =1000 To 1 Step -10
很多情况下，后面可以不加step 10
如：For i=1 to 100，它的作用是每循环一次i值就增加1
+ W9 b3 f# O0 }  ?2 g* r* \Next i语句必须出现在需要结束循环的位置，不然程序没法运行。
下面看画圆命令：
' ?* x* C8 n; N$ W3 Q3 n  w: l9 E" t7 XCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
% O9 a( I8 i7 i& Z3 k8 c2 S3 Z  @Call语句的作用是调用其他过程或者方法。
ThisDrawing.ModelSpace是指当前CAD文档的模型空间
AddCircle是画圆方法
* J) ~9 y/ \1 f8 aAddcicle方法需要两个参数：圆心和半径
CC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310……
! c9 t8 _. ?& G0 t3 a" d本课到此结束，下面请完成一道思考题：
1.以(4,2)为圆心，画5个同心圆，其半径为1-5

wsj249201

第三课 编程基础二
0 s8 A# g, Q, \) i7 z# K
有一位叫自然9172的网友提出了下面的问题：
9 j: R8 k& Z$ Y, y% Y" R8 h/ n- P绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入
本课将讲解这个问题。

为了简化程序，这里用多条直线来代替多段线。以下是源码：
9 j; _- E' @% M1 D  |$ ^) s5 }Sub myl()
2 p$ T9 U3 o9 M! IDim p1 As Variant '申明端点坐标
Dim p2 As Variant
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
" S& ?1 D4 j0 H' tp1(2) = z '将Z坐标值赋予点坐标中
9 r2 D$ h7 Z7 ~: O5 S) f* vOn Error GoTo Err_Control '出错陷井
Do '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
4 k0 W- H5 Y9 g. c' t: g  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  p2(2) = z '将Z坐标值赋予点坐标中
  Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
' ^) x0 p! ^& Z" o4 V, w/ ~0 ULoop
Err_Control:
6 G0 I) I- n  T# R+ ^; g# N& D' gEnd Sub
7 i! x- v/ g5 l/ Y3 E
先谈一下本程序的设计思路：
9 L/ r4 e  d& s5 T2 j; n1、获取第一点坐标
2、输入第一点Z坐标
6 _: U9 s' ~$ r3、获取第二点坐标
7 |: l2 p9 M0 G# F' {! T: v4、输入第二点Z坐标
5、以第一、二点为端点，画直线
6、下一条线的第一点=这条线的第二点
7、回到第3步进行循环
如果用户没有输入坐标或Z值，则程序结束。

首先看以下两条语句：
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标
……
0 T% Y" J5 h$ l8 o3 Fp2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
3 k" w, Z. m0 S- n5 ^这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。ThisDrawing.Utility.GetPoint（）在ACAD中这是最常用的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。
) j* w6 I- X9 N2 }4 X逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。
VbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”
&的作用是连接字符。举例：
% h$ m9 _  q( z. Z& ?9 ?, ~+ Y“爱我中华 ”&”抵制日货 ”&”从我做起”

% Z0 X1 _; w6 B3 D, u+ kz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
由用户输入一个实数

9 @8 m1 f6 D$ E) D9 A4 _+ IOn Error GoTo Err_Control '出错陷井
' D  L% G* r+ U4 }  s, d……
5 N" @; c- N% Q: x9 GErr_Control:
On Error是出错陷井语句，在程序出错时将执行On Error 后面的语句
GoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句，本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。

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

! e& D5 j  J0 q5 O1 MCall ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
画直线方法也是很常用的，它的两个参数是点坐标变量

, w: r" W7 M  {, H  @3 g8 |; P+ b  L) n本课到此结束，请做思考题：
; \: R* u$ U, t$ y连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出
! f& C* s& M1 z4 F" A
第四课 程序的调试和保存
% W, C4 p, r' i4 c4 m) v) q6 r! S
" C. ?# Q  Y2 ?3 ~7 V) q# r$ X1 a0 c
人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，随着学习的深入，以后我们需要经常进行程序调试。事实上，对于那些资深程序员来说，调试程序也是一项不可或缺的重要工作。
7 f6 i* y3 b4 o/ Z# x
. S9 p/ A" b; P首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB键（它位于“Q”键左边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。
7 E+ Y/ `% H7 f我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变化。下面我举一个简单的例子，先看源代码：
/ S, b" {7 W, b) X, n; nsub test()
for i=2 to 4 step 0.6
next i
* `( E, a8 ^4 U( I4 nend sub
这是一个非常简单的循环，每一次循环i便会增加0.6，当循环3次后i值就变为4.4，但问题是每一次循环时i值变为多少？
第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。
第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。
) b) Z+ d& m; N. A好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。
第三步：在next i行再按一次F9，清除断点。监视的表达式的右键菜单选择“删除监视”。
另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。
2 |1 Y, T. |* z4 E0 D6 x- s
* b, e! G- c. K1 V- N1 ?- ^到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的Autocad图形文件中， 以后打开这个文件时代码才会加载，如果别的dwg文件也要使用，那就需要把代码导出为.bas文件，供其他dwg文件导入。在VBA编辑器的“文件”菜单中有这两个功能，一试便知。
ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图形文件中共享，但是由于VBA功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要这样做。
: |5 {' C/ x, V# }8 Z" K  `
本课结束，请做思考题；监视下列代码中的i和j的值，注意，此题虽然要监视2个变量，但是在代窗口中只要设置1个断点就足够了。
6 V# y7 U  r- a. ?sub test()
$ I+ Z. z0 f9 g+ @1 K5 ~for i=2 to 4 step 0.6
9 [  s; F8 X* |1 t( u  for j=-5 to 2 step 5.5  
# M3 Q4 _# M9 m/ l0 |  next j
# K5 X; x- A7 s+ Snext i
end sub

wsj249201

第五课 画函数曲线
先画一组下图抛物线。
. N. ^0 }# i3 K! B, ^# I. l4 t' q
  J8 S# D5 h8 P# B; k
3 l% H0 G0 n1 M5 G. n/ u
下面是源码：
Sub myl()
% p- P/ G8 Y% w4 `5 x+ gDim p(0 To 49) As Double '定义点坐标
Dim myl As Object '定义引用曲线对象变量
# H6 g" S; T$ z( k& @co = 15 '定义颜色
/ F. ?, K/ v, }/ G( ^5 I" TFor a = 0.01 To 1 Step 0.02 '开始循环画抛物线
3 R; D) I% m; |; {  For i = -24 To 24 Step 2 '开始画多段线
    j = i + 24  '确定数组元素
    p(j) = i '横坐标
    p(j + 1) = a * p(j) * p(j) / 10 '纵坐标
) |. S+ H; y% `7 w: Z+ m/ V+ N  Next i '至此p(0)-p(40)所有元素已定义，结束循环
  Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
* Y* H) i$ b3 C& U' V$ ]) H5 B$ t3 C4 d  myl.Color = co '设置颜色属性
  co = co + 1 '改变颜色，供下次定义曲线颜色
Next a
End sub
为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如果有问题不懂请跟贴提问。
2 L; l6 k% s$ e1 p9 V在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化。
8 Q8 m1 x6 L- t, @6 zACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正负24之间。
/ P+ h$ M" J0 X* u, b程序第二行：Dim myl As Object '定义引用曲线对象变量
6 ]  V- `3 l6 \+ G, H% l# R( G: IObject也是一种变量类型，它可以把变量定义为对象，本例中myl变量将引用多段线，所以要定义为Objet类型。
8 |" M) W9 b% `: g5 |" n7 r* v看画多段线命令：
8 D, u: X6 i+ s0 @4 g- d9 ySet myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
4 z# y$ P- ?! A其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。
( e9 y9 T! U( P9 b; z等号前面部分“Set myl”的作用就将myl变量去引用画好的多段线。
9 ?4 j$ z" C1 K7 B. T0 R9 T. n* amyl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co会增值，这样就会有五彩缤纷的效果。
本课第二张图：正弦曲线，下面是源码：
Sub sinl()
Dim p(0 To 719) As Double '定义点坐标
For i = 0 To 718 Step 2 '开始画多段线
    p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
    p(i + 1) = 2 * Sin(p(i)) '纵坐标
  ?# N# c$ E5 x2 I; |" sNext i
ThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线
ZoomExtents '显示整个图形
End Sub

p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
横坐标表示角度，后面表达式的作用是把角度转化弧度
, T7 o- \. S3 ~, e( w( {5 i- pZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域
/ b4 O" Q! k: q. t本课思考题：画一条抛物线：y=0.5*x*x+3，其中X取值范围在正负50之间
* j8 A7 d/ w9 d0 U/ |* C8 b" F第六课 数据类型的转换
8 z. R) G& m" q' \8 N上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。
- ^8 h9 S8 y! A1 A* \我们举例说明：
jd = ThisDrawing.Utility.AngleToReal(30, 0)
9 l4 A3 W/ Y% |1 ], s6 D这个表达式把角度30度转化为弧度，结果是.523598775598299。
AngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为0-4之间的整数，有如下意义：
. v6 L! v" ?% l7 ~6 i0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位
例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1)
) Y  M% l& R: ?+ ?1 m2 A: z* @这个表达式计算62度30分10秒的弧度
8 z# ^9 i# C2 f: _" O* f再看将字符串转换为实数的方法：DistanceToReal
9 z/ j. a7 l8 @5 e6 R1 o需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义：
* }' @2 a7 t5 v* ^6 ~9 l1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。
0 `' S+ o3 X" Q) v1 W5 y; v例：以下表达式得到一个12.5的实数
temp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1)
temp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2)
temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5)
% B- H7 p* F. t0 ~而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数
- D& y# z9 S+ H  l; C第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。
temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3)
得到这个字符串：“1.250E+01”，
下面介绍一些数型转换函数：
& ~" m' H. X8 e1 {1 h+ [Cint，获得一个整数，例：Cint(3.14159) ，得到3
8 ?) M% W0 l6 M2 D) S& h+ WCvar，获得一个Variant类型的数值，例：Cvar("123" & "00")，得到”12300”
Cdate，转换为date数据类型，例：MyShortTime = CDate("11:13:14 AM")
# y8 R1 X% i7 b( V  G$ Y下面的代码可以写出一串数字，从000-099。
Sub test()
Dim add0 As String
0 v- h0 D2 p6 P2 Y, s0 g0 zDim text As String
& O8 s. M2 {( e, v, K, HDim p(0 To 2) As Double
p(1) = 0 'Y坐标为0
/ z5 R' x1 e" t$ w7 cp(2) = 0 'Z坐标为0
! V9 j2 f) v/ L) nFor i = 0 To 99 '开始循环
3 h# `/ }0 u# J; u* c  If i < 10 Then '如果小于10
    add0 = "00" '需要加00
  d# P9 B: v4 A, E  Else '否则
/ ]4 H/ U& j9 o9 A    add0 = "0" '需要加0
  End If
& Y( D) ?  S+ ]: _2 D  text = add0 & CStr(i) '加零，并转换数据
  p(0) = i * 100 'X坐标
3 w' m* \: y3 K% }1 Z; g  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
. v+ ^: s( a8 z+ P  Next i
8 y1 P/ x. h& K* w; X' z  
8 z3 @  [8 q, XEnd Sub
) y1 h. D2 b9 F, S, T
7 D7 [( }2 L" C1 Z* \重点解释条件判断语句：
If 条件表达式 Then
! E- F( [7 }6 [' [& m' {! q( U! o4 e……
Else
……
End if
7 y/ y3 B4 X9 i+ n( V: E如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if后面
如果不满足条件，程序跳到else后往下运行。
  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
8 _* Z& Q2 a+ C这是写单行文本，需要三个参数，分别是:写的内容、位置、字高
0 r. S. a8 b8 _. ]4 R) q! ^第七课
/ R( i' H* |# _/ `0 e& P* E4 K写文字
* l1 y6 f  c; \, L, d4 R( V; R$ ?客观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是把定义文字样式，用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。
+ W% z: H8 n* f0 ]/ ]5 |# U3 R+ S# dSub txt()
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
( U/ P  X: Q" {+ _4 Q, ~Dim p(0 To 2) As Double '定义坐标变量
p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值
Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
mytxt.f '设置字体文件为仿宋体
mytxt.Height = 100 '字高
* W9 F  S: H6 N6 O: f9 }! r) hmytxt.Width = 0.8 '宽高比
6 r) @: A; p" p: y: G5 Mmytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度）
: X3 x: `6 b% c
- |, D# I3 ^, T1 h+ y+ u8 {1 NThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
: m( f# K* f% T* V5 fSet txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
txtobj.LineSpacingFactor = 2 '指定行间距
9 O- ~4 L  @* S1 qtxtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2为居中）
End Sub
我们看这条语句
Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名
fontfile、height、width、ObliqueAngle是文本样式最常用的属性
Call ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
这条语句是写文本，需要三个参数。第一个参数p是坐标，1400是宽度，最后一个参数是文本内容，其中\p是一个回车符
+ u& k5 x1 b: H) K+ P: e扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3 部，n取值范围是0.75-3
在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34
8 {  K# m" a. ~3 O/ n\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
\C是颜色格式字符，C后面跟一个数字表示颜色
\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐
第八课:图层操作
# B; P7 r! U5 [先简单介绍两条命令：
1、这条语句可以建立图层：
1 S% |$ E; q5 ~9 QThisDrawing.Layers.Add("新建图层")
在括号中填写图层的名称。
% g0 T$ h9 R; q; T2、设置为当前的图层
ThisDrawing.ActiveLayer=图层对象
6 H! L4 _" o+ C) g' n) V8 m6 y注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量
以下一些属性在图层比较常用：
% B# d; Q1 I1 f) J% h: N1 BLayerOn 打开关闭
Freeze 冻结
9 N* @+ i/ h5 C# `" ^1 z, mLock锁定
$ x$ }& {/ e% U, g6 A# D6 e7 Y- ]! nColor 颜色
8 I& o1 c! D2 g0 z( R4 E" lLinetype 线型
- G8 L  j9 W4 C. t0 G
8 X# H7 e- }0 X看一个例题：
1、先在已有的图层中寻找一个名为“新建图层”的图层
2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置为当前图层。
3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层
" V6 Y+ l6 ?' s3 [1 q/ n" T# C7 H9 ]6 jSub mylay()
5 i8 c$ X  Y" [* z# |' x" I* MDim lay0 As AcadLayer '定义作为图层的变量
7 n  Y5 ^/ t! Y5 T7 s6 u( UDim lay1 As AcadLayer
findlay = 0 '寻找图层的结果的变量，0没有找到，1找到
For Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环
' x1 a# x/ v; y% d9 i  If lay0.Name = "新建图层" Then '如果找到图层名
    findlay = 1 '把变量改为1标志着图层已经找到
- w, r6 M. L; b0 Z( z    msgstr = lay0.Name + "已经存在" + vbCrLf
) o4 h: P4 B; L0 h3 r* g3 M    msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf
3 x1 d  n- n& |    msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf
( \3 j4 J" m. t2 y    msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf
& ]5 y4 |. B, c2 w9 h) x* p    msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf
: b3 ^3 `8 x/ y7 Z# s' A    msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf
    msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf
    msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf
! y" F! ^5 q8 v7 G9 f    msgstr = msgstr + "是否设置为当前图层？"
    If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定
  H* E. b7 ]( O       If Not lay0.LayerOn Then lay0.LayerOn = True '打开
       ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层
    End If
, n; W$ N+ b, T    Exit For '结束寻找
) q5 r0 @2 @/ @# y( t* T  End If
- v' l% F1 ^* W. R& fNext lay0
If findlay = 0 Then '没有找到图层
3 S3 W! a7 w; B: g* z" e1 Z  Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层
4 n+ h) t; T1 T, m, t) A6 `: p  lay1.Color = 2 '图层设置为黄色
9 _" K1 E3 H2 |4 R  
- y0 T! G. m1 |; [  ltfind = 0 '找到线型的标志，0没有找到，1找到
5 t9 Y" T5 ?& q, ^2 c$ k  For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环
    If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN"
% S1 R$ s$ [& P7 }      ltfind = 1 '标志为已找到线型
* U4 @3 ~: |6 \- e) [      Exit For '退出循环
# P" E; R. q1 M# z& o& C    End If
% v( N: l! w7 i6 k. V9 \  l  Next entry '结束循环
  If ltfind = 0 Then '没有找到线型
    ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型
  End If
& S) A" F! p4 U! Y- ]: a  lay1.Linetype = "HIDDEN" '设置线型
. K6 G* W5 F6 ~# D  ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层
: b- s! M9 m! I0 W' |End If
End Sub
5 J0 Y% p  v& @+ |- X) [在寻找图时时我们用到for each……next 语句
它的语法是这样的：
2 S+ E. N) l2 l) b8 VFor Each 变量 In 数组或集合对象
% q# n2 \! Q1 t0 @( ]' Z3 G( s7 Z6 B……
2 ]# V: x% ]9 e& K. X- D% Uexit for
……
- U9 @9 Z, C% z6 [3 @; Dnext 变量
% U6 ^3 H% j- R# a它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层
7 }# s* x/ Y2 Y, z; ~在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。
6 m# Y6 Q. D. n  u2 U6 NIf lay0.Name = "新建图层" Then
$ M# X* R# S0 ^lay0.name代表这处图层的图层名
: y/ a& T! [* rIIf(lay0.LayerOn = True, "打开", "关闭")
这是一个简单判断语句，语法如下：
iif（判断表达式，返回值1，返回值2）
当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2
MsgBox(msgstr, 1)
Mgbox显示一个对话框，第一个参数是对话框显示的内容
9 u) P0 u! E4 ]7 \7 |' h- w6 e第二个参数可以控制对话框上的按钮。
; U5 H' |; o5 }6 Z1 G/ |0 只有确认按钮
1 确认、取消
2 终止、重试、忽略
# m( A. T4 D; X3 D# X8 ~3 是、否、取消
" f" L( N0 V; S! _. L: H4 是、否
7 n- Z) _4 E& Q. fMsgBox获得值如下：
' C+ p* z+ O3 Q% t确认：1
% U6 ~/ C$ M, W取消：2
终止：3
重试：4
忽略：5
是：6
否7
6 i1 f: a) h" p5 L5 M初学者不需要死记硬背，能有所了解就行了
ACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：
ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin"
: x( R$ @" X  @2 TThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。


[ 本帖最后由 wsj249201 于 2008-6-21 14:39 编辑 ]

wsj249201

第九课:创建选择集
' j! w/ Z1 \$ d1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
Sub c300()
Dim myselect(0 To 300) As AcadEntity '定义选择集数组
& i* h: l/ D2 q9 e+ J9 a% FDim pp(0 To 2) As Double '圆心坐标
For i = 0 To 300 '循环300次
pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
! y+ T) ~2 q8 [" ]. ^+ {  P, ASet myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
% t/ Q: x, E1 R! A+ INext i
* h! X2 N- g: V6 BFor i = 1 To 300
$ T, {; p/ [$ \5 d) `& NIf myselect(i).Radius > 10 Then '判断圆的直径是否大于10
# V* A& ?0 f, L& i3 f3 m2 Gmyselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
Else
myselect(i).color = 0 '小圆改为白色
End If
3 t5 s' M6 V3 U- Z# Q/ ANext i
ZoomExtents '缩放到显示全部对象
End Sub
* T5 L( O- U( _, K
& S8 v- M% i5 cpp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
8 H. G( \6 X% ^' E. H: xrnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
' c) J  H; i5 a+ f  I+ O& d这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
$ F( C1 S( W4 ]9 _/ L2.提标用户在屏幕中选取
0 r0 Q) n" E6 n* @& P选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
" ]) m  V3 g' D% ]' L9 E4 dSub mysel()
8 v% X" o; h' j6 c; V; M& YDim sset As AcadSelectionSet '定义选择集对象
) N8 S( R* l, t2 MDim element As AcadEntity '定义选择集中的元素对象
) c4 d* j+ |* A- l3 V3 x& LSet sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
% ?" @) y+ Z( R( [  O7 q2 ]sset.SelectOnScreen '提示用户选择
1 h$ p! {. W9 d7 W; j. eFor Each element In sset '在选择集中进行循环
  element.color = acGreen '改为绿色
' g# S$ e5 d6 u3 w; H5 }( f1 dNext
sset.Delete '删除选择集
) \  k5 I+ o5 OEnd Sub
3.选择全部对象
用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
0 R( Z- l- T" `6 \; e+ PSub allsel()
6 w+ V. |% ~! p/ UDim sel1 As AcadSelectionSet '定义选择集对象
3 A  P) [# u! K. c" n# NSet sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
Call sel1.Select(acSelectionSetAll) '全部选中
sel1.Highlight (True) '显示选择的对象
sco= sel1.Count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
End Sub

5 O2 {' }  V- L0 q3.运用select方法
) L: t: q+ b9 s8 e上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
1:择全部对象(acselectionsetall)
% V, I5 M$ r3 j  [' R2.选择上次创建的对象(acselectionsetlast)
. ]/ k* a* H3 S$ [3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
; y: X& f6 n4 A/ a5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
) X( R) y* Z6 X3 l7 M还是看代码来学习.其中选择语句是:
Call sel1.Select(Mode, p1, p2)
/ Y# I5 D9 R" x4 r4 Y5 iMode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
Sub selnew()
Dim sel1 As AcadSelectionSet '定义选择集对象
( o* f2 S# b4 |" N* DDim p1(0 To 2) As Double '坐标1
Dim p2(0 To 2) As Double '坐标2
p1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
4 d1 C& k2 Y# ^, }! F6 }- O( ?7 }p2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
, T$ R8 l% O" O' e# ~  O9 ~Mode = 5 '把选择模式存入mode变量中
$ L3 I/ G; I, aSet sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
+ N0 X$ \7 a$ D( y' aCall sel1.Select(Mode, p1, p2) '选择对象
$ Q# \* h( d$ o, ?sel1.Highlight (ture) '显示已选中的对象
# k% R# o8 v$ I* j. Z  s1 e" YEnd Sub
% u, @6 J" ?6 {- ^/ t) g8 g" q第十课:画多段线和样条线
* b# N6 F" `, f" @/ o0 W画二维多段线语句这样写：
% A0 ?9 z+ R  h1 e5 A* `9 Cset lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
0 {! f& l; f7 p1 T, |- tAddLightweightPolyline后面需一个参数，存放顶点坐标的数组
, ^5 P" n$ Q9 ]5 q% T$ H/ }画三维多段线语句这样写：
" w6 u6 t9 [  Q& \, L8 TSet lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
Add3dpoly后面需一个参数，就是顶点坐标数组
画二维样条线语句这样写：
( @& M- l. `8 D  z3 p; o/ `3 NSet lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
& Z5 f8 @& F* K5 |  H+ \/ aAddspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
下面看例题。这个程序是第三课例程的改进版。原题是这样的：
! H( n- Y0 G* l" q绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
8 c+ x. R, ^6 v# A, ]. h. mSub myl()
+ s" [6 E8 q2 c  }, c# Y; LDim p1 As Variant '申明端点坐标
Dim p2 As Variant
0 Z9 n' l, h0 P3 Y2 NDim l() As Double '声明一个动态数组
1 u6 p7 ]/ Y# A( D' O8 l' WDim templ As Object
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
( [* k: n) h1 B& vz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p1(2) = z '将Z坐标值赋予点坐标中
0 Z" S+ O8 Z: \  q- e/ |ReDim l(0 To 2) '定义动态数组
: L6 t4 Z: a5 q9 Bl(0) = p1(0)
! Q# p$ q4 \& hl(1) = p1(1)
) f: [5 d  o2 N/ z9 v7 k: |l(2) = z
% O, w) n0 M  N- r  F4 uOn Error GoTo Err_Control '出错陷井
8 b& K3 m5 n1 m+ n! iDo '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
( u% O5 r' C5 U- ~. Y% P4 q/ {: l  p2(2) = z '将Z坐标值赋予点坐标中
4 S8 M3 I$ K/ ?8 H: s7 ]. S  
4 G# f; t8 A2 Y5 V4 j+ Q" K  lub = UBound(l) '获取当前l数组中元的元素个数
  ReDim Preserve l(lub + 3)
+ O3 V. S6 C9 o% ^  For i = 1 To 3
# j, p( H5 a( c5 N& q- d3 j    l(lub + i) = p2(i - 1)
+ @0 o6 A# h: d$ |+ h( q/ |) z  Next i
4 O: d3 x& }7 y+ T. o. a) F/ c  If lub > 3 Then
    templ.Delete '删除前一次画的多段线
  End If
+ A* \8 Z" R! c5 R% X( [  Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
4 G: ~5 ?) f# q( x4 O0 p  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
  _2 @& U- g+ wErr_Control:
! b+ V2 n+ m! i3 c' z! @End Sub

6 m+ A! a# I! H3 q! m/ N& }我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
( }1 r% [3 y8 A5 P2 E% f# t' s这样定义数组：Dim l( ) As Double
/ d/ p$ N0 A# Y( _) j$ B赋值语句：
! k% y+ |: @; A# o3 gReDim l(0 To 2)
l(0) = p1(0)
% g0 Q6 C. m  gl(1) = p1(1)
" S. Z6 H- [4 Y' ]! z3 yl(2) = z
0 m$ g, Y. [6 I1 m) n重新定义数组元素语句：
  lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
  ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
再看画多段线语句：
Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
删除语句：
+ i; v  S+ h) S" E" d6 ktempl.Delete
因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
+ `4 l8 c: v" W6 |下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
Sub sp2pl()
* L3 ], A1 ]/ g' d& J# tDim getsp As Object ‘获取样条线的变量
% K6 O! b' ?4 L+ HDim newl() As Double ‘多段线数组
Dim p1 As Variant ‘获得拟合点点坐标
+ j& t& v! e8 `# D7 l% NThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
sumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
ReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
  
  For i = 0 To sumctrl - 1 ‘开始循环，
+ b. F: }6 D% `. g' k  p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
# M6 w- I1 `8 x0 e0 K      For j = 0 To 2
    newl(i * 3 + j) = p1(j)
+ z8 M6 }' U& V: I* q+ F5 g: H9 @  Next j
Next i
- S, J8 }; _; C$ a, nSet templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
End Sub
4 P1 `" q8 j! n9 ^下面的语句是让用户选择样条线：
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
ThisDrawing.Utility.GetEntity 后面需要三个参数：
) O/ l5 V7 x3 `; Q5 D) r第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。
第十一课:动画基础
说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
& R1 F/ d% D2 p; J) C* y& R    下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。
7 V* {, g5 o! Q2 j3 b
    移动方法：object.move 起点坐标,端点坐标
% D3 g9 @9 J  j0 l. O  A9 OSub testmove()
3 N* b( j- i1 d; w) P/ L& EDim p0 As Variant       '起点坐标
Dim p1 As Variant       '终点坐标
  e; ?; E% ]4 f: _+ f; d0 }; [6 z- x6 dDim pc As Variant       '移动时起点坐标
Dim pe As Variant       '移动时终点坐标
Dim movx As Variant     'x轴增量
5 _1 V" s/ k0 n! C1 v3 @Dim movy As Variant     'y轴增量
$ Q$ [. n. _2 T4 _; V1 F, bDim getobj As Object    '移动对象
# e4 W9 C3 k+ N4 i( M$ PDim movtimes As Integer '移动次数
2 ?; ~3 X+ n/ _- K, rThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象"
p0 = ThisDrawing.Utility.GetPoint(, "起点:")
p1 = ThisDrawing.Utility.GetPoint(p0, "终点:")
pe = p0
  ]7 o. I1 g* z* ?* L8 q& Tpc = p0
motimes = 3000
movx = (p1(0) - p0(0)) / motimes
  V; V- w3 d+ }/ I4 zmovy = (p1(1) - p0(1)) / motimes
  \' s6 |% [. |: DFor i = 1 To motimes
2 x' l0 g1 T- r# k4 m* A3 T( b  pe(0) = pc(0) + movx
  pe(1) = pc(1) + movy
. d$ a7 @* [; H  u9 o/ k: S  getobj.Move pc, pe    '移动一段
# B' \3 g: v9 S+ V" l  u- D  getobj.Update         '更新对象
Next
# T" b9 b  J' q! yEnd Sub
先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。
/ M9 z5 \6 z- g! c! S看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。
旋转方法：object. rotate 基点,角度
: {& c+ z9 W6 b) x) S偏移方法： object.offset(偏移量)
Sub moveball()
Dim ccball As Variant '圆
Dim ccline As Variant '圆轴
Dim cclinep1(0 To 2) As Double '圆轴端点1
, Y4 B- Q9 }6 ?% W& DDim cclinep2(0 To 2) As Double '圆轴端点2
Dim cc(0 To 2) As Double '圆心
: o, j6 D6 I% b% ^0 J0 d& I; ADim hill As Variant '山坡线
# C( k6 M, C6 i0 h" Y9 f) W$ r2 m2 t) sDim moveline As Variant '移动轨迹线
Dim lay1 As AcadLayer '放轨迹线的隐藏图层
Dim vpoints As Variant '轨迹点
Dim movep(0 To 2) As Double '移动目标点坐标
, J, W/ n, K6 ]; R, n3 a  ccclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标
6 L2 E) ?  M9 KSet ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线
Set ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆
: K. v* V! Z2 T' z
5 `2 c& t3 @6 u% w: T/ x! K  RDim p(0 To 719) As Double   '申明正弦线顶点坐标
For i = 0 To 718 Step 2 '开始画多段线
! j* ~- o+ t+ z$ E  Y4 ?" c+ P    p(i) = i * 3.1415926535897 / 360  '横坐标
    p(i + 1) = Sin(p(i)) '纵坐标
) p8 J2 @8 p& T6 i2 T% a. w: d* J+ lNext i
  
9 \+ E( n& T- T; J- M+ T1 p/ MSet hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线
3 o* n; b0 Q0 Yhill.Update '显示山坡线
moveline = hill.Offset(-0.1) '球心运动轨迹线
7 z! [2 X5 L, o) Ovpoints = moveline(0).Coordinates '获得规迹点
5 F6 H8 B, @5 v- B2 u& nSet lay1 = ThisDrawing.Layers.Add("hidelay") '创建名为"hidelay"的图层
lay1.LayerOn = False '关闭图层
8 u9 b/ m- b% _1 @; ?moveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
ZoomExtents '显示整个图形
/ g! p3 \) d1 i) L, fFor i = 0 To UBound(vpoints) - 1 Step 2
  movep(0) = vpoints(i) '计算移动的轨迹
2 v9 c; p# J. Y2 _. j0 v7 I; R  movep(1) = vpoints(i + 1)
  ccline.Rotate cc, 0.05 '旋转直线
" A; G4 \6 _3 ?9 s% D  ccline.Move cc, movep '移动直线
  ccball.Move cc, movep '移动圆
  cc(0) = movep(0) '把当前位置作为下次移动的起点
4 Y8 V2 U& ]  p& e" j7 s  cc(1) = movep(1)
  For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置
7 g' x( d0 f- R& T% K   j = j * 1
) U) v1 P8 `5 _  Next j
  ccline.Update '更新
Next i
End Sub
$ r! R. h# f) p, ?' [2 b
本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定
2 M! b" F; b7 a5 p! ^3 t( z第十二课:参数化设计基础
简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。
    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

. P: Q) F5 p) `4 X
Sub court()
: Z! X9 u! j* L1 xDim courtlay As AcadLayer '定义球场图层
Dim ent As AcadEntity '镜像对象
Dim linep1(0 To 2) As Double '线条端点1
; g7 T. z9 {, _0 aDim linep2(0 To 2) As Double '线条端点2
( E0 d- N# U3 z5 d, fDim linep3(0 To 2) As Double '罚球弧端点1
" z- o& D0 [4 H) v, W. N& G+ `Dim linep4(0 To 2) As Double '罚球弧端点2
. ?) j0 }; e1 l9 ]. O) `$ [" y& HDim centerp As Variant '中心坐标
8 f0 `' E3 [5 l$ gxjq = 11000 '小禁区尺寸
; s- F+ T# O% K6 e; X( b4 pdjq = 33000 '大禁区尺寸
fqd = 11000 '罚球点位置
fqr = 9150 '罚球弧半径
fqh = 14634.98 '罚球弧弦长
jqqr = 1000 '角球区半径
zqr = 9150 '中圈半径
On Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
If Err.Number <> 0 Then '用户输入的不是有效数字
  chang = 105000
; h  P# y9 t+ l7 b1 [9 f  Err.Clear '清除错误
End If
kuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
If Err.Number <> 0 Then
  a, e6 @( W1 [; K+ r. i  kuan = 68000
End If
" o& Q# {/ p) i$ J7 m: ~! ocenterp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
Set courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
% V* e  D" O7 D2 M( }: o8 ?ThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
9 M, C: {3 m+ m. d2 K) X'画小禁区
linep1(0) = centerp(0) + chang / 2
' t5 U, j" R! }linep1(1) = centerp(1) + xjq / 2
linep2(0) = centerp(0) + chang / 2 - xjq / 2
" V6 d% u8 s" t$ N8 d+ H& [linep2(1) = centerp(1) - xjq / 2
& O4 v& [; O' n2 R7 ^# nCall drawbox(linep1, linep2) '调用画矩形子程序
) l9 R. G; O2 |9 l% ]
; }1 @0 j  o3 S7 y- s- [$ _6 p$ `'画大禁区
4 o& z" E! ?- {' `7 |linep1(0) = centerp(0) + chang / 2
9 i# G# y! f- X) w. u. `linep1(1) = centerp(1) + djq / 2
linep2(0) = centerp(0) + chang / 2 - djq / 2
linep2(1) = centerp(1) - djq / 2
8 q( a* O  t, Q; X7 O2 jCall drawbox(linep1, linep2)
2 W! q$ K& p; ^5 v
* u* \. {+ p/ J" u" n' 画罚球点
+ i7 U9 X" v( }5 r8 ]( h! r% i  p& Vlinep1(0) = centerp(0) + chang / 2 - fqd
/ K8 p2 d# F- P% I1 Y/ slinep1(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '点样式
; E4 X7 j0 F2 X& s. y7 H) i  X5 @, lThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸
3 A# o  g& i: x  c: [5 l'画罚球弧，罚球弧圆心就是罚球点linep1
" c+ R9 A" `4 olinep3(0) = centerp(0) + chang / 2 - djq / 2
linep3(1) = centerp(1) + fqh / 2
. C+ A: d. M- q- \! r# glinep4(0) = linep3(0) '两个端点的x轴相同
linep4(1) = centerp(1) - fqh / 2
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
, j; f9 F. E2 @. u, [8 o. BCall ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
2 w$ r4 T3 I: I
4 F. K! v9 O1 d7 n. ~'角球弧
1 i  l+ {& t4 r7 U9 y' U& U/ P( Eang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
0 c* H& U: X, Wang2 = ThisDrawing.Utility.AngleToReal(180, 0)
linep1(0) = centerp(0) + chang / 2 '角球弧圆心
linep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
5 W" b* ^' n1 S& Q7 m) A3 |ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
- K! E' n: h, G0 |* Qlinep1(1) = centerp(1) + kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

'镜像轴
linep1(0) = centerp(0)
linep1(1) = centerp(1) - kuan / 2
% f7 r0 k% q8 \9 R8 C$ \linep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2
" y5 V1 V1 I* f8 S# m  I) T'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
  G% F. m' s: i    ent.Mirror linep1, linep2 '镜像
  End If
Next ent
- s' O) _) u/ M'画中线
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)
'画中圈
1 V0 p; `- Q; W5 b, SCall ThisDrawing.ModelSpace.AddCircle(centerp, zqr)
! t# x6 E+ V+ x0 w'画外框
linep1(0) = centerp(0) - chang / 2
linep1(1) = centerp(1) - kuan / 2
2 G4 o% s" V! x# O2 _( {6 ^linep2(0) = centerp(0) + chang / 2
linep2(1) = centerp(1) + kuan / 2
" c% z, ^3 `. D0 Q* s; \Call drawbox(linep1, linep2)
ZoomExtents '显示整个图形
* u7 F9 H- K- q! d0 I5 h5 ?End Sub
1 K2 w6 U- @4 I. ~9 LPrivate Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
1 E/ Q, a8 W& A2 q. c+ j% JDim boxp(0 To 14) As Double
boxp(0) = p1(0)
/ ^# u2 b( k& `boxp(1) = p1(1)
' _+ [) G! [) o( E$ S2 E5 }* k' bboxp(3) = p1(0)
boxp(4) = p2(1)
boxp(6) = p2(0)
8 t/ u; X1 h# r) P% cboxp(7) = p2(1)
boxp(9) = p2(0)
boxp(10) = p1(1)
' J1 p0 A" p2 ^* Aboxp(12) = p1(0)
boxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub
7 B7 O% M3 Z9 V3 E& a6 @1 Y
( D8 a" K0 P/ k
* S% |( d& S: n+ y下面开始分析源码：
; @2 ?2 f- n1 G( @4 EOn Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
If Err.Number <> 0 Then '用户输入的不是有效数字
chang = 10500
) ^3 `  C6 h$ z: L, O: cErr.Clear '清除错误
End If
    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。
3 Q- y# ?0 }. ^( Q+ v) w
- M( m( y$ j: L: N/ }5 f" M    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。
+ c7 R$ y  x/ T9 [: r9 ^% Q$ W4 @
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
  k* }9 g8 `0 I" g$ Hang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
' ]. |3 x1 o, k* N    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
下面看镜像操作：
. n2 U% g- ~3 FFor Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
  End If
Next ent
    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。
! O  w" {! S* h- R6 D& @
本课思考题：
1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入
2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中

jshailin

谢谢楼主，正想学习  ！

renweidave

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

蓝色的海01

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

inuyasha_pw

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

dai8812312

真的很谢谢楼主    :lol:

no1sunshine

一直想找一些学习AUTOCAD二次开发方面的资料，真是不枉此点
. c4 v- x8 M  x# c4 J# t我觉得我真的是找到了一个好的归宿-------三维网
真的是我们这些学习机械专业的学生取经的好地方
$ _+ a# a6 P0 s$ [& l' [" i5 z+ ?- j谢谢各位前辈对我们的关怀

tzydsfy

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

shirleykine1980

原帖由 wsj249201 于 2008-6-21 14:13 发表 http://www.3dportal.cn/discuz/images/common/back.gif
Autocad VBA初级教程 (第一课:入门)
6 R8 {* t6 k+ F- H
" Y5 V' ?: ]; q3 Y4 }# H6 o! U第一课：入门

1.为什么要写这个教程
& O# y( D# h" M  X  [) `5 k市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是 ...

+ h- F9 c5 n4 G- {. C4 f; x好像没有声明变量，我重新编了一下，多多指教，我已经运行了，都是同心圆，好眼晕呀
4 i8 Q$ Z. l# j  TOption Explicit
" _; C  I/ j! U( U& X. b6 U9 fSub c100()
Dim c100 As AcadCircle
& a5 c5 t" j& M% MDim i As Double
Dim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
6 E  y9 N1 D+ o" t" |$ Acc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
, H3 t! O) h+ b) [Next i
( u6 u, I: R2 FEnd Sub

woaishuijia

Dim c100 As AcadCircle
7 ~( l; u) t; v1 e9 `- n" E" g9 C' z# {这一行没有用处，程序中并没有把添加的圆对象赋值给变量。
4 z6 |" s" p$ ]; d另外，不赞成变量名和过程名一样，容易出错的。

garychen

谢谢，真热心