|
|
Autocad VBA初级教程 第十三课块操作
定义块方法：
9 m# i1 b( E5 r- ~+ `2 |% I; _/ V9 M, B) }! ^2 c
Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名)
+ a$ u& S. b) N+ c8 f/ b$ o6 R把选择集加入块中的方法：! z2 @9 P g3 [1 N! b
ThisDrawing.CopyObjects(选择集,块)
* ? b f2 `5 }$ g: P) l# M. j插入块方法：
7 q' V$ Y2 U9 i& ?4 f! I& ^( yThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度) , w/ @6 {3 U4 h
画块属性方法：4 f4 l& Q3 Y4 g9 k, P, S9 C6 V
ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值)3 L6 Z9 C1 |6 q- I1 P; w& ]
一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式5 Z. c5 Z- Y5 U, A
, y: h0 s- S* M. W$ p8 X
3 p' W6 \4 f0 Z% o
下面的例题是利用属性块画足球场的阵型图。" y2 H/ U) B8 p: h! U
程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一课内容。0 g2 Z- C) K9 p" v
! N: N/ t6 a1 C* [6 A1 Y, B8 _$ F6 E! u, b3 o
9 r& U4 A* G; v2 B8 m5 T: p) h" |
' n+ I1 ^$ q* p6 E
& e4 f" b- K( \5 H! L
7 n/ P2 H$ w/ l5 G编程思路：- ~8 l4 g j, ` y; ]) C, P( H
1．定义一个空块* H' z3 G) l5 D- h# X% F% }' y
2．在块中画一段弧（球服衣领）; p6 V8 D1 I! K/ g; t' o
3．画多段线，镜像画出球衣7 }/ d; ]5 s2 C. W
4．画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更改对齐点属性
2 q, j \6 y& ?' d5．把多段线和属性复制到块中% o: }" g0 G0 I/ T& B7 ?
6．提示用户点选球员位置和姓名
# ^% \5 M; t. H! y8 C7．插入块，修改球衣号码属性、球员姓名属性
* I: l8 [+ {% w% ~
4 Q. V3 `4 U+ J- |0 I5 T以下是源码，附有详细的注释，如果有疑问，建议用变量跟踪法研究一下。
' J3 E( B& E) fSub team()
$ V$ ~; N- ?! p: vDim playerlay As AcadLayer '定义球员图层8 }. N+ l5 @6 s' A1 |% }
Dim playerblock As AcadBlock '定义块变量
4 A: x0 P }( ~7 O+ YDim arcc(0 To 2) As Double '圆弧圆心
6 V- \, ?% ~! eDim linep1(0 To 2) As Double '线条端点1$ Q: L3 k- u! l% \6 p' t. l; A
Dim linep2(0 To 2) As Double '线条端点20 S3 ^3 _9 t. C- g4 l- a
Dim pline(0 To 20) As Double '定义队服右侧多段线7个顶点( F* e" j. v: j) h$ p7 U& M8 B
Dim basep(0 To 2) As Double '块基点
2 x4 q& N. ?, IDim playernumberpoint(0 To 2) As Double '块属性插入点, N, t. W8 s7 X" k4 N
Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式 O' F9 x; Z# Y+ {* R6 T
Dim blockRef As AcadBlockReference '定义块属性变量
" |, n- Y) I" z5 \0 ]Dim Attr3 As Variant '插入块属性变量7 }% A) f, U+ @) k8 k* `
D0 c) h1 m, V/ a9 z$ @3 v0 G" f$ ySet playerblock = ThisDrawing.Blocks.Add(basep, "球员") '定义一个"球员"的块 g) l+ y) J# z8 s/ \3 q4 \
* @0 k! L- [/ ~ Y5 i! n
arcc(0) = 0% ?8 n9 d$ S5 B) v; N
arcc(1) = 430
2 }. c/ C% p5 z3 q, O9 Y- ICall playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '画弧并加入块中. {" k4 x8 d% B+ T6 V
" W/ q8 W1 w! B8 j& u7 S4 m! T
pline(0) = 0; g6 V! Z: n/ d) n2 d# r
pline(1) = 20
& Y6 c, Z' i. b! Y% M; x/ n7 l
8 o/ k1 z8 r) m/ Spline(3) = 100# z) b. ?0 l9 Q
pline(4) = 20
! l. ^) U5 P$ x4 `% K& c) ]. B a F3 E! f1 J' Y1 g) J
pline(6) = 100/ q* s z1 W, F& ^2 J- C
pline(7) = 250; n' w( p% b. z! i. f3 x+ c$ M& X
g. O" B7 e* T1 c% \/ z
pline(9) = 125+ F8 E2 A8 r7 |/ b
pline(10) = 207
8 \$ G4 @- ~7 A+ T1 U$ V/ w
, y9 h( R i0 _7 _pline(12) = 212
: F3 G6 ~, L; k7 `/ I, H& fpline(13) = 257! x; S2 C9 {% I. |
f2 Y i* N) I# d. C$ t' ?/ G) R8 B g, H0 e1 {( |2 S, n- c
pline(15) = 112# g# M, e; W( _% B/ V* I
pline(16) = 430
% j% K, V3 U) T& I* z0 u; ]
0 I6 E4 ^! |6 b: y) @3 L- w) ^' W$ h6 w; b' @4 P
pline(18) = 50
* C, |( V( \0 L# Z- O& w9 jpline(19) = 430
5 I% W# _( u- P: d! J; \3 E, o. t
0 V' D6 _( k1 R3 p' XSet line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '画队服右侧多段线 N" Y8 s1 w8 H
$ I; T! B: O( u- c/ v. `0 [
linep2(1) = 1 '镜像轴第二点位于Y轴上任一点
" m& x6 f1 @. }4 D( p. ^( jSet line2 = line1.Mirror(linep1, linep2) '镜像获得另一半多段线& `: N4 c2 N0 y6 L! O) Q
4 F. E# t) N/ P; J5 j/ vDim p(0 To 2) As Double '定义坐标变量
( f6 n5 Z9 _. Y7 ]Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式# o& \6 I& g8 Y, G
mytxt.fontFile = "c:\windows\fonts\simfang.ttf" '设置字体文件为仿宋体 r X# x; v, c$ m
ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt4 M$ ]/ d6 g3 H, `. y1 b9 Z
. f4 w, }0 _1 I/ G8 D4 k
playernumberpoint(0) = 0 '块属性位置7 z5 s$ C7 h: `* B' I2 j
playernumberpoint(1) = 200! t2 P- c% B: t: e& [
Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "号码", playernumberpoint, "X", 0) '画块属性
! M' i8 t, M. ~; ?; w) m; m" Tattr1.Alignment = 7 '居中- m: s- K% Y; S! h) ]8 y4 B3 D5 J
attr1.TextAlignmentPoint = playernumberpoint '重定义对齐点 v/ `" V; d0 O0 Z
Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) '画块属性
3 q+ z1 y7 S- }3 _4 W, `: Wattr2.Alignment = 7 '居中8 Q$ ~! q \# V. x* u5 q8 D
& \" E$ Q7 S B4 [6 h2 C
+ S) Q+ u' }- x+ r- fDim objCollection(0 To 3) As Object '创建选择集8 a1 C$ v% I" V& ?( s( m$ E
Set objCollection(0) = line1 '线条1加入选择集+ p& S" ]3 C! N& c
Set objCollection(1) = line2 '线条2加入选择集
7 G2 l! w+ k5 |& F0 B TSet objCollection(2) = attr1 '属性1加入选择集
2 U7 T- W# @" [: z- O) bSet objCollection(3) = attr2 '属性2加入选择集4 F( N4 q+ X+ E; n" P% {
( j$ n) ^' y& O8 _; F, w9 G3 ECall ThisDrawing.CopyObjects(objCollection, playerblock) '把选择集加入块中. x* C5 }3 i7 T5 B- o( n% H
$ Q6 F& h- Y# Z6 ], ]5 L
For Each element In objCollection '在选择集中进行循环
4 ^; }- W, v6 Y& U* r element.Delete '删除线条和属性(此操作并不影响已创建的块)8 Y" i& j8 ? K- s3 a
Next6 o( w& O" q- [7 b& B; J
' U- w0 t$ ~9 x* g# j- B' l+ G% K& O8 d2 c( C2 x
Set playerlay = ThisDrawing.Layers.Add("球员") '新建图层( U; v1 Y; O5 l4 B/ k* k/ N
playerlay.color = 2 '为黄色
; m0 k2 J/ R& q' ~% T: u# ?# {7 \ThisDrawing.ActiveLayer = playerlay '将当前图层设置为球员图层
7 D7 d0 t2 {& s4 ]' h T0 ]! \
Dim p1 As Variant '块插入点位置/ l: T# L& P9 v
" N0 ?4 H! d/ x: E7 q2 Y
For i = 1 To 11 '插入块 m7 q/ ]* P' _: ]2 X( u
pstring = CStr(i) & "号球员位置："5 L" G) U, L5 X' [9 i @4 ?# U
p1 = ThisDrawing.Utility.GetPoint(, pstring) '点选球员位置坐标5 ?" t* U \( R3 W' t
nstring = ThisDrawing.Utility.GetString(30, "球员姓名：")
O, z) Q* y L6 X; ^. y& r1 L Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球员", 1, 1, 1, 0) '插入块
5 l" h% I6 C" V/ i3 e Attr3 = blockRef.GetAttributes '获取块属性
6 F) U. u4 A3 H3 C# R" M Attr3(0).TextString = CStr(i) '赋值球员号码
6 V8 {) I0 \ s1 t4 c) N Attr3(1).TextString = nstring '赋值球员姓名# a0 p; U3 V/ l8 Y+ G
Next1 d5 ^ S+ `9 ?4 O
! }6 H y$ g: G* x, V8 TEnd Sub
) r- `2 V( d' G0 X% e
* g2 y5 t$ X" u t) Q4 S2 h1 e本课思考题：" V7 ~/ I, p. c9 w* [
1、在本课例程的最后一段增加出错陷阱代码，当用户输入非正常数值时退出程序, ~, V+ e7 j& p* w' h. I- Q
2、画一个简易路灯块，用属性块做为路灯编号，由用户点选路灯位置，程序画路灯时自动为路灯编号 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2007-1-24 09:48
谢谢,我是菜鸟不是很懂,感觉很好 啊!
