Autocad VBA初级教程 （强烈推荐）

pengyg1204

好东东啊！先COPY下来再看，呵呵！

wangpiwujing

谢谢,我是菜鸟不是很懂,感觉很好 啊!

yhfsmu

先收藏起来，慢慢看看，谢谢了

设计从零

支持楼主！！！
5 q3 D7 _: |' o5 a！

hellmen

斑竹,还有写好的教程吗?

tianyunxuan

简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。

% n7 b) e) d, }; [    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

2 j9 L' P/ b" _

% A5 s( ]; K* @  ^
Sub court()
Dim courtlay As AcadLayer '定义球场图层
1 X/ o: K1 b% U* i3 y1 \Dim ent As AcadEntity '镜像对象
8 J- v! |" l) [$ Y0 u- s1 F5 @; V2 i2 B& GDim linep1(0 To 2) As Double '线条端点1
! _9 J0 x) k7 h# ], \  b! nDim linep2(0 To 2) As Double '线条端点2
Dim linep3(0 To 2) As Double '罚球弧端点1
Dim linep4(0 To 2) As Double '罚球弧端点2
Dim centerp As Variant '中心坐标
xjq = 11000 '小禁区尺寸
1 x6 A( ]! o6 C  Z, udjq = 33000 '大禁区尺寸
) M, I4 s/ U+ q8 V- I- u5 V5 Hfqd = 11000 '罚球点位置
, I+ ^) w& v; d, Sfqr = 9150 '罚球弧半径
2 c  s) Q) ?8 T0 O4 u& i: b/ ~. l% ?fqh = 14634.98 '罚球弧弦长
! W4 k6 F! X! e, U! @$ Ajqqr = 1000 '角球区半径
3 D/ q" u" T/ [9 l1 X# v% }zqr = 9150 '中圈半径

: ~) c2 ]# \! `' B4 h. IOn Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
  C% M% r3 I9 e: B4 T* gIf Err.Number <> 0 Then '用户输入的不是有效数字
) J; K8 b$ N  b% q  chang = 105000
& z/ d* e# x' k; G1 U  Err.Clear '清除错误
: k. V/ t' P4 JEnd If
: n# K; m) w2 n: |: y* Vkuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
6 F; j$ A6 ]" R5 Z' V' ~% I! k  k# OIf Err.Number <> 0 Then
  kuan = 68000
- y" p# T* q# U& pEnd If

# V# g8 c& Y8 t# ycenterp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")
$ |7 R7 p" Y3 W1 `5 K' n' O
Set courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
) Z  {5 Q! }: c6 IThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层
: ~$ D5 u6 P/ c& v, c6 C: ^
$ w, \6 Q3 V7 V, L8 Z" S2 V1 ['画小禁区
- |7 s  q$ A/ Zlinep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + xjq / 2
% R: I# X9 J. |5 elinep2(0) = centerp(0) + chang / 2 - xjq / 2
linep2(1) = centerp(1) - xjq / 2
Call drawbox(linep1, linep2) '调用画矩形子程序
) ]4 B" J( z. W
- E$ ^( K9 }7 J) z& Z

