AutoCAD VBA二次开发初级教程

bulish

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

powerpeak

正在打算学习二次开发的部分
' Y' `8 d" ^( U0 M- n8 a) M谢谢楼主

wordcad

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

xiaoship

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

hqzoe

真是多谢正好需要

tanlihua

找了了久,终于找到了

sky121

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

wuqitao0000

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

echo7411

谢谢哈   呵呵 很好用啊

ytcadtools

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

wsj249201

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

第一课：入门

1.为什么要写这个教程
) l; n9 D& z9 n! u市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
0 l5 a/ `2 n5 f3 X( |
' ?, L, Q& h+ i2 J6 I2.什么是Autocad VBA？
/ E& M0 o3 l, h. U2 v. r- W7 F4 rVBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
, v) T3 B3 b1 M: x# f4 N% F
3、VBA有多难？
1 \4 @# e7 o( I9 L9 r& w; _6 |相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。
6 D* R# g  o4 ?- P
4、怎样学习VBA？
介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
/ s3 w, N9 z4 `% O
5、现在我们开始编写第一个程序：画一百个同心圆
第一步：复制下面的红色代码
第二步：在模型空间按快捷键Alt+F8，出现宏窗口
$ x( r9 j2 v* a# d. {+ m1 p7 T第三步：在宏名称中填写C100，点“创建”、“确定”
, W5 q  {2 i% U1 K; }$ \3 f1 M第四步：在Sub c100()和End Sub之间粘贴代码
) X7 f8 Q! a6 B' Q" k第五步：回到模型空间，再次按Alt+F8，点击“运行”

! ]! t) c$ c, k- i/ zSub c100()
  A, j3 w6 }7 H! M, {% X, IDim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
. A" c: a2 \  I4 J8 ?& `/ s1 \% ycc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
; g$ ?6 K( [  {4 t- n& x* _: eCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
% Q7 k, K  S& A3 x$ F) [Next i
End Sub
, v6 t! X* l5 ]9 F' W7 S* o9 |
也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

wsj249201

第二课  编程基础
# O0 w) D- Z/ ]9 J! n+ D! g# l本课主要任务是对上一课的例程进行详细分析
下面是源码：
* K4 q) F2 p. PSub c100()
' c) j/ [% {/ F5 h$ Z4 Z% W7 r. SDim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
- w9 {5 w- Q, G4 j/ O! ?cc(2) = 0
' Q; O% s1 c9 W4 @2 G' KFor i = 1 To 1000 Step 10 '开始循环
* k# i% R. j" ~$ v  Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
Next i
End Sub
先看第一行和最后一行：
( h1 u& {) r0 H' tSub C100()
5 P$ c" S! b& ^3 \8 V7 \) ?/ s……
6 a( }+ k, P7 Q8 E% S7 H  AEnd Sub
2 Z' f$ ]: e1 i9 j8 Z, eC100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub　和end sub之间的所有指令。
) }& _6 b& j9 G. N7 f' M第二行：
  G! u2 O9 \+ ^* YDim cc(0 To 2) As Double '声明坐标变量
" F5 S; Z% I) T# o1 }后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注释，越详细越好，对于程序员来说，这是一个好习惯。
电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double
7 k) A2 L7 y, M- z" G* \5 h# c9 ~) w它的作用就是声明变量。
Dim是一条语句，可以理解为计算机指令。
它的语法：Dim变量名 As 数据类型
本例中变量名为CC，而括号中的0 to 2声明这个CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、CC(2)，如果改为CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了这个数组，就可以把坐标数值放到这个变量之中。
Double是数据类型中的一种。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD中数据类型的有很多，下面两个是比较常用的数据类型，初学者要有所理解。
# @( D; V9 k& CLong（长整型），其范围从 -2,147,483,648 到 2,147,483,647。
Variant  它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常用的。
( u5 [7 i$ b7 N1 C: t8 v下面三条语句
4 y6 ~: q5 R" H! W% @/ K6 mcc(0) = 1000 '定义圆心座标
cc(1) = 1000
+ n6 t4 q' q3 n6 acc(2) = 0
它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z坐标。
% ]  z2 |' O* A$ Q% H
For i = 1 To 1000 Step 10 '开始循环
% W0 T  n1 s/ o8 b……
Next i  '结束循环
这两条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到 1000时，结束循环。
i也是一个变量，虽然没有声明i变量，程序还是认可的，VB不是C语言，每用一个变量都要声明，不声明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很长，那就会出现一些意想不到的错误。
4 J+ A& z9 U4 Zstep后面的数值就是每次循环时增加的数值，step后也可以用负值。
  S1 B, C9 j2 t6 H+ _+ R6 V例如：For i =1000 To 1 Step -10
很多情况下，后面可以不加step 10
9 P; \1 h( K9 o; t6 U3 G如：For i=1 to 100，它的作用是每循环一次i值就增加1
Next i语句必须出现在需要结束循环的位置，不然程序没法运行。
下面看画圆命令：
9 m7 S7 L4 g& B6 y6 q/ ]Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
Call语句的作用是调用其他过程或者方法。
! m) T% ~8 g* SThisDrawing.ModelSpace是指当前CAD文档的模型空间
; @; b; L2 d# D+ F: xAddCircle是画圆方法
Addcicle方法需要两个参数：圆心和半径
CC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310……
* T( Y+ B" E5 M; b, o本课到此结束，下面请完成一道思考题：
1.以(4,2)为圆心，画5个同心圆，其半径为1-5

wsj249201

第三课 编程基础二
  X! k: L2 F! P
有一位叫自然9172的网友提出了下面的问题：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入
$ S# F4 l) |. f4 t* H/ e本课将讲解这个问题。

为了简化程序，这里用多条直线来代替多段线。以下是源码：
Sub myl()
Dim p1 As Variant '申明端点坐标
! A& m2 c, q& b! F1 A9 cDim p2 As Variant
3 k7 u- w) n2 p- Q2 cp1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
; k$ N( @# u9 l- p, k2 k1 c0 Fz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p1(2) = z '将Z坐标值赋予点坐标中
6 u* J, d) A' \. WOn Error GoTo Err_Control '出错陷井
1 X2 b8 U6 @0 c  r! {  @Do '开始循环
! M2 l) p/ C5 j% e0 Q3 I! d+ x  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  p2(2) = z '将Z坐标值赋予点坐标中
! N. i' G% _5 b0 p* e  Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
Err_Control:
. ^: e+ F  T" H" l, c6 U/ I4 n- O9 B/ WEnd Sub

