AutoCAD VBA二次开发初级教程

bulish

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

powerpeak

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

wordcad

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

xiaoship

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

hqzoe

真是多谢正好需要

tanlihua

找了了久,终于找到了

sky121

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

wuqitao0000

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

echo7411

谢谢哈   呵呵 很好用啊

ytcadtools

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

wsj249201

Autocad VBA初级教程 (第一课:入门)
, p' M& Y* [# Z4 b9 V7 ~/ v; x
, J( B; B) d& h% [第一课：入门

: `2 P4 t, b) L+ U1.为什么要写这个教程
3 }' ^: u) c8 W# P市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。

* f2 ~: C, T) c& t, ~! u/ j$ [4 _2.什么是Autocad VBA？
VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。

$ |/ I/ I* A3 ^/ F0 z4 Q  k3、VBA有多难？
! V5 z; b8 E& k& x& x9 l" ^相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。

( C0 q6 g6 J; d. t4、怎样学习VBA？
介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
3 m$ R0 Y' R/ P7 L& }/ M  J( z
5、现在我们开始编写第一个程序：画一百个同心圆
第一步：复制下面的红色代码
第二步：在模型空间按快捷键Alt+F8，出现宏窗口
第三步：在宏名称中填写C100，点“创建”、“确定”
第四步：在Sub c100()和End Sub之间粘贴代码
$ [+ x& R: z) g; u第五步：回到模型空间，再次按Alt+F8，点击“运行”

& _  H% t) l. u5 w0 @2 jSub c100()
Dim cc(0 To 2) As Double '声明坐标变量
5 }0 B* ?$ |7 |; [cc(0) = 1000 '定义圆心座标
cc(1) = 1000
cc(2) = 0
5 r, a- s0 X5 u* v# L8 G, kFor i = 1 To 1000 Step 10 '开始循环
, U! j  `. `2 v9 r8 x( lCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
Next i
4 N. p0 V' i" A0 GEnd Sub

, _/ B, S9 W; i1 t" E5 g; z/ n2 f也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

wsj249201

第二课  编程基础
本课主要任务是对上一课的例程进行详细分析
& ?$ a# ~. b+ b# `5 j$ z- B下面是源码：
5 J  h: ^- l( c$ A8 }9 c# FSub c100()
4 n. S' K2 ~6 c" v* F- mDim cc(0 To 2) As Double '声明坐标变量
7 G4 m& U8 l( T4 l0 ~cc(0) = 1000 '定义圆心座标
cc(1) = 1000
: r8 W9 G, a$ Y* n" o# fcc(2) = 0
For i = 1 To 1000 Step 10 '开始循环
, U/ P* [0 w1 }1 N. `  Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
- x. K$ g7 w* F( ~% T5 ]8 `5 ]Next i
& m( Y& s( ?# g! Q* u: d1 M5 NEnd Sub
先看第一行和最后一行：
Sub C100()
/ D, E, ~, U1 \1 m) W+ ?+ a- ^……
* l3 E: @$ x3 q9 A  b/ cEnd Sub
9 {5 Q5 U7 Y  i6 a" U* y0 rC100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub　和end sub之间的所有指令。
第二行：
. a0 U0 r* W% o5 o- t6 C/ EDim cc(0 To 2) As Double '声明坐标变量
/ U: H: x' U, K; w" h  N, ^- l后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注释，越详细越好，对于程序员来说，这是一个好习惯。
电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double
它的作用就是声明变量。
% ]; {1 Q$ j3 O2 Y- R! m  ^Dim是一条语句，可以理解为计算机指令。
它的语法：Dim变量名 As 数据类型
3 Z  U, `( Q8 ]2 C4 P5 c  t本例中变量名为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。
Variant  它是那些没被显式声明为其他类型变量的数据类型，可以理解为一种通用的数据类型，这是最常用的。
! r/ j8 ^, d; D4 ~, I下面三条语句
) S" J" d9 r" `cc(0) = 1000 '定义圆心座标
cc(1) = 1000
- r6 ]( R# U- k$ l$ F! r" K1 z$ scc(2) = 0
它们的作用是给CC变量的每一个元素赋,值其顺序是X、Y、Z坐标。
' s6 _0 u' {2 g2 ^
1 v+ W; J9 E. Q0 O9 cFor i = 1 To 1000 Step 10 '开始循环
……
. _9 h7 [0 c  bNext i  '结束循环
这两条语句的作用是循环运行指令，每循环一次，i值要增加10，当i加到 1000时，结束循环。
' R  D* z0 Y, z+ @1 P' c! U+ Yi也是一个变量，虽然没有声明i变量，程序还是认可的，VB不是C语言，每用一个变量都要声明，不声明就会报错。简单是简单了，这样做也有坏处，如果不小心打错了一个字母，程序不会报错，如果程序很长，那就会出现一些意想不到的错误。
* q8 A* a, d) c5 Istep后面的数值就是每次循环时增加的数值，step后也可以用负值。
  G1 I% S$ D& `例如：For i =1000 To 1 Step -10
很多情况下，后面可以不加step 10
如：For i=1 to 100，它的作用是每循环一次i值就增加1
Next i语句必须出现在需要结束循环的位置，不然程序没法运行。
# U3 }4 k3 P; O; I% c& M$ q下面看画圆命令：
, `0 s: M7 I9 NCall ThisDrawing.ModelSpace.AddCircle(cc, i * 10)
Call语句的作用是调用其他过程或者方法。
9 j& t: Z  o* ], w6 k4 OThisDrawing.ModelSpace是指当前CAD文档的模型空间
AddCircle是画圆方法
Addcicle方法需要两个参数：圆心和半径
CC就是圆心坐标，i*10就是圆的半径，本例中，这些圆的半径分别是10、110、210、310……
本课到此结束，下面请完成一道思考题：
' e, s. y. k8 D; j, F- P1.以(4,2)为圆心，画5个同心圆，其半径为1-5

wsj249201

第三课 编程基础二

5 ]9 N% a5 E0 N" J2 j+ s 有一位叫自然9172的网友提出了下面的问题：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入
4 Z9 n2 Z6 F8 e- y9 C本课将讲解这个问题。

为了简化程序，这里用多条直线来代替多段线。以下是源码：
2 q0 a2 a+ K: ASub myl()
Dim p1 As Variant '申明端点坐标
0 }) c1 n1 p' o% Q& t: F6 [Dim p2 As Variant
$ d9 B) ^6 N. ^  z$ G3 Y3 ]p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p1(2) = z '将Z坐标值赋予点坐标中
# _7 j) S0 L) |/ {4 {" ROn Error GoTo Err_Control '出错陷井
! Y% k; s! C, R% Z/ i4 t7 hDo '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
! C' ~' @. M8 A- Y2 h& X/ p* R* _- ]  p2(2) = z '将Z坐标值赋予点坐标中
  Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