'画大禁区
8 c1 e0 n) Q( @8 m, p: g# ?linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
# \# |! h* e1 a$ Q0 M8 Vlinep2(0) = centerp(0) + chang / 2 - djq / 2
$ T5 x5 @! m2 r- b: r( m' alinep2(1) = centerp(1) - djq / 2
Call drawbox(linep1, linep2)
( t# ~- J8 I$ g4 w' l# Q9 e

' 画罚球点
) v1 o7 [% ?7 Z3 W- _linep1(0) = centerp(0) + chang / 2 - fqd
linep1(1) = centerp(1)
, C- t. C- x& S2 |0 y$ s$ L% F, iCall ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '点样式
ThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸

/ t3 u1 b  u* y0 ]* k'画罚球弧，罚球弧圆心就是罚球点linep1
7 V$ O( B3 {$ }: {, `: Blinep3(0) = centerp(0) + chang / 2 - djq / 2
linep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '两个端点的x轴相同
$ K; ^! ^- \# k3 q, g8 C9 Z0 N3 Jlinep4(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) '画弧
# [2 l2 _1 p9 i/ U7 c

'角球弧
ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
ang2 = ThisDrawing.Utility.AngleToReal(180, 0)
linep1(0) = centerp(0) + chang / 2 '角球弧圆心
. |3 f; P( N8 U2 n0 E2 G) Olinep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧
, Y. R8 d, G7 K0 C4 ?
ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
; Y, J5 ~& z) |$ B  Elinep1(1) = centerp(1) + kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

2 w! G) O/ q4 a. K
9 Y/ h5 @$ {8 E2 U6 _, g
'镜像轴
linep1(0) = centerp(0)
linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2
; d6 f; P  Z# c. g: M: U
'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
6 e+ F( {- d- p5 ?. H  If ent.Layer = "足球场" Then '对象在"足球场"图层中
/ K8 L" d* v. W3 S+ p& {5 t$ [    ent.Mirror linep1, linep2 '镜像
  U4 O( Q! ^9 }) P* }1 i+ U/ I* Z  End If
# ~. F3 c4 R, ENext ent

3 j: h& G4 e( d4 ]7 r, Q5 `, H1 X( {'画中线
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)

'画中圈
Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)

'画外框
9 `" K2 X+ ~! s* C! g2 p# wlinep1(0) = centerp(0) - chang / 2
1 E) s! L3 c6 P$ @+ i0 Klinep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0) + chang / 2
  T6 c7 ]. U1 I. ^" F/ J5 B$ K" t7 Clinep2(1) = centerp(1) + kuan / 2
Call drawbox(linep1, linep2)
) ~% e3 K, Q: \
ZoomExtents '显示整个图形
- h5 E3 Z+ s0 b( ^& A" b$ ]. J$ {: x6 Y
End Sub

1 Z6 l* D/ f) I1 ]Private Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
; ]+ d4 |  U$ Q2 z$ o& F$ VDim boxp(0 To 14) As Double
5 ?( D2 [! \* k( S, o: }2 y
boxp(0) = p1(0)
! L( P+ q( v1 y1 zboxp(1) = p1(1)
5 j: K( y8 Q' G) `3 }6 Y' Z
$ ~# D1 F' U8 i; A( n5 c" Y5 p/ Jboxp(3) = p1(0)
. l2 T% `2 _9 W! H* |: Y, t7 gboxp(4) = p2(1)

, t& m4 B# j& Tboxp(6) = p2(0)
7 u5 [; i% Z" hboxp(7) = p2(1)

boxp(9) = p2(0)
boxp(10) = p1(1)

5 H2 h% D1 h/ H7 bboxp(12) = p1(0)
" O- R$ G+ h" s3 O. b4 \boxp(13) = p1(1)
( l  X: m) v# I
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
8 j8 h/ T0 t" j
+ {1 ?* B% L9 L/ d  n4 QEnd Sub
' ?6 {/ B# ?' I
: H" g& b* m0 S$ Q, Y) }


下面开始分析源码：

0 J$ L8 J: N. j  v0 i& b2 _On Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
If Err.Number <> 0 Then '用户输入的不是有效数字
# T/ `; u  U  ~$ Q8 v( g. Uchang = 10500
1 a1 O- ~' n7 W1 o# d8 _4 lErr.Clear '清除错误
End If
* O! S% C7 z9 \* p4 h
) k" J0 A. n* u% }% f$ @* T    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。
6 I8 l& }* Q1 P* x
4 d; G. |; Z# c1 ]
    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)
8 V6 W: Y9 {' ]5 v0 {/ }9 o
, y6 x& Y# X/ X3 l  J; {    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。
$ j. e7 t* o: Q+ p
. Z. O5 Z6 h- w6 g0 ^+ o$ A
' Q8 B  |3 R: X4 xang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
) z: l" E" V( D9 C% kang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧
! u, @6 \" H- e  e7 r
: `* e: N9 Z$ D' T& }0 i    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标
  |9 K+ a8 R; M9 p- L
# S) b" ^6 s5 \/ |9 X下面看镜像操作：
3 N  x6 c3 K, i) t6 nFor Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
. T9 K: U: Q' b! z" u  E6 F  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
  End If
Next ent

    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。
2 v9 N% {8 m0 i) z0 Z0 V6 E4 R

本课思考题：
4 R: d: p5 M/ A* j2 l: _
" b1 P1 f( N8 D  A+ t1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入

2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中
, G$ }" v* K6 _3 `* B8 J
[ 本帖最后由 tianyunxuan 于 2007-5-26 20:10 编辑 ]

tianyunxuan

定义块方法：

/ D7 F! a( |( V! f0 d4 pSet blocksobj=ThisDrawing.Blocks.Add(基点, 块名)
把选择集加入块中的方法：
5 o0 G' k. u1 A7 ^! _ThisDrawing.CopyObjects(选择集,块)
  \6 L& k, C( `7 q1 V插入块方法：
ThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度)
画块属性方法：
3 W; W% E: K/ {, u5 VThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值)
3 Q* G! ~$ ?+ z4 p) j一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式
, w" c  A* b- X7 k* f
* O! @) S/ ~+ F, X5 y- g6 a- \
6 y1 {$ d* @8 b& P- m$ \下面的例题是利用属性块画足球场的阵型图。
9 }0 K+ ?; T8 |8 w2 G+ }; @" P程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一课内容。

1 `) t- G: d, B6 X8 m4 E- T, W

) M* }$ i$ d4 U1 V
+ A# v: [& u8 [. L; w; j
8 K- j7 l, P- y$ K7 Y7 S
+ u+ ]) Y6 D7 i编程思路：
0 E4 G: B$ o" l( }: {5 U1．定义一个空块
( v# [) s$ S: z* Q: g8 d2．在块中画一段弧（球服衣领）
0 L1 \8 n) g* Q! t. }3．画多段线，镜像画出球衣
4．画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更改对齐点属性
5．把多段线和属性复制到块中
3 V& Z! z; z6 p6．提示用户点选球员位置和姓名
( _* E) q; l4 l1 i1 U+ P* Z7．插入块，修改球衣号码属性、球员姓名属性