0 U% U8 I; U" K, ?, I* N先谈一下本程序的设计思路：
: l! |; m1 M: I8 E5 X! x: l1、获取第一点坐标
; ]" ~) _, d, p/ Q9 y( M. s) w2、输入第一点Z坐标
" z" B$ |. ]1 p: y' ]3、获取第二点坐标
4、输入第二点Z坐标
$ t% m2 a# o# ]9 l5、以第一、二点为端点，画直线
6、下一条线的第一点=这条线的第二点
, ]1 z) _" T2 @* p7、回到第3步进行循环
  V* g: L" p$ C/ N3 A如果用户没有输入坐标或Z值，则程序结束。

首先看以下两条语句：
  I* o! {7 x% ^6 c8 np1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标
( x8 g2 Q3 T$ T5 L……
p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
- ]7 F5 R) X$ X* x9 b$ V6 l这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。ThisDrawing.Utility.GetPoint（）在ACAD中这是最常用的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。
$ s) B% ^5 U8 j) v. o0 |) w. Y逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。
! `, G) L7 N- o6 C' s/ L5 lVbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”
  j$ r, u% z! x$ i1 z# Y- Y. i&的作用是连接字符。举例：
! m6 B9 d# |0 U# ~5 E  D“爱我中华 ”&”抵制日货 ”&”从我做起”

' k6 q- ?8 P; ?1 y( L" Vz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
由用户输入一个实数
2 A5 [/ v- G" A/ w
7 \' Y6 i7 T2 y# X" L. b( bOn Error GoTo Err_Control '出错陷井
……
/ n, O2 f" \3 I/ ?4 Q/ ]- ^Err_Control:
) K' P" i+ E1 S4 jOn Error是出错陷井语句，在程序出错时将执行On Error 后面的语句
# |7 k  `7 Z$ yGoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句，本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。

# V$ I4 \1 e$ b% A' B, vDo '开始循环
" m; D  G  {0 G& t! I……
7 j3 ^4 C7 w0 S# _Loop ‘结束循环
这个循环就历害了，它会无休止地进行循环，好在本例中已经有了一个出错陷井，当用户输入回车时，由于程序没有得到点或坐标，程序出错，跳出循环，中止程序。如果要人为控制跳出循环，可以在代码中用Exit Do语句跳出循环。在For 变量 和Next 变量之间如果要跳出循环，那么只要在循环体内加一个Exit for 就可以跳出循环，关于这方面的例程以后会讲到。
/ a+ n0 I4 z. J
& M9 l" b  O* N4 j6 N' GCall ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
画直线方法也是很常用的，它的两个参数是点坐标变量

本课到此结束，请做思考题：
连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出
, s; h' _' T3 T
第四课 程序的调试和保存