# j, D  I# }) d8 k( b, MLoop
1 i! a" B: h- R3 k" e2 yErr_Control:
End Sub

% ?9 \" r2 g0 S2 }: F先谈一下本程序的设计思路：
1、获取第一点坐标
! n( n9 q! {* R& Q, Z2、输入第一点Z坐标
# t- K& T5 P; p3、获取第二点坐标
. C; X- r& \% P, a0 q4、输入第二点Z坐标
) [. M3 p1 Q2 o+ Q! v5、以第一、二点为端点，画直线
6、下一条线的第一点=这条线的第二点
7、回到第3步进行循环
) v/ d" z% A2 @+ H如果用户没有输入坐标或Z值，则程序结束。
& N' z& `; f* Z( T9 D
首先看以下两条语句：
+ k6 W1 h' |- t: V4 Xp1 = ThisDrawing.Utility.GetPoint(, "输入点:") ‘获取点坐标
……
9 P$ L' N. O' K; Z2 np2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
这两条语句的作用是由用户输入点用鼠标选取点坐标，并把坐标值赋给p1、p2两个变量。ThisDrawing.Utility.GetPoint（）在ACAD中这是最常用的方法之一，它需要两个参数，在逗号前面的参数应该是一个点坐标，它的作用是在屏幕上画一条线，前一个端点位于点坐标位置，后一个端点跟随鼠标移动，逗号之前可以什么都不填，这时没有线条会跟随鼠标移动，但逗号必须保留。
逗号后面使用一串字符，程序在命令行显示这串字符，这不难理解。
  H" d2 r: _" K0 c& i, L/ _VbCr通常代表一个回车符，而在这个语句中，它的作用是在命令行不显示“命令：”
&的作用是连接字符。举例：
“爱我中华 ”&”抵制日货 ”&”从我做起”
+ @6 L4 C" {+ a% O
- Q3 C* }$ M9 O/ fz = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
由用户输入一个实数
2 e! v  T9 ^/ B6 W) V
6 w1 E* t" ]. E( X/ B. `On Error GoTo Err_Control '出错陷井
" g* L' t9 X' X) h! ^' K% }……
Err_Control:
; ~: @3 `' w$ l; S! NOn Error是出错陷井语句，在程序出错时将执行On Error 后面的语句
GoTo Err_contorl 是程序跳转语句，它的作用是在程序中寻找Err_control:，并执行这一行后面的语句，本例中Err_Control:后就是结束宏，所以只要出现错误，程序中止。

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

Call ThisDrawing.ModelSpace.AddLine(p1, p2) '画直线
画直线方法也是很常用的，它的两个参数是点坐标变量

9 A7 j0 p, l- B7 d本课到此结束，请做思考题：
" a+ s1 H. N: x! v' U/ ^连续画圆，每次要求用户输入圆心、半径，当用户不再输入圆心或半径时程序才退出
; A/ f& K) L* J# s) w" Y
第四课 程序的调试和保存
- @6 ~4 _6 n' ~0 A1 q( k

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

; ^  L( B( m) ~. P% m8 Z: X到目前为止，我们所做的工程都是“嵌入式工程”，它只是嵌入在当前的Autocad图形文件中， 以后打开这个文件时代码才会加载，如果别的dwg文件也要使用，那就需要把代码导出为.bas文件，供其他dwg文件导入。在VBA编辑器的“文件”菜单中有这两个功能，一试便知。
ACAD VBA还有一种工程叫“通用式工程”，只要进入ACAD就可以运行，程序可以在不同用户、不同的图形文件中共享，但是由于VBA功能太强，有时候会出现一些意想不到的事情，所以在学习阶段请暂时不要这样做。
. G* Q( c# S) ~! v
2 F5 _5 R" P( ?2 j) A- T" V本课结束，请做思考题；监视下列代码中的i和j的值，注意，此题虽然要监视2个变量，但是在代窗口中只要设置1个断点就足够了。
sub test()
for i=2 to 4 step 0.6
  for j=-5 to 2 step 5.5  
  next j
next i
end sub

wsj249201

第五课 画函数曲线
% g' t+ K" d1 _! w  y7 }2 W先画一组下图抛物线。

$ S' [3 q6 x9 _; `8 O0 o
" h8 Y% M' \- f! V7 R7 u  n1 N
下面是源码：
Sub myl()
3 h0 j5 W5 ?$ WDim p(0 To 49) As Double '定义点坐标
Dim myl As Object '定义引用曲线对象变量
4 U3 U+ W% q. E5 c+ m/ @- {) J9 Uco = 15 '定义颜色
  v  s  w: q/ I4 v9 RFor a = 0.01 To 1 Step 0.02 '开始循环画抛物线
. x' R4 r' f; |3 Z$ x6 B* [# Y" T3 O  For i = -24 To 24 Step 2 '开始画多段线
    j = i + 24  '确定数组元素
% i! ^. i) I2 F    p(j) = i '横坐标
, J4 _" Q/ g! R. u$ W; _    p(j + 1) = a * p(j) * p(j) / 10 '纵坐标
  Next i '至此p(0)-p(40)所有元素已定义，结束循环
) J3 L7 x6 U  y4 Z$ B$ S  Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
  myl.Color = co '设置颜色属性