以下是源码，附有详细的注释，如果有疑问，建议用变量跟踪法研究一下。
/ V6 F  d0 p, k, sSub team()
Dim playerlay As AcadLayer '定义球员图层
Dim playerblock As AcadBlock '定义块变量
% {2 Y2 ]7 a# X/ j3 xDim arcc(0 To 2) As Double '圆弧圆心
* Q; p  B3 j# S6 ~6 X( C, T% qDim linep1(0 To 2) As Double '线条端点1
" s! `+ `0 W! s( C1 C" rDim linep2(0 To 2) As Double '线条端点2
Dim pline(0 To 20) As Double '定义队服右侧多段线7个顶点
9 T# g2 ?+ L  \Dim basep(0 To 2) As Double '块基点
$ W) X, H# y6 h6 oDim playernumberpoint(0 To 2) As Double '块属性插入点
7 b9 \9 ~. p/ `9 w% H4 ADim mytxt As AcadTextStyle '定义mytxt变量为文本样式
; p& e3 H$ [6 _0 p7 x4 e6 wDim blockRef As AcadBlockReference '定义块属性变量
, o; q- p: q8 r# dDim Attr3 As Variant '插入块属性变量

8 K/ [1 ?5 T- p" ]3 n2 F: [* DSet playerblock = ThisDrawing.Blocks.Add(basep, "球员") '定义一个"球员"的块

/ v9 b  V, |7 d2 M3 ^9 l: karcc(0) = 0
' X6 X6 c% Z  u; X* g1 oarcc(1) = 430
1 a  j3 ?% [9 D6 I' SCall playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '画弧并加入块中

pline(0) = 0
pline(1) = 20

+ z3 ~  U0 n4 F) Z1 n! g, Mpline(3) = 100
pline(4) = 20

pline(6) = 100
pline(7) = 250
# C) g/ b8 J5 X) S% N+ S: [
pline(9) = 125
1 p* @* `! `. p; Cpline(10) = 207

0 K( E3 [3 Q7 q! t7 opline(12) = 212
pline(13) = 257


; e0 i  Z4 ]: B1 u/ a# O1 Wpline(15) = 112
pline(16) = 430

1 g+ Y: _2 n. O% \& E% }4 t
" D) a+ X: x7 s5 J" y' i  @pline(18) = 50
pline(19) = 430

1 k5 J7 P$ h( O0 I2 k# JSet line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '画队服右侧多段线
/ I- {: {# b8 K7 |
9 n: P' n9 Z- ]. @/ slinep2(1) = 1 '镜像轴第二点位于Y轴上任一点
Set line2 = line1.Mirror(linep1, linep2) '镜像获得另一半多段线
6 U7 ^& I# C+ [: ~2 w3 \
* v' _2 E2 s" t: V: [# bDim p(0 To 2) As Double '定义坐标变量
, A7 W) o) u" cSet mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式
' t9 v# m1 I7 G7 K2 gmytxt.fontFile = "c:\windows\fonts\simfang.ttf" '设置字体文件为仿宋体
( F0 V1 J6 Q. a1 d) c- {' f* CThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt

& N& p' {" v: f  P# Zplayernumberpoint(0) = 0 '块属性位置
playernumberpoint(1) = 200
Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "号码", playernumberpoint, "X", 0) '画块属性
* W/ Y( ]1 [2 sattr1.Alignment = 7 '居中
! |5 E4 p5 C. Mattr1.TextAlignmentPoint = playernumberpoint '重定义对齐点
Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) '画块属性
3 f  X+ C" V  B' K; j) x( pattr2.Alignment = 7 '居中
7 p3 v( L7 L, O0 p4 V  g  z; H) L( N
1 t- r% }6 \) q9 u+ `9 r$ l" S
3 R9 Q5 n* N% O; p8 @Dim objCollection(0 To 3) As Object '创建选择集
* u# n+ u$ Y9 O5 s6 J% z1 ?Set objCollection(0) = line1 '线条1加入选择集
Set objCollection(1) = line2 '线条2加入选择集
Set objCollection(2) = attr1 '属性1加入选择集
6 d2 S# A8 s( m" f1 H+ ySet objCollection(3) = attr2 '属性2加入选择集
& A5 ^8 d) j- }% O8 m" B9 ^
7 m% b) r4 V3 k* aCall ThisDrawing.CopyObjects(objCollection, playerblock) '把选择集加入块中
! g/ \7 h2 _) k3 F' p
For Each element In objCollection '在选择集中进行循环
  element.Delete '删除线条和属性(此操作并不影响已创建的块)
