AutoCAD VBA二次开发初级教程

bulish

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

powerpeak

正在打算学习二次开发的部分
谢谢楼主

wordcad

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

xiaoship

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

hqzoe

真是多谢正好需要

tanlihua

找了了久,终于找到了

sky121

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

wuqitao0000

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

echo7411

谢谢哈   呵呵 很好用啊

ytcadtools

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

wsj249201

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

第一课：入门

# u# F2 A, I) u: o8 c1.为什么要写这个教程
1 G$ w0 ~* i( A  U3 ?# z市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
3 Q# e% n: ~9 z- ?0 {
- f, N' ?0 V+ T& ]2 w2.什么是Autocad VBA？
VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
  b6 O1 e1 J: o4 @) v& ^+ L
. C! y0 u8 I1 `, Q9 B  T9 I3、VBA有多难？
相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。
1 w+ n' K- S( [. L) a: B
4、怎样学习VBA？
* [; O* M% Q7 ]3 }/ i. `介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
+ a2 k' a& T% i! c$ ^' V7 {- K
5、现在我们开始编写第一个程序：画一百个同心圆
第一步：复制下面的红色代码
第二步：在模型空间按快捷键Alt+F8，出现宏窗口
第三步：在宏名称中填写C100，点“创建”、“确定”
" ?: J; {. ^  i4 a! |6 {第四步：在Sub c100()和End Sub之间粘贴代码
& q* g1 p* G2 t2 e+ m) G: H9 U第五步：回到模型空间，再次按Alt+F8，点击“运行”
. e- _) ~% [% h+ p: U9 |: S7 V
- g/ t. v1 Z2 |5 P% L: }Sub c100()
+ Q; |4 n/ Y! SDim cc(0 To 2) As Double '声明坐标变量
' P0 f. l' K9 N8 A; \  ]cc(0) = 1000 '定义圆心座标
cc(1) = 1000
( ^0 L8 @" W& U  U+ tcc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
7 d: s! Q9 C" f6 y# s# h; u3 k: CCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
3 B' x1 C9 S# t1 K: E. Y5 \Next i
End Sub

4 W2 j7 S2 r5 T9 ]也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

wsj249201

第二课  编程基础
, W: |0 o$ L& V本课主要任务是对上一课的例程进行详细分析
下面是源码：
Sub c100()
Dim cc(0 To 2) As Double '声明坐标变量
( l# A) p! ?" M6 M3 R4 v2 v! ~* xcc(0) = 1000 '定义圆心座标
9 i/ T8 y7 ]0 N  w. q8 [. K. ]cc(1) = 1000
4 G$ _3 o2 `+ K% Zcc(2) = 0
# {$ \# t& _, v* r' m: S$ pFor i = 1 To 1000 Step 10 '开始循环
  Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
; ~- E6 Q3 }8 Y  X* [Next i
End Sub
- P4 s! r( y& R0 Q  p: _% n& J, Z  \先看第一行和最后一行：
Sub C100()
……
End Sub
C100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub　和end sub之间的所有指令。
第二行：
! E+ {0 s2 x2 WDim cc(0 To 2) As Double '声明坐标变量
后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注释，越详细越好，对于程序员来说，这是一个好习惯。
% N' W% x; @" N" K: @7 Y9 g电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double
! B5 v2 m9 @7 s0 ^4 O/ f( q7 t它的作用就是声明变量。
Dim是一条语句，可以理解为计算机指令。
它的语法：Dim变量名 As 数据类型
. X% X* ?2 l! s; b, z0 [' A本例中变量名为CC，而括号中的0 to 2声明这个CC是一个数组，这个数组有三个元素：CC(0)、CC(1)、CC(2)，如果改为CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了这个数组，就可以把坐标数值放到这个变量之中。
Double是数据类型中的一种。ACAD中一般需要定义坐标时就用这个数据类型。在ACAD中数据类型的有很多，下面两个是比较常用的数据类型，初学者要有所理解。
Long（长整型），其范围从 -2,147,483,648 到 2,147,483,647。
4 Q9 l$ |) x4 v8 |  H$ m5 pVariant  它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常用的。
& B4 y" \/ v. J' s) e: i下面三条语句
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
- W6 d/ M  v2 d4 Ecc(2) = 0
它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z坐标。
- m+ Z3 R/ ]5 j0 Y* Z
For i = 1 To 1000 Step 10 '开始循环
……
Next i  '结束循环
5 X+ Y2 g) Q+ @9 @8 {这两条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到 1000时，结束循环。
! ]9 m& L$ I1 h6 t; w4 }i也是一个变量，虽然没有声明i变量，程序还是认可的，VB不是C语言，每用一个变量都要声明，不声明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很长，那就会出现一些意想不到的错误。
$ K8 _3 ]+ R+ C2 X3 y& vstep后面的数值就是每次循环时增加的数值，step后也可以用负值。
例如：For i =1000 To 1 Step -10
很多情况下，后面可以不加step 10
; a. T+ C" Y/ v( {如：For i=1 to 100，它的作用是每循环一次i值就增加1
Next i语句必须出现在需要结束循环的位置，不然程序没法运行。
下面看画圆命令：
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
Call语句的作用是调用其他过程或者方法。
ThisDrawing.ModelSpace是指当前CAD文档的模型空间
AddCircle是画圆方法
! S  E! n0 `/ w3 O1 h' DAddcicle方法需要两个参数：圆心和半径
  {+ _' q- }( ^. b7 F1 aCC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310……
- D! @* M# s* J) C  k本课到此结束，下面请完成一道思考题：
) ]  B. t, h/ J, f2 ]7 x1.以(4,2)为圆心，画5个同心圆，其半径为1-5