, b% J+ H# s: l  co = co + 1 '改变颜色，供下次定义曲线颜色
Next a
% o; z$ j$ N; \9 m) OEnd sub
. i$ v( x8 ]/ r6 B' j2 v! y; J为了鼓励大家积极思考，从本课开始，我不再解释每一条语句的作用，只对以前没有提过的语句进行一些解释，也许你一时很难明白，建议用上一课提到的跟踪变量、添加断点的办法领悟每一条语句的作用，如果有问题不懂请跟贴提问。
4 R% a: _0 Y: b* [1 Z! v. j在跟踪变量p时请在跟踪窗口中单击变量p前的+号，这样可以看清数组p中每一个元素的变化。
& H' \3 ]1 i; \7 f4 G& N4 K6 v$ D3 NACAD没有现成的画抛物线命令，我们只能用程序编写多段线画近似抛物线。理论上，抛物线的X值可以是无限小、无限大，这里取值范围在正负24之间。
程序第二行：Dim myl As Object '定义引用曲线对象变量
; q6 f$ F7 T& g! O, D. b1 g% KObject也是一种变量类型，它可以把变量定义为对象，本例中myl变量将引用多段线，所以要定义为Objet类型。
, M. z* X' @  v# {0 {) ]7 M看画多段线命令：
% _. O* P4 j. V* DSet myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画多段线
其中括号中的p是一个数组，这个数组的元素数必须是偶数，每两个元数作为一个点坐标。
, D! T2 t5 S: ?等号前面部分“Set myl”的作用就将myl变量去引用画好的多段线。
" N: d/ u! T# B5 T* m$ S0 @1 _myl.Color = co '设置颜色属性。在ACAD中，颜色可以用数字表示，本例中co会增值，这样就会有五彩缤纷的效果。
本课第二张图：正弦曲线，下面是源码：
Sub sinl()
" {1 ~5 M6 b* n" mDim p(0 To 719) As Double '定义点坐标
: }+ ?3 Q5 O/ P2 jFor i = 0 To 718 Step 2 '开始画多段线
1 ?1 X8 m3 G1 h+ e" H    p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
    p(i + 1) = 2 * Sin(p(i)) '纵坐标