Next
' }1 ^) _  y1 {- M# n

Set playerlay = ThisDrawing.Layers.Add("球员") '新建图层
playerlay.color = 2 '为黄色
ThisDrawing.ActiveLayer = playerlay '将当前图层设置为球员图层

6 B7 _, U4 G  [: `0 I# TDim p1 As Variant '块插入点位置
9 P, m: P. E: q' l; U/ j& ?
For i = 1 To 11 '插入块
  pstring = CStr(i) & "号球员位置："
  p1 = ThisDrawing.Utility.GetPoint(, pstring) '点选球员位置坐标
% h& F2 f6 i. \5 r# _& F6 r, N  nstring = ThisDrawing.Utility.GetString(30, "球员姓名：")
, A$ l6 Y+ w  S/ M* [1 M6 y  Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球员", 1, 1, 1, 0) '插入块
* B$ t$ g2 F0 u& U& }7 ^  Attr3 = blockRef.GetAttributes '获取块属性
  Attr3(0).TextString = CStr(i) '赋值球员号码
# G* t8 ^) Z- N6 U* b( W6 \  Attr3(1).TextString = nstring '赋值球员姓名
4 P) d& s: A! O" R( WNext
* D8 N& K* Y7 b8 e$ D
% E: z! e# D% R% m0 zEnd Sub

, T  x* s7 S  \5 K) _本课思考题：
( ^* r, P8 ^* {6 }3 s5 P7 h1、在本课例程的最后一段增加出错陷阱代码，当用户输入非正常数值时退出程序
2、画一个简易路灯块，用属性块做为路灯编号，由用户点选路灯位置，程序画路灯时自动为路灯编号

trinco

很有帮助！谢谢lz

cgc

终于看好了，写得很不错， 连我从来不写程序的人都能看得懂了

好好学习，感觉函数 方面还有很多的东西不是很懂

有函数库可以查阅么？
8 a9 q  a7 |. T$ z* x+ R$ E$ v9 }  e
1 w% \7 n. G: l( a0 B" h买书也行

nebs

偶是菜鸟 还看不懂 还是顶你一下  辛苦啦

lianghn1986

头痛呀~~~~~~~~~~~~

pianpi111

auto cad vba第一次听说
/ A, ]$ W4 Q, @9 D- M8 c% o: Z学学

nebs

顶！！ 学习中.....

sod11791

太难了，能学会吗？

kyokula

学ＶＢ是不是必须要懂Ｃ语言？