wsj249201

第三课 编程基础二
: H0 ~0 j8 G1 E; w  B$ @% M
: q1 J+ _7 N# r* O 有一位叫自然9172的网友提出了下面的问题：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入
. T$ F/ l1 v' e本课将讲解这个问题。

$ o6 V( t6 k, p0 |+ f& G! j) W为了简化程序，这里用多条直线来代替多段线。以下是源码：
Sub myl()
- A, `! h  x' lDim p1 As Variant '申明端点坐标
2 k/ }2 q2 T) l1 k: {! \8 _Dim p2 As Variant
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
" n, |2 {+ G5 \$ s1 tp1(2) = z '将Z坐标值赋予点坐标中
On Error GoTo Err_Control '出错陷井
Do '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
# W2 ?/ Z# ~. o6 K  p2(2) = z '将Z坐标值赋予点坐标中
  Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
9 L; d" y8 @& a4 G6 V( u% q8 Z. L) H  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
& Q' ~9 I7 ^( gLoop
Err_Control:
End Sub

: l5 ]+ J/ [9 P3 k1 Z$ R先谈一下本程序的设计思路：
1、获取第一点坐标
2、输入第一点Z坐标
/ [  u, k5 b; ]& a3、获取第二点坐标
0 f0 t9 ]7 w8 T6 i: B" N) s+ s4、输入第二点Z坐标
5、以第一、二点为端点，画直线
6、下一条线的第一点=这条线的第二点
7、回到第3步进行循环
如果用户没有输入坐标或Z值，则程序结束。
' |! s/ N' C# h
首先看以下两条语句：
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标
$ D. k3 y4 J% ]8 v7 j2 |……
. P! K  Z" P: G: f+ Gp2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
( A& {' g# R- K; e* ^6 T- S4 J这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。ThisDrawing.Utility.GetPoint（）在ACAD中这是最常用的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。
- b3 F; {  Q" k7 {# {逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。
VbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”
7 j% Z' i% ]4 d7 p: R&的作用是连接字符。举例：
“爱我中华 ”&”抵制日货 ”&”从我做起”
' R' y" }" C3 j* E  X
' `( \$ Y( X8 T; U( ~# p' Yz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
8 {5 k  O% Z4 u- f由用户输入一个实数
+ `, D1 p, E6 ?+ C  t
On Error GoTo Err_Control '出错陷井
……
. U+ y1 x1 U9 t2 v/ ZErr_Control:
On Error是出错陷井语句，在程序出错时将执行On Error 后面的语句
GoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句，本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。

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

5 d+ @, y1 w$ S8 O2 \Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
6 S! y$ f" l& q画直线方法也是很常用的，它的两个参数是点坐标变量
; }& y# L& o* U
, `; u0 M- b& z7 T" w* V, q本课到此结束，请做思考题：
连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出

第四课 程序的调试和保存


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

- ?1 o7 `& O  y1 X6 ~首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB键（它位于“Q”键左边）确认。当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。
我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变化。下面我举一个简单的例子，先看源代码：
sub test()
8 w; @- P3 H0 ?- x) \/ \8 [for i=2 to 4 step 0.6
# B9 {5 b. ~' S  `0 q/ {- B3 x0 lnext i
0 N( s5 g7 E5 t' d8 _# U% [end sub
" `6 a: P/ \7 I4 g8 n这是一个非常简单的循环，每一次循环i便会增加0.6，当循环3次后i值就变为4.4，但问题是每一次循环时i值变为多少？
/ m1 Z" L1 N- [" n第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。
第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。
+ v6 ?: n6 b. m; `# p# O好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。
第三步：在next i行再按一次F9，清除断点。监视的表达式的右键菜单选择“删除监视”。
' M2 d7 P# w3 H% e3 o另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。
* c, J9 X9 z7 e3 ~7 I- ]
到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的Autocad图形文件中， 以后打开这个文件时代码才会加载，如果别的dwg文件也要使用，那就需要把代码导出为.bas文件，供其他dwg文件导入。在VBA编辑器的“文件”菜单中有这两个功能，一试便知。
ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图形文件中共享，但是由于VBA功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要这样做。

本课结束，请做思考题；监视下列代码中的i和j的值，注意，此题虽然要监视2个变量，但是在代窗口中只要设置1个断点就足够了。
sub test()
for i=2 to 4 step 0.6
2 S0 T: ]# U3 P% B/ d5 [8 \  for j=-5 to 2 step 5.5  
( G: q5 Q9 D0 ~$ z) L: O  next j
next i
end sub

wsj249201

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


% C7 `( x, v) N. `1 w
( V4 [6 S1 q2 w! h下面是源码：
, j! {! O2 ]7 n8 D4 h3 j3 DSub myl()
Dim p(0 To 49) As Double '定义点坐标
Dim myl As Object '定义引用曲线对象变量
+ Z# g6 W# y4 Wco = 15 '定义颜色
" d& U2 [0 m1 ]! L+ w/ ]For a = 0.01 To 1 Step 0.02 '开始循环画抛物线
$ N- i7 k5 o( V/ O  For i = -24 To 24 Step 2 '开始画多段线
0 {6 n4 U8 T0 P' u5 e    j = i + 24  '确定数组元素
    p(j) = i '横坐标
    p(j + 1) = a * p(j) * p(j) / 10 '纵坐标
  Next i '至此p(0)-p(40)所有元素已定义，结束循环
; M% C8 u" X! }8 B  Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
  myl.Color = co '设置颜色属性
  co = co + 1 '改变颜色，供下次定义曲线颜色
: `4 I3 X; |7 \! w: B7 CNext a
/ g2 ^: X. v! L1 JEnd sub
' U: n$ D6 X" K为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如果有问题不懂请跟贴提问。
+ c7 c9 N  r* D: s在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化。
ACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正负24之间。
程序第二行：Dim myl As Object '定义引用曲线对象变量
Object也是一种变量类型，它可以把变量定义为对象，本例中myl变量将引用多段线，所以要定义为Objet类型。
" _2 y; B6 u$ p. q* b看画多段线命令：
Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
5 s7 X) e7 W/ O' a其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。
等号前面部分“Set myl”的作用就将myl变量去引用画好的多段线。
myl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co会增值，这样就会有五彩缤纷的效果。
本课第二张图：正弦曲线，下面是源码：
: K2 g5 N9 Q1 uSub sinl()
Dim p(0 To 719) As Double '定义点坐标
# ~" M4 |' i8 ?& N4 sFor i = 0 To 718 Step 2 '开始画多段线
3 u& d7 @8 Z; p2 M! I2 W    p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
* F* ?/ e) k5 m    p(i + 1) = 2 * Sin(p(i)) '纵坐标
Next i
ThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线
! J0 w% f9 H% |' A  c1 h+ n1 TZoomExtents '显示整个图形
End Sub
8 ?3 ^$ a7 L& M' G: L
p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
横坐标表示角度，后面表达式的作用是把角度转化弧度
ZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域
本课思考题：画一条抛物线：y=0.5*x*x+3，其中X取值范围在正负50之间
第六课 数据类型的转换
上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。
我们举例说明：
) A$ u* s: N2 r$ O$ njd = ThisDrawing.Utility.AngleToReal(30, 0)
, z' s- W1 x- C5 B2 ^" x: ^$ |" j- v这个表达式把角度30度转化为弧度，结果是.523598775598299。
; n2 v2 j; \5 Y( F0 h0 \) FAngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为0-4之间的整数，有如下意义：
0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位
: R0 {0 w9 Z( {4 C4 t% P9 n+ ]) V6 I例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1)
' w+ z+ |; w# r3 V+ c" N这个表达式计算62度30分10秒的弧度
再看将字符串转换为实数的方法：DistanceToReal
需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义：
$ p3 v. k# Y' n% l! X1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。
& y. i+ ?' V3 Y例：以下表达式得到一个12.5的实数
& @4 G6 N' V( |3 b$ ]* ctemp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1)
temp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2)
temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5)
% Y4 Q4 H# e( ?( ?而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数
4 }* I% C4 u/ X+ K第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。
temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3)
得到这个字符串：“1.250E+01”，
下面介绍一些数型转换函数：
Cint，获得一个整数，例：Cint(3.14159) ，得到3
5 o% s; Y, T: g+ Q  ICvar，获得一个Variant类型的数值，例：Cvar("123" & "00")，得到”12300”
4 u  w. W0 \1 `4 r& W' jCdate，转换为date数据类型，例：MyShortTime = CDate("11:13:14 AM")
下面的代码可以写出一串数字，从000-099。
- R' R+ b% a1 h0 s$ I4 K: eSub test()
Dim add0 As String
Dim text As String
9 h0 w# F! R) }1 i. `0 FDim p(0 To 2) As Double
2 s  u4 ]% q* a# g5 _p(1) = 0 'Y坐标为0
p(2) = 0 'Z坐标为0
For i = 0 To 99 '开始循环
: L% B3 z% [" O4 |  If i < 10 Then '如果小于10
    add0 = "00" '需要加00
7 _% ^# x* N4 p, R& @: ], p  Else '否则
7 e" _& ?' a/ t    add0 = "0" '需要加0
8 _$ p% I1 V, E7 f+ T: s4 z  End If
9 Y( y( Z  u5 i7 H  ]) m  text = add0 & CStr(i) '加零，并转换数据
  p(0) = i * 100 'X坐标
  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
  Next i
1 e. o1 \6 N/ p6 t; n  
End Sub

重点解释条件判断语句：
If 条件表达式 Then
……
Else
……
End if
4 L( U, h, A- z4 ]如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if后面
# l; a: l$ S& B! o+ |如果不满足条件，程序跳到else后往下运行。
  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
这是写单行文本，需要三个参数，分别是:写的内容、位置、字高
第七课
写文字
客观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是把定义文字样式，用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。
. ?: O6 k' M! q) m8 kSub txt()
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
. y. c, J  f& \3 d" w. p9 q: yDim p(0 To 2) As Double '定义坐标变量
p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值
3 G& l$ |- p" {# m2 H/ _/ P1 ISet mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
2 r2 \& ~3 v" k/ {% D/ [; n  umytxt.f '设置字体文件为仿宋体
% {. H& Q* A  b3 qmytxt.Height = 100 '字高
mytxt.Width = 0.8 '宽高比
mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度）

ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
Set txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
txtobj.LineSpacingFactor = 2 '指定行间距
* }) x% R6 @& H/ S2 G' btxtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2为居中）
End Sub
2 z% t) k) |5 p我们看这条语句
3 f: Z7 D  V, G- |Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
% m- {: O! G# w4 e7 B2 }8 c3 ~添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名
8 ^. c. v9 P; ?1 g8 L5 Ffontfile、height、width、ObliqueAngle是文本样式最常用的属性
/ }3 `5 L5 b- M7 u5 n- @; xCall ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
这条语句是写文本，需要三个参数。第一个参数p是坐标，1400是宽度，最后一个参数是文本内容，其中\p是一个回车符
扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3 部，n取值范围是0.75-3
" x- G1 B4 V* `+ i7 g3 S在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34
2 T' H# J5 E5 F' e" S) ]( B$ Y9 k\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
) i* v5 k+ x) y8 d  ^\C是颜色格式字符，C后面跟一个数字表示颜色
\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐
第八课:图层操作
先简单介绍两条命令：
, t" B4 ~& A; Z! v& t1、这条语句可以建立图层：
' a9 S! w; C; `) W  C  v; Z* LThisDrawing.Layers.Add("新建图层")
# p0 Y: k1 z6 {: V; U在括号中填写图层的名称。
2、设置为当前的图层
ThisDrawing.ActiveLayer=图层对象
注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量
$ U4 Q8 ~- h, H8 a8 s以下一些属性在图层比较常用：
LayerOn 打开关闭
" B* [$ z, J# V' _7 g3 X) P! CFreeze 冻结
1 k- c! k- p- I0 r; l" ULock锁定
/ a# z9 V6 t; B! b. b. L  [Color 颜色
Linetype 线型