Next i
ThisDrawing.ModelSpace.AddLightWeightPolyline (p) '画多段线
ZoomExtents '显示整个图形
; j" @7 _" [! F$ t% h3 Q: i, w0 o" IEnd Sub
3 R+ U$ q1 e. R" f
p(i) = i * 2 * 3.1415926535897 / 360 '横坐标
& V# Q( b9 K4 a) R9 m! S$ Z横坐标表示角度，后面表达式的作用是把角度转化弧度
; a3 j( |8 |+ b& t$ CZoomExtents语句是缩放命令，它的作用是显示整个图形，消除图形以外的区域
本课思考题：画一条抛物线：y=0.5*x*x+3，其中X取值范围在正负50之间
! i1 W( Y( i" \3 R第六课 数据类型的转换
上一节课我们用一个简单的公式把角度转化为弧度，这样做便于大家理解。不过VBA中有现成的方法可以转换数据类型。
( H1 J& D. n0 {& H1 m* Y7 e/ _我们举例说明：
  G- e3 f! n8 I  `/ Ajd = ThisDrawing.Utility.AngleToReal(30, 0)
这个表达式把角度30度转化为弧度，结果是.523598775598299。
AngleToReal需要两个参数，前面是表示要转换角度的数字，而后面一个参数可以取值为0-4之间的整数，有如下意义：
0：十进制角度；1：度分秒格式；2：梯度；3：弧度；4：测地单位
+ `, c2 V) |* e1 Z& _% x$ b, B例：id= ThisDrawing.Utility.AngleToReal("62d30' 10""", 1)
这个表达式计算62度30分10秒的弧度
% c5 F3 Z, w+ R6 m  A& P4 \4 t% C- J4 |再看将字符串转换为实数的方法：DistanceToReal
' G' Q6 I4 \. ?9 Q9 k需要两个参数，前一个参数是表示数值的字符串，后面可以取值1-5，表示数据格式，有如下意义：
1：科学计数；2：十进制；3：工程计数——英尺加英寸；4：建筑计数——英尺加分数英寸；5：分数格式。
例：以下表达式得到一个12.5的实数
temp1 = ThisDrawing.Utility.DistanceToReal("1.25E+01", 1)
" C1 ^8 i0 u# Y& g; atemp2 = ThisDrawing.Utility.DistanceToReal("12.5", 2)
temp3 = ThisDrawing.Utility.DistanceToReal("12 1/2", 5)
: @  w# E- e. p* Z而realtostring方法正好相反，它把一个实数转换为字符串。它需要3个参数
第一个参数是一个实数，第二个参数表示数据格式，含义同上，最后一个参数表示精确到几位小数。
temp1= ThisDrawing.Utility.RealToString(12.5, 1, 3)
得到这个字符串：“1.250E+01”，
' i; `: o" h8 l6 t+ T0 n* @4 M下面介绍一些数型转换函数：
" r7 L/ _9 L6 f) B6 E( n8 J+ LCint，获得一个整数，例：Cint(3.14159) ，得到3
Cvar，获得一个Variant类型的数值，例：Cvar("123" & "00")，得到”12300”
Cdate，转换为date数据类型，例：MyShortTime = CDate("11:13:14 AM")
下面的代码可以写出一串数字，从000-099。
Sub test()
Dim add0 As String
Dim text As String
Dim p(0 To 2) As Double
1 _' V, N6 R# b8 |p(1) = 0 'Y坐标为0
4 u: \( \) x. g: A8 y5 |5 h6 J5 W$ Ip(2) = 0 'Z坐标为0
For i = 0 To 99 '开始循环
  If i < 10 Then '如果小于10
; Y* H8 G% ^8 X6 w# K    add0 = "00" '需要加00
  Else '否则
' j) {6 H7 G+ A, G    add0 = "0" '需要加0
  End If
  text = add0 & CStr(i) '加零，并转换数据
* h: u. q/ X# L- W2 l  p(0) = i * 100 'X坐标
5 p+ x2 R: m+ b- V  P" S  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
  Next i
  
) g8 N" M1 z. t! t5 d- REnd Sub
) ]8 D$ E( k5 `4 N' D' }
重点解释条件判断语句：
  D2 B2 @( C9 f- E* _# rIf 条件表达式 Then
……
Else
……
7 P0 u( @2 d0 g8 b5 i0 HEnd if
& _, z, Y& }9 r: c. }9 t5 L如果满足条件那么程序往下执行，到else时不再往下执行，直接跳到End if后面
如果不满足条件，程序跳到else后往下运行。
& m- V$ k' b. w, n: K: S3 S  Call ThisDrawing.ModelSpace.AddText(text, p, 4) '写字
  ^% ~5 x6 q( x" @这是写单行文本，需要三个参数，分别是:写的内容、位置、字高
% k/ D9 e, a& {8 U! ?0 Q# {# ?第七课
写文字
, k; y3 {  D% Y! S2 o客观地说，ACAD写字功能不够历害，而用VBA可以使写字效率更高。比较正规的做法是把定义文字样式，用样式来控制文字的特性。我们还是用实例来学习，先看下面一段代码，它的作用是先创建一个文字样式，然后用这个文字样式写一段多行文本。
Sub txt()
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式
" n! ~# T2 p" u" d+ C: rDim p(0 To 2) As Double '定义坐标变量
p(0) = 100: p(1) = 100: p(2) = 0 '坐标赋值
6 G' I* ^5 `$ v2 {Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
8 ?. p% d  j0 E$ x( W: @% s( x, }mytxt.f '设置字体文件为仿宋体
4 S' L! g3 ]) ]) O! R' `9 u9 C& J6 ymytxt.Height = 100 '字高
+ f' n/ s, M: R6 d6 smytxt.Width = 0.8 '宽高比
mytxt.ObliqueAngle = ThisDrawing.Utility.AngleToReal(3, 0) '倾斜角度（需转为弧度）
+ h; `  r, h3 j4 g8 w9 L$ i
ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
$ c* j7 R; ?: x# c% e9 NSet txtobj = ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
& c+ V' S% r9 Z1 R; ?6 }; @9 h( {txtobj.LineSpacingFactor = 2 '指定行间距
txtobj.AttachmentPoint = 3 '右对齐（1为左对齐，2为居中）
- X% ?( ^& R3 U# N/ |7 ^End Sub
我们看这条语句
Set mytxt = ThisDrawing.TextStyles.Add("mytxt")
& ]. q# x  `4 V4 t添加文本样式并赋值给mytxt变量，只需要一个参数：文本样式名
# U! A. M% V) M4 L' j9 T+ C% yfontfile、height、width、ObliqueAngle是文本样式最常用的属性
% b: P6 M: b; Z- PCall ThisDrawing.ModelSpace.AddMText(p, 1400, "{做到老，学到老}\P" & "此心自光明正大，过人远矣")
这条语句是写文本，需要三个参数。第一个参数p是坐标，1400是宽度，最后一个参数是文本内容，其中\p是一个回车符
扩大字符间距用\T数字，例：\T3abc，使文字abc的间距扩大3 部，n取值范围是0.75-3
4 k5 p. m, W7 R* A( x% @2 w3 W+ C在论坛中有一个经常被同好提及的问题：如何使用文字叠加。举例说明：123\S+0.12^-0.34
. m. g  _% J) B$ _\S是格式字符，^是分隔符，前面的数字在上，后面的数字在下。
\C是颜色格式字符，C后面跟一个数字表示颜色
\A是对齐方式，\A0，\A1,\A2分别表示底部对齐、中间对齐和顶部对齐
& S- }- w2 P- P% O# g1 u+ P+ P第八课:图层操作
  q& M* f' c6 ^先简单介绍两条命令：
1、这条语句可以建立图层：
ThisDrawing.Layers.Add("新建图层")
. ]. @3 Y+ }' M4 r在括号中填写图层的名称。
* {* Y0 ~& i1 [& {2、设置为当前的图层
ThisDrawing.ActiveLayer=图层对象
0 d) a& t( I0 w" p  _2 H注意，等号右边的变量不能用图层名称，必须使用一个有效的图层变量
* @. g' \: x) G) h, x8 w1 l以下一些属性在图层比较常用：
# j# Z$ ^& N0 F6 \LayerOn 打开关闭
Freeze 冻结
( i: [# D, e' k% ~! O7 m; H, ]6 yLock锁定
% ^3 k* b* |/ r3 W/ t; ^* OColor 颜色
& ]3 O. f# L9 f7 h  [9 b( ^1 O! r4 e' gLinetype 线型
# g& q, e: @7 d3 ~
! _2 |( h. q9 z) f8 w看一个例题：
: C( r& F% h1 W$ K1 V1、先在已有的图层中寻找一个名为“新建图层”的图层
1 P0 }$ s/ p! y9 A, q2、如果找到这个图层，显示该图层的信息，并提示用户是否需要设置为当前图层，如果用户确认，则设置为当前图层。
$ _( D) ?1 K) F) C; i3、如果图层没有找到，新建一个名为“新建图层”的图层，设置为黄色，HIDDEN线型，并把这个图层设置为当前图层
Sub mylay()
3 o$ e, x  h2 E  T& kDim lay0 As AcadLayer '定义作为图层的变量
Dim lay1 As AcadLayer
$ q+ H0 d  C7 r. mfindlay = 0 '寻找图层的结果的变量，0没有找到，1找到
For Each lay0 In ThisDrawing.Layers '在所有的图层中进行循环
6 G6 x9 ^( h( x' D8 h' U5 J: y  If lay0.Name = "新建图层" Then '如果找到图层名
4 M- Q( f' P6 D6 k" S    findlay = 1 '把变量改为1标志着图层已经找到
; L1 N. G% `) S* _    msgstr = lay0.Name + "已经存在" + vbCrLf
2 p$ B2 y# u+ H& \. H    msgstr = msgstr + "图层状态：" + IIf(lay0.LayerOn = True, "打开", "关闭") + vbCrLf
    msgstr = msgstr + "图层" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf
    msgstr = msgstr + "图层" + IIf(lay0.Lock = True, "已经", "没有") + "锁定" + vbCrLf
1 j4 l. |% c3 d, Y# f" b    msgstr = msgstr + "图层颜色号：" + CStr(lay0.Color) + vbCrLf
7 N/ W' ^5 e& r1 O1 L1 T" a    msgstr = msgstr + "图层线型：" + lay0.Linetype + vbCrLf
    msgstr = msgstr + "图层线宽：" + CStr(lay0.Lineweight) + vbCrLf
    msgstr = msgstr + "打印开关" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf
    msgstr = msgstr + "是否设置为当前图层？"
% Q; [) O; S9 |4 P5 @' q    If MsgBox(msgstr, 1) = 1 Then '如果用户点击确定
: f5 A. a4 i. |# ~! u       If Not lay0.LayerOn Then lay0.LayerOn = True '打开
. [4 U8 z: y9 D. R+ Y2 d       ThisDrawing.ActiveLayer = lay0 '把当前图层设为已经存在的图层
    End If
  n  n3 E- O* h4 F: Y6 m3 \8 B7 ]    Exit For '结束寻找
" ~8 x' b* M+ A7 _2 k+ ~. A8 |  Y  End If
Next lay0
( }2 E6 ~7 R7 p1 z  x4 B6 KIf findlay = 0 Then '没有找到图层
3 O, f8 Y3 G  A5 m" m  Set lay1 = ThisDrawing.Layers.Add("新建图层") '增加一个名为“临时图层”的图层
  lay1.Color = 2 '图层设置为黄色
! s  a- P# J9 x) e7 |2 W  
  ltfind = 0 '找到线型的标志，0没有找到，1找到
  For Each entry In ThisDrawing.Linetypes '在现有的线型中进行循环
    If StrComp(entry.Name, "HIDDEN") = 0 Then '如果线型名为"HIDDEN"
1 a6 S. v% `7 J1 X      ltfind = 1 '标志为已找到线型
      Exit For '退出循环
    End If
  Next entry '结束循环
, c: D# Q+ g& R& ]" o! V% c; o  If ltfind = 0 Then '没有找到线型
    ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin" '加载线型
  End If
  lay1.Linetype = "HIDDEN" '设置线型
* I/ x/ |, ~- ?9 d) M  ThisDrawing.ActiveLayer = lay1 '将当前图层设置为新建图层
End If
8 e2 u0 b  c6 Z; o6 M9 P) c  NEnd Sub
在寻找图时时我们用到for each……next 语句
/ h$ l; t/ h5 y- s' S+ B* p它的语法是这样的：
6 R" b; {2 L0 h% G- g5 nFor Each 变量 In 数组或集合对象
; O( v: J" D9 D- C# U! h1 I……
: t& o8 N( S6 f) ~+ ]! ~! |exit for
. C, u: b6 g6 ]5 _' t. ]7 q; U7 s" l……
( p- L2 f8 _5 ?next 变量
0 L" v% t$ j" V' x2 ^( p2 `它的作用是在数组或集合对象中进行循环，每循环一次，变量就成为数组或集合对象中的一个元素。本例在所有的图层对象中进行循环，每循环一次layo变量就代表一个图层
在循环体中遇到exit for 语句则退出循环，如果没有 exit for，循环将在所有的元素都操作一遍后结束。
If lay0.Name = "新建图层" Then
lay0.name代表这处图层的图层名
7 U* p4 Q/ o5 ?0 A4 DIIf(lay0.LayerOn = True, "打开", "关闭")
7 X0 h3 f  O: v* ^- T这是一个简单判断语句，语法如下：
* C' J" q% R$ W+ Z. V2 i( qiif（判断表达式，返回值1，返回值2）
' h1 f! T0 c3 c- g当判断表达式成立，函数值=返回值1，如果表达式不成立，函数值=2
: ~6 x. X6 V! V- {; jMsgBox(msgstr, 1)
( E6 `% ^% _( H7 i2 U  YMgbox显示一个对话框，第一个参数是对话框显示的内容
6 E% q- K7 y$ f4 ^  n$ J1 E第二个参数可以控制对话框上的按钮。
0 只有确认按钮
/ ]3 }) S3 u) I$ S5 g* |/ F- J& d1 确认、取消
2 终止、重试、忽略
; Q3 Q% c$ L) E+ L! @' j3 是、否、取消
4 是、否
MsgBox获得值如下：
确认：1
取消：2
0 [& N8 ]0 P; i# X' k; J终止：3
6 a4 ~  E$ a+ E+ @; w: R+ ~重试：4
忽略：5
是：6
否7
初学者不需要死记硬背，能有所了解就行了
ACAD图层中最麻烦的就是线型问题了，本例先寻找一个HIDDEN线型，如果找不到就加载这个线型，用这条语句：
ThisDrawing.Linetypes.Load "HIDDEN", "acadiso.lin"
ThisDrawing.Linetypes.Load后需要两个参数，一个是线型的名称，另外一个是线型文件的名称。
- J/ E$ E+ B6 ?. E& d

2 l+ M; ]3 g7 B3 |* u; e5 K[ 本帖最后由 wsj249201 于 2008-6-21 14:39 编辑 ]

wsj249201

第九课:创建选择集
4 P2 |5 R& O/ J( T3 R6 W1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
Sub c300()
) I; m4 `: R6 V9 ]% m& `3 Q' v6 {Dim myselect(0 To 300) As AcadEntity '定义选择集数组
$ b: @: L# I; a' ]/ VDim pp(0 To 2) As Double '圆心坐标
For i = 0 To 300 '循环300次
9 w+ g; K% S9 b/ Rpp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
! t1 y) r  l, Q* l% q2 O# }; e+ ~Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
Next i
" I7 ~& H- D9 U, U. N0 ^; E$ b1 {For i = 1 To 300
1 V/ T% k/ V" G# k4 WIf myselect(i).Radius > 10 Then '判断圆的直径是否大于10
myselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
Else
- h" y7 A; C- a3 Dmyselect(i).color = 0 '小圆改为白色
End If
Next i
ZoomExtents '缩放到显示全部对象
" X3 w, k& o* A  F" WEnd Sub
2 R' ^- Z' k5 t- a
pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
9 o8 q2 ^; m' I2 S+ g  S0 E) f这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
  J$ Q* a% s* @" _( d3 }+ _rnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
+ Q- A1 |* s3 D5 b* ]2 ESet myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
2.提标用户在屏幕中选取
& L. E( y  A" R选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
Sub mysel()
. W3 E1 ^3 c. [$ ~, ~/ fDim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
Set sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
sset.SelectOnScreen '提示用户选择
For Each element In sset '在选择集中进行循环
  element.color = acGreen '改为绿色
' a( S* Y$ T& Q$ b: d# S2 qNext
# Z/ ^9 i9 a1 t' K8 m8 Esset.Delete '删除选择集
% e4 w4 s; {/ E1 fEnd Sub
3.选择全部对象
用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
Sub allsel()
Dim sel1 As AcadSelectionSet '定义选择集对象
Set sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
6 M& u6 e5 X6 L3 ]( Y0 `Call sel1.Select(acSelectionSetAll) '全部选中
9 E1 X0 ]7 L1 y6 U1 j) U/ _sel1.Highlight (True) '显示选择的对象
sco= sel1.Count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
; Z  I6 d- k5 D* d8 }$ k, SEnd Sub

9 M# s& X( _- D3 g8 E3.运用select方法
上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
3 p9 _: X4 }; i( T( a' s* m1:择全部对象(acselectionsetall)
+ x- U# k5 s* F" H2.选择上次创建的对象(acselectionsetlast)
- A7 r$ Q$ D' Q+ k: y3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
/ z" _; S, W- N; ~) U7 [5 _5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
还是看代码来学习.其中选择语句是:
) G6 E# H1 z- {9 WCall sel1.Select(Mode, p1, p2)
3 `; y" L2 l+ H. RMode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
0 H0 F- [5 k- E) S% n( \Sub selnew()
# e2 _0 f/ j. e2 C8 |  v$ aDim sel1 As AcadSelectionSet '定义选择集对象
# l4 e2 w* w0 n( `! g& K+ FDim p1(0 To 2) As Double '坐标1
7 S2 c& L7 T0 R5 X0 @% oDim p2(0 To 2) As Double '坐标2
p1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
: T; g' P& L. P  O; J2 U. @p2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
Mode = 5 '把选择模式存入mode变量中
4 M+ F; J, y; `4 Q; ^+ HSet sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
& Q5 I. _1 F: U+ L" Q, o( ECall sel1.Select(Mode, p1, p2) '选择对象
1 E1 w+ G" d" _+ V$ @$ osel1.Highlight (ture) '显示已选中的对象
End Sub
' |1 T- W  D8 ^- M4 @第十课:画多段线和样条线
1 V" O/ g3 n, H) k: Z/ ^) P画二维多段线语句这样写：
set lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
* l. h: J$ i, z' k2 j! g' J9 FAddLightweightPolyline后面需一个参数，存放顶点坐标的数组
画三维多段线语句这样写：
$ i/ g4 z8 l; e5 QSet lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
Add3dpoly后面需一个参数，就是顶点坐标数组
画二维样条线语句这样写：
# j+ b  ?/ G! V% x+ z9 [5 fSet lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
6 o6 Y4 o0 v8 l5 z& N) I7 VAddspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
下面看例题。这个程序是第三课例程的改进版。原题是这样的：
4 y$ b" s  b9 l$ z3 Q绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
Sub myl()
Dim p1 As Variant '申明端点坐标
$ j4 _( x4 p  rDim p2 As Variant
5 Z$ c( Q/ h  gDim l() As Double '声明一个动态数组
/ r. e# |) U7 Y" x0 Z3 pDim templ As Object
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  b9 ?; K" G! a8 n# z( L0 \p1(2) = z '将Z坐标值赋予点坐标中
2 f3 L) |$ H  I& E5 iReDim l(0 To 2) '定义动态数组
- z/ f7 l  Q( P4 |, ^1 u* U/ Xl(0) = p1(0)
l(1) = p1(1)
7 j) J9 P! O. F9 Rl(2) = z
  I9 T3 [+ p' S- J. l4 xOn Error GoTo Err_Control '出错陷井
Do '开始循环
+ Y$ s& m1 z% X  v8 @, E$ j& O# T/ Q  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
  z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
  p2(2) = z '将Z坐标值赋予点坐标中
  
  lub = UBound(l) '获取当前l数组中元的元素个数
  ReDim Preserve l(lub + 3)
  For i = 1 To 3
2 ]6 u, t* b: Y9 H+ D    l(lub + i) = p2(i - 1)
  Next i
  If lub > 3 Then
) }- z6 I, D( a7 s% ?& j) B- C    templ.Delete '删除前一次画的多段线
  End If
7 t, _; z1 k, Z6 L  k- u  Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
+ ^' g9 g( ?5 x1 H/ X6 N  oLoop
/ y  p" ?5 Q2 f$ a; RErr_Control:
End Sub

我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
这样定义数组：Dim l( ) As Double
8 y$ Y5 i* v9 A* p6 _! u. J赋值语句：
ReDim l(0 To 2)
5 S0 d1 Q6 N& {6 ~8 E- W, \2 n2 wl(0) = p1(0)
4 h* ~7 c5 F; f: ?1 fl(1) = p1(1)
l(2) = z
重新定义数组元素语句：
  lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
  ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
再看画多段线语句：
7 x/ U( Q' L: Y8 @' h# pSet templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
7 c: _  F8 i% @2 j" `: N: N在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
$ ]0 R+ K, z" q$ C5 Q删除语句：
, e! R" ~7 W% y' gtempl.Delete
8 i6 N  |! p( `! q) ]$ k因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
+ V+ ?2 Y6 |( u( e1 a- l9 o下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
Sub sp2pl()
/ N" c, R( l) \% H% e/ v6 p4 V; ADim getsp As Object ‘获取样条线的变量
$ r: |3 v3 G; bDim newl() As Double ‘多段线数组
2 p9 q8 n* H; X2 s+ K2 G. nDim p1 As Variant ‘获得拟合点点坐标
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
) P5 X# Q1 U' U2 jsumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
* V7 P( Z3 [. JReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
, {% Q& Y0 B0 X# @' X. q: {' E  
+ a1 h& B- f2 W! D- x0 Q, K  For i = 0 To sumctrl - 1 ‘开始循环，
  V* {5 i% R4 ?& h: S  p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
      For j = 0 To 2
! [! b/ ?: ]0 t- \    newl(i * 3 + j) = p1(j)
4 B3 M# T1 q( g5 K9 n0 t/ y  Next j
! H. Q$ ]( M& y# l+ x; r- Z0 qNext i
* b2 \/ s8 p; |" hSet templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
End Sub
4 y) E6 p& t/ f& _9 U+ m' c. d- ]9 v下面的语句是让用户选择样条线：
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
ThisDrawing.Utility.GetEntity 后面需要三个参数：
! c. k5 d$ V, p" z- d" n第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。
第十一课:动画基础
, m3 T& @$ W- q说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
    下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。

    移动方法：object.move 起点坐标,端点坐标
Sub testmove()
, W8 L5 v* [: k0 pDim p0 As Variant       '起点坐标
Dim p1 As Variant       '终点坐标
& i% h' G( r+ ]! R' X2 oDim pc As Variant       '移动时起点坐标
Dim pe As Variant       '移动时终点坐标
7 _2 i6 v0 u( _  M$ {/ W/ QDim movx As Variant     'x轴增量
Dim movy As Variant     'y轴增量
Dim getobj As Object    '移动对象
* S- n) ~! J/ dDim movtimes As Integer '移动次数
ThisDrawing.Utility.GetEntity getobj, po, "请选择移动对象"
) y7 l4 F+ u0 A+ |! t; pp0 = ThisDrawing.Utility.GetPoint(, "起点:")
p1 = ThisDrawing.Utility.GetPoint(p0, "终点:")
pe = p0
9 W4 X2 k' S6 F) N6 z5 T5 _pc = p0
1 e- e# `; _4 J: K: L3 Vmotimes = 3000
movx = (p1(0) - p0(0)) / motimes
7 Y) \0 b6 P8 u% l( Pmovy = (p1(1) - p0(1)) / motimes
2 i+ v6 P* o+ s  ?/ Q4 O  k8 z2 cFor i = 1 To motimes
  pe(0) = pc(0) + movx
/ B- E& y$ {' k  u8 h  pe(1) = pc(1) + movy
& \! U5 O3 ~/ }% V' r  getobj.Move pc, pe    '移动一段
$ |2 [$ F6 g3 a+ f2 _( c- G+ ?  getobj.Update         '更新对象
2 E0 Y# W( j" z; |Next
End Sub
, ~# p+ p8 S8 f先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。
看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。
旋转方法：object. rotate 基点,角度
偏移方法： object.offset(偏移量)
Sub moveball()
: u+ o' i( r' ^8 L( Z; d" [Dim ccball As Variant '圆
Dim ccline As Variant '圆轴
Dim cclinep1(0 To 2) As Double '圆轴端点1
( P) y. W, l& m7 z, SDim cclinep2(0 To 2) As Double '圆轴端点2
Dim cc(0 To 2) As Double '圆心
4 b  c, h5 h' g# v% bDim hill As Variant '山坡线
Dim moveline As Variant '移动轨迹线
Dim lay1 As AcadLayer '放轨迹线的隐藏图层
Dim vpoints As Variant '轨迹点
1 d+ |3 g) s# ]( V- R+ ~/ w" UDim movep(0 To 2) As Double '移动目标点坐标
cclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标
Set ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线
6 I5 h' q) K! F# X9 [Set ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆
4 L3 K3 d2 z' ^/ z* e4 `6 x3 O* F- f
Dim p(0 To 719) As Double   '申明正弦线顶点坐标
2 b0 a) l3 X- }! C3 @2 f6 S; R, q' pFor i = 0 To 718 Step 2 '开始画多段线
    p(i) = i * 3.1415926535897 / 360  '横坐标
    p(i + 1) = Sin(p(i)) '纵坐标
Next i
+ r8 Q" x& R5 F) P  
Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线
hill.Update '显示山坡线
moveline = hill.Offset(-0.1) '球心运动轨迹线
vpoints = moveline(0).Coordinates '获得规迹点
* V  F& T: F; A) M. [9 a: |Set lay1 = ThisDrawing.Layers.Add("hidelay") '创建名为"hidelay"的图层
6 h; I0 Q( F$ p% V5 I' K" Llay1.LayerOn = False '关闭图层
moveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
6 p' a+ u8 l* J- YZoomExtents '显示整个图形
For i = 0 To UBound(vpoints) - 1 Step 2
  movep(0) = vpoints(i) '计算移动的轨迹
) p' g( p( T5 g" Z4 w/ C  movep(1) = vpoints(i + 1)
7 ?+ e' i( s/ C8 r' _- s  ccline.Rotate cc, 0.05 '旋转直线
  ccline.Move cc, movep '移动直线
  ccball.Move cc, movep '移动圆
4 I6 q, Q9 T( L! V) I  cc(0) = movep(0) '把当前位置作为下次移动的起点
& K& t0 B+ s" N$ m  cc(1) = movep(1)
5 p7 |8 z1 P) ]) u- e  For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置
' {6 C+ A/ }( b; M   j = j * 1
  Next j