( e# Q4 b0 d8 _6 U/ n1 k
人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，随着学习的深入，以后我们需要经常进行程序调试。事实上，对于那些资深程序员来说，调试程序也是一项不可或缺的重要工作。

6 j0 V+ B) A# m8 H) I首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB键（它位于“Q”键左边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。
/ w0 S5 z, j( I9 @6 t- \我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变化。下面我举一个简单的例子，先看源代码：
sub test()
for i=2 to 4 step 0.6
2 F$ E) ?- {6 Q* J- [/ bnext i
end sub
, j7 s5 Z8 c1 R$ `2 ]3 Q) N% y这是一个非常简单的循环，每一次循环i便会增加0.6，当循环3次后i值就变为4.4，但问题是每一次循环时i值变为多少？
/ p8 ]: a& k7 i. w6 s! @, [第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。
第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。
! _/ `) s7 [4 ?3 r好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。
第三步：在next i行再按一次F9，清除断点。监视的表达式的右键菜单选择“删除监视”。
另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。

到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的Autocad图形文件中， 以后打开这个文件时代码才会加载，如果别的dwg文件也要使用，那就需要把代码导出为.bas文件，供其他dwg文件导入。在VBA编辑器的“文件”菜单中有这两个功能，一试便知。
ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图形文件中共享，但是由于VBA功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要这样做。
5 B5 F3 N9 `. H2 P$ ], i
本课结束，请做思考题；监视下列代码中的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
6 @& F" F* |" \. F$ mend sub

wsj249201

第五课 画函数曲线
先画一组下图抛物线。



% M- i1 J2 }$ ^下面是源码：
# m/ S4 v& j5 X6 rSub myl()
& j0 W: e$ O3 u: B. c, L5 k$ DDim p(0 To 49) As Double '定义点坐标
Dim myl As Object '定义引用曲线对象变量
co = 15 '定义颜色
For a = 0.01 To 1 Step 0.02 '开始循环画抛物线
  For i = -24 To 24 Step 2 '开始画多段线
3 s) }- w4 x5 \. }) g& ^; i; T* S    j = i + 24  '确定数组元素
    p(j) = i '横坐标
    p(j + 1) = a * p(j) * p(j) / 10 '纵坐标
  Next i '至此p(0)-p(40)所有元素已定义，结束循环
, @$ j! E& L: z  Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
3 `2 y* c. z3 O1 e8 F* b  myl.Color = co '设置颜色属性
. n7 S: o; Z% W5 [2 S  co = co + 1 '改变颜色，供下次定义曲线颜色
Next a
End sub
为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如果有问题不懂请跟贴提问。
在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化。
ACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正负24之间。
程序第二行：Dim myl As Object '定义引用曲线对象变量
Object也是一种变量类型，它可以把变量定义为对象，本例中myl变量将引用多段线，所以要定义为Objet类型。
看画多段线命令：
7 b9 ~+ A! l+ B+ RSet myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。
3 T$ e( Z: G; g* c4 W- A等号前面部分“Set myl”的作用就将myl变量去引用画好的多段线。
% P/ P$ ?& b/ H* ]2 z0 g% U- pmyl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co会增值，这样就会有五彩缤纷的效果。
* }. ~9 r+ \6 h* I1 O  w本课第二张图：正弦曲线，下面是源码：
6 T/ f+ `& m) R' }! i# R; GSub sinl()
/ e/ [3 ?* m1 \7 w' dDim p(0 To 719) As Double '定义点坐标
For i = 0 To 718 Step 2 '开始画多段线
' @) c+ \- P, V, Y    p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
    p(i + 1) = 2 * Sin(p(i)) '纵坐标
4 `9 n9 c" o# u, ~) ZNext i
) |2 O9 ~) w7 ~9 R2 A4 h9 Q8 fThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线
ZoomExtents '显示整个图形
$ z6 k% r9 E* E: h7 dEnd Sub
5 {/ u5 f) m% j
p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
横坐标表示角度，后面表达式的作用是把角度转化弧度
ZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域
8 ~6 J. M6 L$ j! f2 [本课思考题：画一条抛物线：y=0.5*x*x+3，其中X取值范围在正负50之间
第六课 数据类型的转换
上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。
我们举例说明：
0 p3 A: `7 }2 Z' e" djd = ThisDrawing.Utility.AngleToReal(30, 0)
4 s1 J  G) @9 d7 S/ H* z4 \; `# c这个表达式把角度30度转化为弧度，结果是.523598775598299。
. |0 H( F9 m2 Y( ]! tAngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为0-4之间的整数，有如下意义：
, T5 e3 {) }4 K. Y* ]' y/ I  H0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位
% s. V& \: @& t4 z5 Y例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1)
7 z& v  }' r9 a* C  h8 j/ d这个表达式计算62度30分10秒的弧度
( F2 g4 ^  X* }" a再看将字符串转换为实数的方法：DistanceToReal
需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义：
1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。
例：以下表达式得到一个12.5的实数
$ [! o. g5 @5 k) Y$ Ctemp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1)
- r# R- }+ g6 E5 x* q- f' A8 rtemp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2)
temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5)
6 M: n) D& c. E而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数
' V9 A8 C/ i! x4 p! b第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。
% W" s1 G: ~; ~5 gtemp1= ThisDrawing.Utility.RealToString(12.5, 1, 3)
得到这个字符串：“1.250E+01”，
% M2 y4 {' Y' g" w) h2 ^, U5 R下面介绍一些数型转换函数：
$ H# B. l" E+ y' u* a$ YCint，获得一个整数，例：Cint(3.14159) ，得到3
Cvar，获得一个Variant类型的数值，例：Cvar("123" & "00")，得到”12300”
Cdate，转换为date数据类型，例：MyShortTime = CDate("11:13:14 AM")
下面的代码可以写出一串数字，从000-099。
% d( ?3 L& K6 a% Y; Y9 xSub test()
$ \$ n( i/ L; d4 ?7 b% [; D0 ]Dim add0 As String
' w6 `, ]% M  N% ?; `) j& cDim text As String
+ q  D7 }/ q- P  G. HDim p(0 To 2) As Double
p(1) = 0 'Y坐标为0
. E* F( x8 s0 w1 F1 e8 s9 zp(2) = 0 'Z坐标为0
For i = 0 To 99 '开始循环
1 x: P% `) e8 R3 J  If i < 10 Then '如果小于10
1 V' m) ?+ U3 i8 |* Z    add0 = "00" '需要加00
8 N" u, o' _/ _9 _6 v3 s0 u0 I7 \  Else '否则
8 ~$ y# z4 |+ s2 q( N: K2 S8 U    add0 = "0" '需要加0
  End If
  text = add0 & CStr(i) '加零，并转换数据
  p(0) = i * 100 'X坐标
$ o& q- G1 i/ J* j  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
) T" v3 ]2 m+ t/ E0 _( S& B  Next i
  
End Sub
  {. S. p1 U1 n4 e+ D2 Q
重点解释条件判断语句：
+ i9 O" G% A! \If 条件表达式 Then
……
Else
, C6 ?* B* e# Z3 e* s3 ?……
* |; k! q9 _: |1 u! a9 I( VEnd if
如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if后面
如果不满足条件，程序跳到else后往下运行。
0 X* t3 d* m% F  v+ D  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
+ q) _+ g7 D, B这是写单行文本，需要三个参数，分别是:写的内容、位置、字高
% z3 B% g. q! D1 A" R' ]第七课
, v: B* y! }' c/ w写文字
客观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是把定义文字样式，用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。
Sub txt()
1 m5 z. `8 W# Q- [, ^Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
Dim p(0 To 2) As Double '定义坐标变量
p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值
- o& E) G! v7 n2 H! [4 ZSet mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
% K1 T; a( Y" L2 M& U3 r7 i1 [7 Jmytxt.f '设置字体文件为仿宋体
4 k# S7 j1 v5 Q2 y% gmytxt.Height = 100 '字高
5 F8 x# \/ V/ Y1 T# I8 D- H9 c* Rmytxt.Width = 0.8 '宽高比
0 _" q  @: Q4 ~) s+ B! |mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度）

4 I$ C" M) O; a+ {8 s" JThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
Set txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
5 }0 ?; @( G" h7 xtxtobj.LineSpacingFactor = 2 '指定行间距
& [, A/ C! e3 a2 ctxtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2为居中）
End Sub
我们看这条语句
Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
8 x# a$ U/ j& Z+ t  G添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名
+ d: T0 h. ~# [! m5 z% ?1 a# T& Xfontfile、height、width、ObliqueAngle是文本样式最常用的属性
; w) i" w) k# C' }; fCall ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
这条语句是写文本，需要三个参数。第一个参数p是坐标，1400是宽度，最后一个参数是文本内容，其中\p是一个回车符
扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3 部，n取值范围是0.75-3
在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34
\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
( ~' S8 V" f! \9 E* P: @  q7 V\C是颜色格式字符，C后面跟一个数字表示颜色
\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐
5 @$ G) Y- }& ~; ]& l0 x0 S第八课:图层操作
先简单介绍两条命令：
1、这条语句可以建立图层：
3 ~' x, D: k' k  ]' }) W# E1 QThisDrawing.Layers.Add("新建图层")
: G$ H% Z% k" m& K! ]3 n, E* \; N在括号中填写图层的名称。
( m0 L' e7 K3 Q, d0 F( e2、设置为当前的图层
ThisDrawing.ActiveLayer=图层对象
9 p8 w: X$ t( p$ n注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量
( }9 D7 m% c0 t  v以下一些属性在图层比较常用：
LayerOn 打开关闭
Freeze 冻结
' r5 `: l( {4 z7 t- s9 @8 M& q) ULock锁定
6 T: ~# C7 d( J. q( @! vColor 颜色
Linetype 线型

看一个例题：
2 o. ]! x) K7 v" ^1 r1、先在已有的图层中寻找一个名为“新建图层”的图层
2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置为当前图层。
3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层
* J' K3 g, e  C0 @4 b3 M4 N7 l1 n0 GSub mylay()
Dim lay0 As AcadLayer '定义作为图层的变量
& x* b% h) v, _8 @3 pDim lay1 As AcadLayer
- }6 D9 M5 o' x! r# N8 ~3 Zfindlay = 0 '寻找图层的结果的变量，0没有找到，1找到
, X9 d( |9 d; H; B/ CFor Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环
2 [8 T* ]) S0 n, }" w: f. I  If lay0.Name = "新建图层" Then '如果找到图层名
    findlay = 1 '把变量改为1标志着图层已经找到
    msgstr = lay0.Name + "已经存在" + vbCrLf
    msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf
9 q( o, f. ]; ?  x3 ^+ q0 a9 {    msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf
    msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf
7 A4 c. u1 A  l3 c4 y, o" c/ z    msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf
/ ^& Y- Q  X' u& E; I2 N    msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf
8 @# |, \8 W5 f    msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf
, v0 E$ `# h% `+ E4 p) ~! g    msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf
  n& g6 a* h6 ^% M    msgstr = msgstr + "是否设置为当前图层？"
    If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定
) p7 }* T: k4 h* F       If Not lay0.LayerOn Then lay0.LayerOn = True '打开
2 ?' U; L8 z, A2 L       ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层
    End If
! B! p8 V* Y3 k$ X4 ^2 ?    Exit For '结束寻找
  End If
9 c; U: }% v& M. _9 lNext lay0
If findlay = 0 Then '没有找到图层
$ ]% s3 |5 \( i$ Z  Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层
7 n/ C4 I# g7 ?: x  lay1.Color = 2 '图层设置为黄色
  
; A: f! @6 \2 o4 C1 M7 s' W  ltfind = 0 '找到线型的标志，0没有找到，1找到
2 T! {( z9 J& Y( c! ~  For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环
7 Y- I/ [3 d( X$ t& k7 `: _# b6 S& [    If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN"
8 z& v! w0 R* {5 U# _0 b. b% X; X; e      ltfind = 1 '标志为已找到线型
      Exit For '退出循环
7 C3 f5 j5 F1 |, y) B    End If
  Next entry '结束循环
  If ltfind = 0 Then '没有找到线型
    ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型
) o6 B2 T% K1 o$ ]  End If
  lay1.Linetype = "HIDDEN" '设置线型
  ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层
End If
End Sub
在寻找图时时我们用到for each……next 语句
, X. D5 g0 _# L它的语法是这样的：
For Each 变量 In 数组或集合对象
0 u  C+ `) i) }, V' x……
+ N/ S: D0 `0 Q/ l' a! oexit for
' }1 O2 g2 O8 \1 c& S# o% n……
next 变量
9 I! Y% }! H  m7 B它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层
在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。
If lay0.Name = "新建图层" Then
lay0.name代表这处图层的图层名
IIf(lay0.LayerOn = True, "打开", "关闭")
这是一个简单判断语句，语法如下：
7 G# l$ W. F% p9 K/ Viif（判断表达式，返回值1，返回值2）
$ h" I0 H( i7 H# b! d当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2
2 b( t- n. r+ d- |MsgBox(msgstr, 1)
8 w! _# F: n! v) I# p; w1 iMgbox显示一个对话框，第一个参数是对话框显示的内容
第二个参数可以控制对话框上的按钮。
, ~5 J2 @9 o: q$ c1 C; @0 只有确认按钮
1 确认、取消
% I/ Q; @, D9 y$ a$ ]# z2 终止、重试、忽略
3 是、否、取消
4 是、否
; W( @) Y; G- H2 d( K- RMsgBox获得值如下：
8 `9 V- [. h( q5 c! ]. X% i- i确认：1
. P5 d" i$ J2 _7 I, b/ \2 |取消：2
终止：3
# @! z" }& y  }1 _3 {7 d重试：4
忽略：5
- m! P( `5 p! f2 [  g$ y* w是：6
否7
初学者不需要死记硬背，能有所了解就行了
/ J7 G- S+ L5 [0 TACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：
ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin"
& b$ i8 q# S% S' [% A. CThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。


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

wsj249201

第九课:创建选择集
1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
3 Z9 d4 L4 }/ r$ ^Sub c300()
# ?7 U  r) f2 x8 Z: [Dim myselect(0 To 300) As AcadEntity '定义选择集数组
Dim pp(0 To 2) As Double '圆心坐标
For i = 0 To 300 '循环300次
& S1 m4 O- A* d" npp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
) R, R& O, I. T$ xNext i
For i = 1 To 300
If myselect(i).Radius > 10 Then '判断圆的直径是否大于10
myselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
Else
+ V+ r, H; l. O; K6 B8 k1 bmyselect(i).color = 0 '小圆改为白色
End If
Next i
- ?) q- z& Z3 q1 D( o5 aZoomExtents '缩放到显示全部对象
End Sub
) M/ C8 g! C7 X- s! C% L
* R& r$ [/ n& npp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
  Y7 L0 a, O# t" v  B. H9 zrnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
2.提标用户在屏幕中选取
选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
: H9 _# u$ y3 u4 _Sub mysel()
Dim sset As AcadSelectionSet '定义选择集对象
! C5 r$ U$ P$ q* k! iDim element As AcadEntity '定义选择集中的元素对象
Set sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
sset.SelectOnScreen '提示用户选择
( N* h! ?& P, }: D3 `For Each element In sset '在选择集中进行循环
) q- M3 g! i* \3 k+ I  B  element.color = acGreen '改为绿色
Next
& }4 C1 S0 C% A3 ^5 ]0 @& \sset.Delete '删除选择集
End Sub
: X% t2 ^" d1 T, V3.选择全部对象
用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
  {: s2 l+ D- k5 H! Y6 QSub allsel()
. e% P- v; f& G& a3 a4 E- W) UDim sel1 As AcadSelectionSet '定义选择集对象
* j8 K( k& H7 u. D2 K) R) fSet sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
' P& w# U6 Q) x! }# @Call sel1.Select(acSelectionSetAll) '全部选中
# P  a9 I" F. S& W4 n: f3 Tsel1.Highlight (True) '显示选择的对象
sco= sel1.Count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
End Sub

3.运用select方法
- k( }4 u7 c0 c) D上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
0 V# W) t5 v( {( _2 e% \1:择全部对象(acselectionsetall)
2.选择上次创建的对象(acselectionsetlast)
( |# }+ E  }8 n- U- |3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
还是看代码来学习.其中选择语句是:
Call sel1.Select(Mode, p1, p2)
Mode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
9 h. s8 M0 {! n' [/ X1 M0 ~" iSub selnew()
+ |( Q  R9 g7 b1 k! ~2 vDim sel1 As AcadSelectionSet '定义选择集对象
Dim p1(0 To 2) As Double '坐标1
1 K: V) v# J) }) v' yDim p2(0 To 2) As Double '坐标2
  V% t/ w3 Q% H$ mp1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
p2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
Mode = 5 '把选择模式存入mode变量中
6 O1 E* J5 q1 GSet sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
Call sel1.Select(Mode, p1, p2) '选择对象
3 P: P0 `$ P# p/ d) W/ B' r  x2 r, lsel1.Highlight (ture) '显示已选中的对象
" v' D5 U! B) f. WEnd Sub
8 f/ o" @+ F# }* w4 w; ~6 h' P第十课:画多段线和样条线
7 X9 ]( r; b, ^; b; ^/ u画二维多段线语句这样写：
5 v, k% A- r3 s! F. y& Tset lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
AddLightweightPolyline后面需一个参数，存放顶点坐标的数组
7 B+ n9 Q1 r( J0 z: }' |& B画三维多段线语句这样写：
. w' c2 e. D( FSet lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
. e/ t: h2 r4 j' _; QAdd3dpoly后面需一个参数，就是顶点坐标数组
画二维样条线语句这样写：
; M3 O( w( O% k" a# g- w9 a9 kSet lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
Addspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
; P9 C  n7 C+ K' S( l下面看例题。这个程序是第三课例程的改进版。原题是这样的：
. u- {& n5 A( d3 [绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
Sub myl()
Dim p1 As Variant '申明端点坐标
7 q4 G& W9 D: qDim p2 As Variant
Dim l() As Double '声明一个动态数组
Dim templ As Object
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
5 _4 p8 D3 r6 s% S8 f# n" up1(2) = z '将Z坐标值赋予点坐标中
! N3 F* t% t' f5 k" N" W9 VReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
l(1) = p1(1)
l(2) = z
On Error GoTo Err_Control '出错陷井
Do '开始循环
. B3 \, E+ w/ E  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
, l5 P; e0 c. M. x4 N  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
( d  x# \" `( F, ~3 R; o1 ~  p2(2) = z '将Z坐标值赋予点坐标中
( ^4 j; s$ J" ~, L  
  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
3 z/ t8 D1 P) Z4 @4 b( ~* H5 D    templ.Delete '删除前一次画的多段线
: c! G2 w* m: h4 z7 {7 w  End If
  Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
Err_Control:
" a% m2 W5 e3 ?5 L/ mEnd Sub
- @8 D6 Y7 O; ]  ~
我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
! Z# S  i# x; K这样定义数组：Dim l( ) As Double
赋值语句：
ReDim l(0 To 2)
; w2 r8 H" m( J" \" N  ^' M9 z9 `l(0) = p1(0)
" s! l# |* q" u7 R; W5 tl(1) = p1(1)
4 q+ i; b8 e0 g; V# z9 wl(2) = z
. v4 x7 ?. M1 Q3 i, q" ?8 Z重新定义数组元素语句：
  lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
/ D( }3 \0 ]. @  ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
再看画多段线语句：
  N, k! k/ }  f1 y7 i  RSet templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
2 Q! e/ H" D! ~$ V3 C+ [在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
' w. t# u4 c  ]* X0 k* @+ X删除语句：
templ.Delete
因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
/ O  I) v) n. n8 S下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
# X. u% ~! }2 KSub sp2pl()
8 J$ G" b- O1 r( MDim getsp As Object ‘获取样条线的变量
Dim newl() As Double ‘多段线数组
Dim p1 As Variant ‘获得拟合点点坐标
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
sumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
) l5 k- A- ~6 Y* }5 ?ReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
  
  For i = 0 To sumctrl - 1 ‘开始循环，