看一个例题：
! W# U$ N6 R5 e3 v; r! ?: v1、先在已有的图层中寻找一个名为“新建图层”的图层
2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置为当前图层。
3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层
/ ]3 b; A' o3 VSub mylay()
- U+ q. ^4 A( P; N) l) P( nDim lay0 As AcadLayer '定义作为图层的变量
Dim lay1 As AcadLayer
findlay = 0 '寻找图层的结果的变量，0没有找到，1找到
For Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环
' q0 m! g$ k  M4 ?  If lay0.Name = "新建图层" Then '如果找到图层名
4 |5 ~7 o) Y# f    findlay = 1 '把变量改为1标志着图层已经找到
6 O, C% d: D, w  g& b' f    msgstr = lay0.Name + "已经存在" + vbCrLf
* T% z  {) ?, P# b% t3 @8 `    msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf
4 q! [, W( M/ q7 C8 X    msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf
    msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf
    msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf
    msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf
' R) d. c" |2 c0 F' C5 H7 M" ~8 r6 I    msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf
7 r- ]: J4 `; q    msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf
    msgstr = msgstr + "是否设置为当前图层？"
    If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定
       If Not lay0.LayerOn Then lay0.LayerOn = True '打开
       ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层
    End If
; @3 L* M- e: o4 E$ s2 h    Exit For '结束寻找
2 |& B  }" g$ i, x4 r3 Y  End If
& }: r/ [% n' _5 eNext lay0
If findlay = 0 Then '没有找到图层
  Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层
  lay1.Color = 2 '图层设置为黄色
3 P, L4 z/ U9 F, q" g6 H  
  ltfind = 0 '找到线型的标志，0没有找到，1找到
  For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环
  [0 Q+ I- v, N- [    If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN"
1 T5 w* ]) a! U! _4 Y* H' x      ltfind = 1 '标志为已找到线型
      Exit For '退出循环
    End If
  Next entry '结束循环
  If ltfind = 0 Then '没有找到线型
    ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型
2 E, [4 O, n7 X0 K( }  End If
  lay1.Linetype = "HIDDEN" '设置线型
% b! t7 v1 t5 L  ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层
End If
End Sub
# ]( x& P0 ?2 A% n# U在寻找图时时我们用到for each……next 语句
它的语法是这样的：
For Each 变量 In 数组或集合对象
……
exit for
……
8 D6 E$ z0 B5 U2 Inext 变量
它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层
% j. o# q3 F1 v: U6 t在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。
If lay0.Name = "新建图层" Then
lay0.name代表这处图层的图层名
IIf(lay0.LayerOn = True, "打开", "关闭")
" o  W5 Y) V7 ~" }% y这是一个简单判断语句，语法如下：
  L6 f5 p1 X) [iif（判断表达式，返回值1，返回值2）
当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2
6 A; l+ Z  ]; Y. J: {4 R: ^( Z) RMsgBox(msgstr, 1)
Mgbox显示一个对话框，第一个参数是对话框显示的内容
8 z! R9 V: H+ H+ O5 |第二个参数可以控制对话框上的按钮。
0 只有确认按钮
. |2 U8 Z% v% I$ n, m: q$ H1 确认、取消
2 终止、重试、忽略
, v7 C; J( O# y* L! ?3 是、否、取消
6 v$ X8 Q  M# n& V, Q! f) h8 p+ S4 是、否
; A% z4 n. D/ {+ P4 u. OMsgBox获得值如下：
5 b' f/ x; M6 T6 r确认：1
# r/ B$ A/ R. s2 H1 p+ x; t取消：2
8 D" ]. j: E3 P) H7 {6 }终止：3
# S/ `- x6 h7 I1 B; h重试：4
忽略：5
是：6
5 X* h. S' c, [8 X否7
' S6 M6 m) S4 F* \0 h7 m初学者不需要死记硬背，能有所了解就行了
ACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：
ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin"
ThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。

  x4 B' w0 @9 s
8 o) p+ {5 ~% ?  i$ z: i$ R" z[ 本帖最后由 wsj249201 于 2008-6-21 14:39 编辑 ]

wsj249201

第九课:创建选择集
# R& p8 Q; L: e, C1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
' h, k) `6 {3 l  q# h' v& g) \; ESub c300()
7 k1 P/ T$ V3 W3 K% s9 I& y  mDim myselect(0 To 300) As AcadEntity '定义选择集数组
& X+ G  w3 x( v7 D$ zDim pp(0 To 2) As Double '圆心坐标
+ _: ]( u, `7 P7 ?- HFor i = 0 To 300 '循环300次
pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
! G3 B% ?# h% W/ ?Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
Next i
For i = 1 To 300
- j0 T* v: r* Z/ O! ~# j6 `: _If myselect(i).Radius > 10 Then '判断圆的直径是否大于10
myselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
/ ~0 S* e7 R, n$ F( ^: `Else
myselect(i).color = 0 '小圆改为白色
9 U; O7 F  [+ Z$ SEnd If
Next i
ZoomExtents '缩放到显示全部对象
) o8 P& e6 Z( XEnd Sub

7 @( ]7 y% [$ K0 e2 Tpp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
rnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
) y0 O' }- t0 R% f- NSet myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
6 N0 N% T  @3 J1 B2.提标用户在屏幕中选取
  ~9 `2 V" U' p$ y3 G选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
/ E' ?7 U% @) [7 `: P下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
4 ^) @1 P) M% L- N) U: N2 q& n6 Z. VSub mysel()
Dim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
$ m' E5 ~0 M! Z/ c% Q, |Set sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
/ l" F8 \4 O& s) j0 X) C$ Rsset.SelectOnScreen '提示用户选择
+ ^* m6 Y6 T% E+ f* W$ q' R7 L, r: tFor Each element In sset '在选择集中进行循环
0 D& W8 m+ \; y& W* A$ Z* Q  element.color = acGreen '改为绿色
Next
1 U4 H3 G! ?5 {, k- b/ Ysset.Delete '删除选择集
End Sub
" x8 Y0 F5 s: w0 k7 g# {! F0 Y3.选择全部对象
' z, b# O, |! ^1 w  u. u( s用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
9 u! [7 o, C! P- D3 Z! ?) aSub allsel()
Dim sel1 As AcadSelectionSet '定义选择集对象
Set sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
" \9 @. g5 r$ j+ S2 |( A4 b; g8 RCall sel1.Select(acSelectionSetAll) '全部选中
# A) D+ q: `' i$ U& l2 g) L6 Ysel1.Highlight (True) '显示选择的对象
sco= sel1.Count '计算选择集中的对象数
/ g3 |0 m: E7 e$ {9 k4 F- PMsgBox "选中对象数:" & CStr(sco) '显示对话框
: ^3 m8 F6 f% f7 b; Z6 s0 t* G6 lEnd Sub

& @9 I3 q4 C: R' F. }. J8 R, b! M3.运用select方法
上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
1:择全部对象(acselectionsetall)
" V5 }0 N7 l# \) a- K/ z3 s/ M& e8 {2.选择上次创建的对象(acselectionsetlast)
. r5 g3 I1 r+ t  M' z' s- C3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
/ T$ R, b* g$ O+ M. _还是看代码来学习.其中选择语句是:
Call sel1.Select(Mode, p1, p2)
* Y3 {6 y2 x+ R$ }$ E9 V0 mMode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
9 B1 L# n/ \1 j5 o. b8 q0 ESub selnew()
( K1 ~2 ~* M; T0 I7 I& xDim sel1 As AcadSelectionSet '定义选择集对象
3 n( k' m, A* P+ b. A' w* Z; VDim p1(0 To 2) As Double '坐标1
9 V! X1 K' \" n9 f  YDim p2(0 To 2) As Double '坐标2
/ Q1 R3 g5 N2 }p1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
8 N7 M6 T/ }/ c/ sp2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
. c( I* P, a* Y5 wMode = 5 '把选择模式存入mode变量中
7 }. g" U( G0 @1 N3 v* |Set sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
2 g5 |; B/ e6 z2 s2 h% h" kCall sel1.Select(Mode, p1, p2) '选择对象
; _$ a5 {9 C* D% o8 Hsel1.Highlight (ture) '显示已选中的对象
End Sub
5 q2 y" _; S% q) ]  z第十课:画多段线和样条线
7 T  w7 _; R; L/ _) l! L, x画二维多段线语句这样写：
# u5 J5 A/ y/ V9 k, lset lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
AddLightweightPolyline后面需一个参数，存放顶点坐标的数组
1 f' k+ \8 B* _" p9 c画三维多段线语句这样写：
4 ]! ]0 Y( {( s$ y, ?; XSet lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
( F; U" _' h. h1 m) wAdd3dpoly后面需一个参数，就是顶点坐标数组
画二维样条线语句这样写：
Set lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
Addspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
下面看例题。这个程序是第三课例程的改进版。原题是这样的：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
/ @* f3 }- V  V4 D3 }; ?细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
* H/ P: t2 T  V用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
/ _; [! P9 e9 M8 h3 `# ]Sub myl()
5 v. G2 u" S) Y1 M4 J4 tDim p1 As Variant '申明端点坐标
Dim p2 As Variant
Dim l() As Double '声明一个动态数组
& o$ F% J: f, I0 v+ b  cDim templ As Object
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  h, k3 W3 t. pp1(2) = z '将Z坐标值赋予点坐标中
6 z: ~- {0 u0 n6 FReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
) k  y, c) N+ c! \" @l(1) = p1(1)
$ e9 ?$ S2 H7 }- A1 u' g& vl(2) = z
3 p. r# B  [' k+ ]0 I& n3 IOn Error GoTo Err_Control '出错陷井
Do '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
- G& m+ g8 x, T/ N/ M& Q  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  p2(2) = z '将Z坐标值赋予点坐标中
  
& v" `2 l9 v7 J1 V0 i# t  lub = UBound(l) '获取当前l数组中元的元素个数
  ReDim Preserve l(lub + 3)
  For i = 1 To 3
3 s9 q3 K9 R* G2 g    l(lub + i) = p2(i - 1)
( n$ M, {, D1 w$ O1 T1 l' g  Next i
  If lub > 3 Then
# g3 @1 U& z8 R4 a6 h2 c    templ.Delete '删除前一次画的多段线
- m4 R1 g9 ~# I' i! H  End If
) D% K; u* Y& P+ t- ^4 K  Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
5 Q0 Y# J' E' v& z9 lLoop
Err_Control:
End Sub

. I6 T8 D8 N' @% y5 I我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
这样定义数组：Dim l( ) As Double
1 K+ @) [) F- D+ x赋值语句：
7 H3 e( O/ X. K2 t. ?3 n: CReDim l(0 To 2)
l(0) = p1(0)
l(1) = p1(1)
  Y2 i. p/ u! J  n5 Q& n; X" {  Ql(2) = z
重新定义数组元素语句：
  q% D7 d) m; W( w  lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
  ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
再看画多段线语句：
* d, v' L2 Y- `- f5 R9 ISet templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
删除语句：
' C. e) I3 |- I; B% htempl.Delete
因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
& P" a9 P6 o4 Y) D3 e下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
Sub sp2pl()
Dim getsp As Object ‘获取样条线的变量
+ Y9 t# s8 h* S* }3 D; e" s1 ~: oDim newl() As Double ‘多段线数组
3 V. D: w" x9 J! m! ~5 YDim p1 As Variant ‘获得拟合点点坐标
: Y+ v% I" E5 CThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
$ [$ a/ x) Y' }$ Dsumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
ReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
  
  For i = 0 To sumctrl - 1 ‘开始循环，
  p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
1 @1 p' j5 m: o: z" W* G! h      For j = 0 To 2
    newl(i * 3 + j) = p1(j)
  Next j
- O$ E6 ?6 m, P6 [: ?6 c5 tNext i
2 r) S6 X: Z+ T& j$ R" |) ]4 pSet templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
End Sub
4 o8 n* C9 i2 p6 V( M下面的语句是让用户选择样条线：
& r8 L' P4 a+ i; Y- M/ ]ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
; i" [. {, E# pThisDrawing.Utility.GetEntity 后面需要三个参数：
1 a0 \# q& |% f: p第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。
- I* }, O; S! c) z第十一课:动画基础
! q& @( a2 L5 m( I6 f说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
    下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。
/ C$ {" N. |$ Y
    移动方法：object.move 起点坐标,端点坐标
( V3 ~0 Z# y4 J8 t/ q* s& q& f5 HSub testmove()
Dim p0 As Variant       '起点坐标
& y$ E- ?; S, |6 }% E7 sDim p1 As Variant       '终点坐标
Dim pc As Variant       '移动时起点坐标
2 q! V; ~2 R, gDim pe As Variant       '移动时终点坐标
2 Y2 m% z6 c4 |% G+ s) G! m' q& s% IDim movx As Variant     'x轴增量
4 ^& {  _; k4 QDim movy As Variant     'y轴增量
; @: S4 `) U% M/ @7 r$ S0 Q- DDim getobj As Object    '移动对象
' ?7 f5 y6 ~; I, {2 A4 n! UDim movtimes As Integer '移动次数
ThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象"
p0 = ThisDrawing.Utility.GetPoint(, "起点:")
p1 = ThisDrawing.Utility.GetPoint(p0, "终点:")
pe = p0
pc = p0
motimes = 3000
6 u  f) n& L; B# P- fmovx = (p1(0) - p0(0)) / motimes
1 B$ D  ^  g* S" Z' tmovy = (p1(1) - p0(1)) / motimes
- g5 R' X' E; u% H# d  I8 Q% VFor i = 1 To motimes
0 [6 V2 C- C# P1 o& `: o  pe(0) = pc(0) + movx
  pe(1) = pc(1) + movy
$ p1 g- ~/ E, f* p; \+ G! h; D  getobj.Move pc, pe    '移动一段
  getobj.Update         '更新对象
Next
5 w( L! O3 C, O) v( M0 S0 W$ F# \End Sub
先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。
3 p$ i+ n: u7 w1 t% U) U看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。
旋转方法：object. rotate 基点,角度
偏移方法： object.offset(偏移量)
8 q3 q3 _* H1 q2 t7 v+ w5 ]Sub moveball()
" s. a8 X0 a0 a8 Z( L% uDim ccball As Variant '圆
, }/ T$ F# Z0 B) ?2 m: s* PDim ccline As Variant '圆轴
) k" e6 m$ r6 n; v5 T# C' j8 P4 CDim cclinep1(0 To 2) As Double '圆轴端点1
Dim cclinep2(0 To 2) As Double '圆轴端点2
' b+ k  M1 x4 j5 y- tDim cc(0 To 2) As Double '圆心
8 v2 i% o3 j7 |' @# ?9 ODim hill As Variant '山坡线
  d) f) j( K% h& `/ i9 MDim moveline As Variant '移动轨迹线
Dim lay1 As AcadLayer '放轨迹线的隐藏图层
Dim vpoints As Variant '轨迹点
% V8 }9 N, C* \6 ~' GDim movep(0 To 2) As Double '移动目标点坐标
, x! M% Z- V# E$ u! q, lcclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标
Set ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线
& K' f  z' y( l1 x: J" m: PSet ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆
; d* ]7 `8 F: D: B' q
5 W; l. I4 h7 M/ R9 l% ^) C6 NDim p(0 To 719) As Double   '申明正弦线顶点坐标
For i = 0 To 718 Step 2 '开始画多段线
: B( D. `! a! I& G% C    p(i) = i * 3.1415926535897 / 360  '横坐标
    p(i + 1) = Sin(p(i)) '纵坐标
* p8 V/ O/ Z- _( ~6 fNext i
% l: H: O0 g/ W! O  
Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线
9 ^" V. C) S& `" l- w; e: vhill.Update '显示山坡线
moveline = hill.Offset(-0.1) '球心运动轨迹线
vpoints = moveline(0).Coordinates '获得规迹点
# J% Y1 z  W7 K4 j/ n/ E: BSet lay1 = ThisDrawing.Layers.Add("hidelay") '创建名为"hidelay"的图层
( ~1 S& N2 A& Q- O7 M) [lay1.LayerOn = False '关闭图层
% {0 V( [% O8 tmoveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
ZoomExtents '显示整个图形
For i = 0 To UBound(vpoints) - 1 Step 2
& k7 g  W$ }( e# m9 b2 L" i' H  movep(0) = vpoints(i) '计算移动的轨迹
: g" P  K/ i2 S9 k9 u$ i  movep(1) = vpoints(i + 1)
. v) f! }( R5 I3 d. g  ccline.Rotate cc, 0.05 '旋转直线
  ccline.Move cc, movep '移动直线
  ccball.Move cc, movep '移动圆
  cc(0) = movep(0) '把当前位置作为下次移动的起点
  cc(1) = movep(1)
2 N8 a; I" }7 w5 |  For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置
   j = j * 1
  Next j
  ccline.Update '更新
Next i
End Sub
+ b, _7 z* v" C, w! ~
) Q1 n6 P" h2 q本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定
第十二课:参数化设计基础
简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。
    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。
$ f. x: {! y4 s, C

! e  t& ^/ S# b% u  ]2 pSub court()
Dim courtlay As AcadLayer '定义球场图层
+ T- r* n5 ]+ g9 a; k0 zDim ent As AcadEntity '镜像对象
Dim linep1(0 To 2) As Double '线条端点1
Dim linep2(0 To 2) As Double '线条端点2
Dim linep3(0 To 2) As Double '罚球弧端点1
+ D! W4 I$ X7 p2 ADim linep4(0 To 2) As Double '罚球弧端点2
Dim centerp As Variant '中心坐标
; `; }1 m2 e+ t# k1 N3 D/ ]xjq = 11000 '小禁区尺寸
2 p* Y9 Z! F3 x' f) qdjq = 33000 '大禁区尺寸
fqd = 11000 '罚球点位置
fqr = 9150 '罚球弧半径
1 \% Q$ T. r/ ?$ j+ V, N# Qfqh = 14634.98 '罚球弧弦长
jqqr = 1000 '角球区半径
' c- A, X  K/ h6 I( fzqr = 9150 '中圈半径
On Error Resume Next
' m9 I9 M- g/ V* h1 D- schang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
If Err.Number <> 0 Then '用户输入的不是有效数字
+ o  P) A9 n4 S$ W/ v9 r  chang = 105000
  Err.Clear '清除错误
End If
6 k* Q4 K) j0 v/ qkuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
! S% V% \- ]1 }3 `" u( F2 `, }If Err.Number <> 0 Then
$ t  Y& K' I, \9 i' {5 d  kuan = 68000
1 V( J/ Q) J2 d' jEnd If
centerp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
4 N/ f4 W0 N- Y( _1 Y3 ASet courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
; m9 o' @7 |1 b7 `' U& lThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
7 v! T; h7 Y$ j/ W3 o5 Q, P'画小禁区
linep1(0) = centerp(0) + chang / 2
( j5 Z0 L. {) y2 K! {linep1(1) = centerp(1) + xjq / 2
3 i0 g5 W" d4 b/ ~! k! |$ q7 ylinep2(0) = centerp(0) + chang / 2 - xjq / 2
: Z/ F( I' _+ F8 E/ Z8 _linep2(1) = centerp(1) - xjq / 2
" a/ ?0 W. r, m. x* D  `$ [" I- wCall drawbox(linep1, linep2) '调用画矩形子程序
" c* |/ ]% _5 X% {1 z8 o8 k
'画大禁区
2 l+ |) O# q! P# Y3 p. {) \& Ulinep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
. j/ N7 n3 s% W) J: I" G8 ulinep2(0) = centerp(0) + chang / 2 - djq / 2
& q* l  w$ ?1 D; R0 zlinep2(1) = centerp(1) - djq / 2
" l* p' Z) H$ I. D( lCall drawbox(linep1, linep2)

' 画罚球点
linep1(0) = centerp(0) + chang / 2 - fqd
9 o" N! k4 ?1 ]5 P/ i% |linep1(1) = centerp(1)
* S7 ~6 [3 C, y) e5 O: KCall ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '点样式
) q+ I4 Y% `/ v0 o0 zThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸
1 G% C# u  Q. t0 t5 R'画罚球弧，罚球弧圆心就是罚球点linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
& z& t# }8 `; E; p( @1 W7 Jlinep3(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) '画弧
' Z8 y4 q3 F% P' _7 W% Z
' o: u5 X, r9 \3 u6 w'角球弧
: j3 m" Y; D" U, ^0 Gang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
1 |) C( e% R5 O* v. h' k& Lang2 = ThisDrawing.Utility.AngleToReal(180, 0)
+ x6 i, X% B, d, j4 Hlinep1(0) = centerp(0) + chang / 2 '角球弧圆心
' m) v: T) b, ]3 r' G; Z) Ulinep1(1) = centerp(1) - kuan / 2
) `; ]0 g4 Y6 ?Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
# _& X3 z& }- ~$ J( h3 e3 @" @linep1(1) = centerp(1) + kuan / 2
5 s$ f% i7 O4 ~Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

'镜像轴
linep1(0) = centerp(0)
" W6 B/ `: m9 P" T( M$ ]linep1(1) = centerp(1) - kuan / 2
7 {& V6 b. K+ t  U) Vlinep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2
'镜像
5 i- r" k2 W: V2 o; eFor Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
# e& S; z9 G" W+ k. w  If ent.Layer = "足球场" Then '对象在"足球场"图层中
  J! i, c) Y+ ~# Z    ent.Mirror linep1, linep2 '镜像
1 C1 L  ]! h7 Y9 c3 u: P  End If
Next ent
'画中线
9 w7 e/ I- m# D4 \6 \1 E" rCall ThisDrawing.ModelSpace.AddLine(linep1, linep2)
'画中圈
Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)
'画外框
+ `" q% j6 S5 J$ Q0 e) s% plinep1(0) = centerp(0) - chang / 2
linep1(1) = centerp(1) - kuan / 2
3 j: b1 H0 d( z7 w) alinep2(0) = centerp(0) + chang / 2
1 q( x! h' P2 c/ |- z  Jlinep2(1) = centerp(1) + kuan / 2
Call drawbox(linep1, linep2)
ZoomExtents '显示整个图形
End Sub
( ?* f* E0 s+ l7 u/ MPrivate Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
& j& D4 d$ W7 kDim boxp(0 To 14) As Double
! I1 z6 y8 {+ h0 U/ B( _* p0 }boxp(0) = p1(0)
0 W% p- c3 f2 r% q& v* G( T; Aboxp(1) = p1(1)
" Z; b& g; w9 O# ?2 A1 H" u- Rboxp(3) = p1(0)
! i7 Q# A( w, O: \) jboxp(4) = p2(1)
5 C$ o  R5 c3 Cboxp(6) = p2(0)
boxp(7) = p2(1)
+ u/ C, l- B& g0 {$ ]boxp(9) = p2(0)
boxp(10) = p1(1)
9 r9 y5 [. G) A' M3 y/ fboxp(12) = p1(0)
9 V) r6 @& I8 Z$ H3 wboxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub


4 P- H$ P9 v9 S, V" R7 v下面开始分析源码：
* Q# v$ h3 i* \% kOn Error Resume Next
3 y; Z- n2 `8 y! d. V' v: z( Mchang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
( Z, ?) W3 ^) s0 x; _$ E3 a9 l- PIf Err.Number <> 0 Then '用户输入的不是有效数字
chang = 10500
5 w# m# T9 X5 o8 i& wErr.Clear '清除错误
1 d- X, `0 D8 j3 w6 k- H7 h: tEnd If
    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。

7 N6 v  i. s( Z3 ~    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
$ Y( k2 K# J& @3 G    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。
6 [2 x6 [- D$ l
# w, U. p1 |6 \ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
* q: X5 ~1 I7 e- Z9 WCall ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
下面看镜像操作：
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
) {" n' E1 c1 \# |6 p  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
: ]8 H. T3 r* A% V0 M1 Z1 z! ]  End If
0 _7 G! ]. b& H- x3 u- @Next ent
    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。
. i- n! G2 W9 m
本课思考题：
1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入
2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中

jshailin

谢谢楼主，正想学习  ！

renweidave

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

蓝色的海01

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

inuyasha_pw

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

dai8812312

真的很谢谢楼主    :lol:

no1sunshine

一直想找一些学习AUTOCAD二次开发方面的资料，真是不枉此点
) P; I, a- A" G: A我觉得我真的是找到了一个好的归宿-------三维网
" g/ t* N# W- ]2 w8 `. ]真的是我们这些学习机械专业的学生取经的好地方
. j( U( J) n: X. }2 J8 U谢谢各位前辈对我们的关怀

tzydsfy

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

shirleykine1980

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

5 i, G5 M9 e6 m: ]0 m) J第一课：入门
% Q. x% _1 u# N
4 j; O0 n2 P, {* {& h' ~  _1.为什么要写这个教程
市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是 ...

: |- g, Z' t9 S: j0 s: H  J4 j好像没有声明变量，我重新编了一下，多多指教，我已经运行了，都是同心圆，好眼晕呀
Option Explicit
Sub c100()
Dim c100 As AcadCircle
4 b- S# X, `- p) Z( jDim i As Double
Dim cc(0 To 2) As Double '声明坐标变量
cc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
0 f4 E6 _: W! x1 j! ?2 J: cFor i = 1 To 1000 Step 10 '开始循环
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
) }) h4 C7 d$ r+ D7 c1 I/ r: W. Y; ?Next i
End Sub

woaishuijia

Dim c100 As AcadCircle
: C( e- i- H, w这一行没有用处，程序中并没有把添加的圆对象赋值给变量。
: }% e+ z& n+ p2 D6 t+ @3 F. w& k5 s另外，不赞成变量名和过程名一样，容易出错的。

garychen

谢谢，真热心