7 `. ]* k1 |$ B: M- ^9 t) p" F  ccline.Update '更新
Next i
: u' @% M# t3 q" Z6 a9 G$ ~( |End Sub
8 k* S1 V# |% T7 `0 ^+ C3 F
本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定
  k6 e; ]* q5 w9 u6 d6 t& y( O8 F6 p' h第十二课:参数化设计基础
简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。
/ s7 }# B; q6 ^, z    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

6 e* _4 _' \/ `, T1 H+ Y. B
  C8 B! U& N- N& K; d4 USub court()
Dim courtlay As AcadLayer '定义球场图层
, l6 E& o* _8 x: ~Dim ent As AcadEntity '镜像对象
Dim linep1(0 To 2) As Double '线条端点1
) _: ?  h( @; S3 bDim linep2(0 To 2) As Double '线条端点2
: @9 [6 L; h  K: G9 I& PDim linep3(0 To 2) As Double '罚球弧端点1
Dim linep4(0 To 2) As Double '罚球弧端点2
1 B1 X* ?3 e$ o% \8 V% {& K6 b+ kDim centerp As Variant '中心坐标
xjq = 11000 '小禁区尺寸
djq = 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
  Err.Clear '清除错误
End If
7 [4 M; q* x. F* ^kuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
If Err.Number <> 0 Then
, J& `1 a2 v$ R% p* p! H# c  kuan = 68000
End If
' G/ T6 n9 h. h( e; ecenterp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
; p0 r1 F6 x5 eSet courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
$ ~4 Q' Q$ O! L0 pThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
'画小禁区
linep1(0) = centerp(0) + chang / 2
+ ~8 I2 r" M- ^' H$ _. g5 Elinep1(1) = centerp(1) + xjq / 2
! A6 r6 I/ ~+ A: tlinep2(0) = centerp(0) + chang / 2 - xjq / 2
& u+ ^% x$ D4 }8 h. @linep2(1) = centerp(1) - xjq / 2
. d) n% @3 Q0 S, F# d6 P5 z+ m3 jCall drawbox(linep1, linep2) '调用画矩形子程序
! R. j( E' |/ K6 i; X2 H5 t
) `" T, g. {* `) F' k: c" G; V3 O'画大禁区
linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
linep2(0) = centerp(0) + chang / 2 - djq / 2
% H: N' K4 v5 D$ `0 T/ Slinep2(1) = centerp(1) - djq / 2
Call drawbox(linep1, linep2)

! W4 F- Z/ u/ d2 K. V# q( ?5 F' 画罚球点
linep1(0) = centerp(0) + chang / 2 - fqd
linep1(1) = centerp(1)
6 d$ d8 y" O, i0 U5 v4 u2 ]+ oCall ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '点样式
ThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸
'画罚球弧，罚球弧圆心就是罚球点linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
$ q, B9 |; k0 m, A( E* Nlinep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '两个端点的x轴相同
# P8 w! R8 T6 h' ~linep4(1) = centerp(1) - fqh / 2
' x1 E7 k- j- B) F$ P' {# zang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
; c4 e% W. M7 v; d! Mang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧

'角球弧
$ }; |# q4 p, A2 W* c# ^% Hang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
4 Q  I# d# o; K$ F. l+ Nang2 = ThisDrawing.Utility.AngleToReal(180, 0)
& J1 Y6 U: Z+ Flinep1(0) = centerp(0) + chang / 2 '角球弧圆心
! \6 |. O' W- H1 c3 l. ?linep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
/ N* V$ s5 H( rang1 = ThisDrawing.Utility.AngleToReal(270, 0)
linep1(1) = centerp(1) + kuan / 2
5 k' x3 ]0 n( t9 w$ VCall ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

0 p# S5 X5 ^& A+ ^! i' M'镜像轴
linep1(0) = centerp(0)
" |! |: B* j- I: ~  g  I. Klinep1(1) = centerp(1) - kuan / 2
7 }3 j( |( C; G& M4 `  Llinep2(0) = centerp(0)
, B8 f- v7 l1 d; g* f8 Vlinep2(1) = centerp(1) + kuan / 2
'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
% U! C7 C" }9 C# B8 P' f* w+ ^; x  If ent.Layer = "足球场" Then '对象在"足球场"图层中
0 J! i) X' ^2 ^, U& T& `  e+ Y$ D    ent.Mirror linep1, linep2 '镜像
  End If
Next ent
& u  X. ^; ]* a: J0 A! r'画中线
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)
'画中圈
1 F& c! F5 E5 z9 m; a0 F1 x" j, FCall ThisDrawing.ModelSpace.AddCircle(centerp, zqr)
'画外框
linep1(0) = centerp(0) - chang / 2
! X' c4 ^7 R" v% z# i# K, Q, ]linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0) + chang / 2
linep2(1) = centerp(1) + kuan / 2
( r+ B8 N0 Z8 E3 b# S7 a" YCall drawbox(linep1, linep2)
2 T; O1 r1 T- p7 oZoomExtents '显示整个图形
End Sub
  w8 U: P& M3 \Private Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
# J( X: K' ]. ^- v) ^, m5 DDim boxp(0 To 14) As Double
boxp(0) = p1(0)
# s9 C$ I0 N% {% }; i" s6 x+ vboxp(1) = p1(1)
: U- w) C' o& G9 B6 Cboxp(3) = p1(0)
boxp(4) = p2(1)
boxp(6) = p2(0)
boxp(7) = p2(1)
boxp(9) = p2(0)
boxp(10) = p1(1)
boxp(12) = p1(0)
& L: t4 i; r  ~7 H( Lboxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub
" G: Y8 W( b7 k, M. [, \# C. j
/ Y: p7 @6 b- c
' S2 d% K6 a, [+ t+ K% _下面开始分析源码：
0 \1 |/ s; O# s) T& }* i) p2 o6 vOn Error Resume Next
* x; m8 O: ^+ A3 f- p2 @! L1 kchang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
If Err.Number <> 0 Then '用户输入的不是有效数字
4 X, k; ~( {2 \: j$ K) \, Uchang = 10500
8 t4 T; z6 ^5 y5 a, M3 n6 [9 JErr.Clear '清除错误
End If
8 e) a) a: X2 h* {$ q+ R: d0 |6 O    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。

. n: o! s4 {, J6 e    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
9 o* P- ], \" q. K/ ?- O    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
9 e% C8 C) J5 V- p/ J+ i而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。

- Z; g% N- d$ z$ q7 e8 c3 C: Xang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
6 r( |8 l# H1 i1 sang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
4 O' J6 {( o+ E( y6 L    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
下面看镜像操作：
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
! Z2 K, K4 x; Y! I/ r( Z  If ent.Layer = "足球场" Then '对象在"足球场"图层中
0 T( e9 G( V! P  z& A4 D- ]: {    ent.Mirror linep1, linep2 '镜像
$ V/ q; M6 M. x4 @  End If
Next ent
    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。

本课思考题：
) E/ G  ^+ X/ m* e1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入
& J6 ]6 m) u' j. o2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中

jshailin

谢谢楼主，正想学习  ！

renweidave

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

蓝色的海01

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

inuyasha_pw

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

dai8812312

真的很谢谢楼主    :lol:

no1sunshine

一直想找一些学习AUTOCAD二次开发方面的资料，真是不枉此点
0 b- e# N& z( S, y3 c我觉得我真的是找到了一个好的归宿-------三维网
真的是我们这些学习机械专业的学生取经的好地方
  N9 h, M# t3 ~% n( C! D" U  H谢谢各位前辈对我们的关怀

tzydsfy

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

shirleykine1980

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

: s/ d& E1 o+ r/ E: D" I第一课：入门

1.为什么要写这个教程
6 L! a# f0 [7 [+ @2 q- o市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是 ...

好像没有声明变量，我重新编了一下，多多指教，我已经运行了，都是同心圆，好眼晕呀
Option Explicit
Sub c100()
Dim c100 As AcadCircle
9 M$ Y) M2 K  x8 L' @# X! MDim i As Double
4 J2 R$ a  N4 f- U0 a7 dDim cc(0 To 2) As Double '声明坐标变量
, d2 \; w6 z  Y+ e( _" q. Mcc(0) = 1000 '定义圆心座标
1 M. j) s$ t; ?' b  }7 }- ?3 Scc(1) = 1000
& {2 r; i! s0 c5 @* {6 ccc(2) = 0
( g( h0 O4 H. U, c, HFor i = 1 To 1000 Step 10 '开始循环
Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆
, T9 J4 F% @% Q2 _. FNext i
4 s- @* N: p9 n/ m& ?End Sub

woaishuijia

Dim c100 As AcadCircle
2 Y/ F5 ?( D3 K这一行没有用处，程序中并没有把添加的圆对象赋值给变量。
另外，不赞成变量名和过程名一样，容易出错的。

garychen

谢谢，真热心