6 }$ F6 N$ c, K$ e  p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
      For j = 0 To 2
    newl(i * 3 + j) = p1(j)
  Next j
+ p; n. S' {! X4 x. H8 ~Next i
Set templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
End Sub
# ^( G0 Z  e0 f& p( r下面的语句是让用户选择样条线：
" ?2 x. w- F! Q, p$ MThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
; x  R0 Q, c. u" MThisDrawing.Utility.GetEntity 后面需要三个参数：
. E! z* z# J* M) q7 X& L第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。
第十一课:动画基础
+ M" f4 D* f' y; U说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
    下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。

    移动方法：object.move 起点坐标,端点坐标
Sub testmove()
Dim p0 As Variant       '起点坐标
0 v, @0 s- a" I- l: S' \Dim p1 As Variant       '终点坐标
  Q* v- D& U( mDim pc As Variant       '移动时起点坐标
6 C4 `) l, t. L) nDim pe As Variant       '移动时终点坐标
Dim movx As Variant     'x轴增量
4 K% p# z' O2 w  _Dim movy As Variant     'y轴增量
Dim getobj As Object    '移动对象
Dim movtimes As Integer '移动次数
ThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象"
: ~) a3 S2 J' Xp0 = ThisDrawing.Utility.GetPoint(, "起点:")
% S3 z/ ]- o+ L8 A$ tp1 = ThisDrawing.Utility.GetPoint(p0, "终点:")
/ d7 Y' \/ l6 Zpe = p0
5 }2 M( O2 g+ k3 B* N+ zpc = p0
motimes = 3000
movx = (p1(0) - p0(0)) / motimes
movy = (p1(1) - p0(1)) / motimes
For i = 1 To motimes
  pe(0) = pc(0) + movx
  pe(1) = pc(1) + movy
+ W; }8 H; y- N) B. F# u3 `, {* |  getobj.Move pc, pe    '移动一段
  getobj.Update         '更新对象
Next
, j1 N! y: p( L, o9 k( iEnd Sub
先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。
看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。
/ Y) i. b* |. }旋转方法：object. rotate 基点,角度
" q% @& I0 U% y7 o/ W偏移方法： object.offset(偏移量)
8 D$ J* D7 B* C  W; C& L% KSub moveball()
9 L3 u0 ?% Q4 v7 `: u9 y* M- K1 ADim ccball As Variant '圆
7 {3 v: |, B- |7 G- d- KDim ccline As Variant '圆轴
6 Q& s: g5 g' ~$ O& U! q# b; vDim cclinep1(0 To 2) As Double '圆轴端点1
Dim cclinep2(0 To 2) As Double '圆轴端点2
1 H' K8 |- G) z* D4 K, l9 D0 GDim cc(0 To 2) As Double '圆心
9 a' F! s: [6 tDim hill As Variant '山坡线
Dim moveline As Variant '移动轨迹线
% R& R, ^0 a; g" JDim lay1 As AcadLayer '放轨迹线的隐藏图层
9 H- t/ K$ D$ I2 NDim vpoints As Variant '轨迹点
& h. @. ^( D% V$ {+ VDim movep(0 To 2) As Double '移动目标点坐标
$ i: F  f7 R* R) P& `cclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标
  Y, m7 `5 [5 a& {2 I0 T; SSet ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线
  j7 `5 c3 e' |9 @. z/ nSet ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆

2 \7 f& X, C1 R; u3 sDim p(0 To 719) As Double   '申明正弦线顶点坐标
7 v# v6 U0 d( Y/ o( }For i = 0 To 718 Step 2 '开始画多段线
6 L  g/ A% f: U3 \    p(i) = i * 3.1415926535897 / 360  '横坐标
    p(i + 1) = Sin(p(i)) '纵坐标
8 \- Z  \7 M- X& [1 b( L% X; {Next i
) \1 u; p% i# }* ]  
Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线
hill.Update '显示山坡线
moveline = hill.Offset(-0.1) '球心运动轨迹线
vpoints = moveline(0).Coordinates '获得规迹点
  @( e2 {3 Q& `Set lay1 = ThisDrawing.Layers.Add("hidelay") '创建名为"hidelay"的图层
lay1.LayerOn = False '关闭图层
4 r: f: b2 {* K6 u, Hmoveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
% o; M0 J5 @: S( U) y' [# `ZoomExtents '显示整个图形
5 a- q5 |) |) ]0 j9 MFor i = 0 To UBound(vpoints) - 1 Step 2
  movep(0) = vpoints(i) '计算移动的轨迹
. n6 [4 V& @5 R1 |% C6 O/ L* q- @  movep(1) = vpoints(i + 1)
  ccline.Rotate cc, 0.05 '旋转直线
# B' S3 q2 I3 F$ f  ccline.Move cc, movep '移动直线
  ccball.Move cc, movep '移动圆
  cc(0) = movep(0) '把当前位置作为下次移动的起点
  cc(1) = movep(1)
* {  b: w# ?0 S% k3 ]- a- B7 Y  For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置
   j = j * 1
9 X- e' A. G1 q  Next j
& k) B! }/ ~/ b1 s  ccline.Update '更新
+ B: |. v' O$ v+ T' W. uNext i
End Sub

8 H3 F. m# I. S& c本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定
8 d: o. H1 t" i9 h( n" o1 n第十二课:参数化设计基础
5 A7 T2 W# L$ U: B% t* W" e  \0 ?" L简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。
    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。
1 T" K# r  I% m+ e9 o4 l1 U

2 s( H5 Q5 v3 {5 [& [Sub court()
3 T# v$ Q, x! @- r0 yDim courtlay As AcadLayer '定义球场图层
! C8 d# `4 G; N/ g( L; ]/ ?  pDim ent As AcadEntity '镜像对象
# s& e$ X* h; @+ x- L" Z' d( I: SDim linep1(0 To 2) As Double '线条端点1
Dim linep2(0 To 2) As Double '线条端点2
  |( d7 ~; j8 P; m. W8 z- vDim linep3(0 To 2) As Double '罚球弧端点1
# @4 _* s; U* A7 ?Dim linep4(0 To 2) As Double '罚球弧端点2
# J: x- j2 R7 A. R; yDim centerp As Variant '中心坐标
% U$ I$ @  ?# R( R  w. g, I+ Mxjq = 11000 '小禁区尺寸
djq = 33000 '大禁区尺寸
fqd = 11000 '罚球点位置
fqr = 9150 '罚球弧半径
* t. `2 H3 L2 c) B+ y$ _% jfqh = 14634.98 '罚球弧弦长
jqqr = 1000 '角球区半径
# s3 K" J7 }3 l( G+ l/ yzqr = 9150 '中圈半径
6 C) W! e* ]) T3 ]+ m8 {. VOn Error Resume Next
2 }- J+ P9 m# s- _% C) z: N# Pchang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
If Err.Number <> 0 Then '用户输入的不是有效数字
% C- ]& ~6 L5 H+ _% c$ v# o$ o  chang = 105000
* F: r' H8 U% w  Err.Clear '清除错误
End If
9 r- i* H2 z5 T3 i) V+ ?kuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
If Err.Number <> 0 Then
  kuan = 68000
7 m, r  T! h3 L4 K. N0 t8 fEnd If
centerp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
' z' M' Y; P3 vSet courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
( Z# t* G& j9 w; c& }ThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
5 n; r* i/ a% Q% A1 c, L'画小禁区
, c( V6 E* A) C! R2 M3 i2 _& ulinep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + xjq / 2
linep2(0) = centerp(0) + chang / 2 - xjq / 2
& F/ ~% N0 l1 ~7 {! C9 w8 C& t+ T- Dlinep2(1) = centerp(1) - xjq / 2
Call drawbox(linep1, linep2) '调用画矩形子程序

6 b: \' a. w& M0 M'画大禁区
linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
! V. ~) A  Q# m6 u) g: f3 ^- Olinep2(0) = centerp(0) + chang / 2 - djq / 2
7 ?+ E# g' [6 s  s* M1 Q7 ~9 _linep2(1) = centerp(1) - djq / 2
! k, T" m- @2 `* lCall drawbox(linep1, linep2)
! e5 d. O) o, S; b0 t' G& ]
, d3 B1 f9 F; P$ m, d' 画罚球点
  N2 x4 E) B4 [9 Vlinep1(0) = centerp(0) + chang / 2 - fqd
3 o0 `* ~9 y/ E. L, Olinep1(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddPoint(linep1)
% ]: R4 V% n# x9 l( U'ThisDrawing.SetVariable "PDMODE", 32 '点样式
& x) v- ^+ I5 gThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸
'画罚球弧，罚球弧圆心就是罚球点linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
linep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '两个端点的x轴相同
5 o1 l0 f/ c& `) g0 |* X+ K8 Vlinep4(1) = centerp(1) - fqh / 2
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
0 d8 }( U1 {6 Z2 C: A; Zang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
7 `8 A8 I3 t1 D/ l2 s# U8 iCall ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
7 L. o. p3 [# A% C
9 P  I( T0 p+ I. }/ k' j'角球弧
ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
, a) ^$ Y$ B4 n! f2 |ang2 = ThisDrawing.Utility.AngleToReal(180, 0)
linep1(0) = centerp(0) + chang / 2 '角球弧圆心
, Y$ M9 n( ~# w$ mlinep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
linep1(1) = centerp(1) + kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)
+ M6 O: P$ e# q# x
( G8 O7 t9 B- A% W9 J'镜像轴
  y3 l0 H& _2 _; T0 Nlinep1(0) = centerp(0)
5 _* {, K. `. D& r$ dlinep1(1) = centerp(1) - kuan / 2
3 T: {, V: l( S5 y6 _! C! xlinep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2
'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
( k: Q& z/ q' n0 F2 {8 }2 R0 y  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
" W# ]- m2 x4 \& z  End If
% k; L. Z# e" `- ?7 \& b( A3 INext ent
'画中线
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)
" @0 T( Q5 o$ c/ n'画中圈
Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)
* r! @1 @9 o; v+ V'画外框
linep1(0) = centerp(0) - chang / 2
2 w+ S& k, a4 u, T: k1 T7 _& p6 [linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0) + chang / 2
linep2(1) = centerp(1) + kuan / 2
$ k' o4 L2 A; V5 Y$ D% i0 K/ ~" h' uCall drawbox(linep1, linep2)
( v; O2 U" l+ o# e- [2 V. bZoomExtents '显示整个图形
6 V- X' h9 l0 P! T8 A* ]2 jEnd Sub
Private Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
Dim boxp(0 To 14) As Double
boxp(0) = p1(0)
boxp(1) = p1(1)
boxp(3) = p1(0)
$ P/ K. f7 X) c9 Zboxp(4) = p2(1)
boxp(6) = p2(0)
, W, H. d% v- J5 \" \# x2 qboxp(7) = p2(1)
boxp(9) = p2(0)
: Z' i  q' }/ R$ f1 M7 q. dboxp(10) = p1(1)
boxp(12) = p1(0)
* K) e( @2 O1 t* r5 }1 jboxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
& ?* `: c: l# }End Sub
3 X- [& y- R& l6 f* A* N; h5 L

下面开始分析源码：
( |4 r) M/ Z& v/ [( Z3 k# e$ h" S+ UOn Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
# |8 \( a0 t$ M% MIf Err.Number <> 0 Then '用户输入的不是有效数字
- B/ Q( U# I9 C% i( Q2 \chang = 10500
  ?, z  a  v+ Z5 XErr.Clear '清除错误
% o  n1 p1 m* z, qEnd If
    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。

    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。

  p- T. V0 O' Z& u6 Y, Dang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
2 S1 Y& X. D- y( ZCall ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
下面看镜像操作：
3 y% a8 D5 B5 k( y! v. e& [For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
$ H1 T- i( u- V$ ]8 D: v6 ]4 p  End If
7 ^. g8 X2 Q% j3 Z1 TNext ent
! c, o  l! ?* R9 K/ u- x/ r) S    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。

本课思考题：
" @+ Q+ t! h3 ~7 q* S1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入
1 M) _( ~# C. y2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中

jshailin

谢谢楼主，正想学习  ！

renweidave

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

蓝色的海01

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

inuyasha_pw

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

dai8812312

真的很谢谢楼主    :lol:

no1sunshine

一直想找一些学习AUTOCAD二次开发方面的资料，真是不枉此点
我觉得我真的是找到了一个好的归宿-------三维网
. W: H6 @& T0 n' q真的是我们这些学习机械专业的学生取经的好地方
谢谢各位前辈对我们的关怀

tzydsfy

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

shirleykine1980

原帖由 wsj249201 于 2008-6-21 14:13 发表 http://www.3dportal.cn/discuz/images/common/back.gif
) ?3 g4 f- o4 \. B6 R) I8 n6 D, HAutocad VBA初级教程 (第一课:入门)
) v, u7 b# I# O8 n/ L% I
: z+ u. S+ P  F" F第一课：入门

' {" N- k1 _, [2 D. x1.为什么要写这个教程
8 X5 @) E. T/ C  I1 U5 L& q8 z市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是 ...

* X8 \) w7 o' t, t+ x" t2 A) @
1 o$ g4 w9 Q' b( h5 x好像没有声明变量，我重新编了一下，多多指教，我已经运行了，都是同心圆，好眼晕呀
$ n8 @' j# }; T( A$ uOption Explicit
( D2 Z! |' s( D, O( g+ ^% F& vSub c100()
Dim c100 As AcadCircle
( s/ ^+ E1 V" H0 n6 m6 v0 {- [0 z( w; fDim i As Double
Dim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
$ A! |/ Q, N; P4 L: k4 d8 Ycc(1) = 1000
5 s, h( A* F! bcc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
/ h% f: q5 C; BCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
Next i
End Sub

woaishuijia

Dim c100 As AcadCircle
% L0 Z( x* b, W& ^1 N5 C  J这一行没有用处，程序中并没有把添加的圆对象赋值给变量。
4 X7 @$ f' [  c3 L8 b8 Q, X) }( D另外，不赞成变量名和过程名一样，容易出错的。

garychen

谢谢，真热心