|
|
Autocad VBA初级教程 第十三课块操作
定义块方法：
3 T, } d5 p+ E3 X( }( I! N$ j' l) C
Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名)
# E7 }0 i- A3 L把选择集加入块中的方法： O- r1 K7 _+ S- }% p' }' M& d
ThisDrawing.CopyObjects(选择集,块) j; ]: E! G( q5 B5 ]
插入块方法：
7 y+ z9 r( {+ \- u6 jThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度)
! [9 B, m9 G1 ~1 c {! `画块属性方法：
7 X1 e' H. d1 y2 I2 UThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值): ~. {1 c {1 F1 [7 w/ I* X
一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式
6 @, K3 D [) G4 V- \) S' @4 m0 P5 w: E" x3 R+ `7 R
1 w) m- ]) q5 a% L4 c下面的例题是利用属性块画足球场的阵型图。) j: g5 Q* Z2 }0 A0 q+ E
程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一课内容。
& I* V$ k `+ }, t! M& G; v
; [" u: G/ I, o8 k- S* e
* B! K, E' U: S+ e5 {: u" B6 r
7 i! [0 y! w9 c: N3 W" }
5 N1 r( R: T3 t' f$ l9 z q! }8 {3 H+ i/ {! x
& k% g g) [0 [
编程思路：
1 [9 `; v7 r9 x9 U0 `3 E1．定义一个空块8 q1 W/ E) }4 | Z
2．在块中画一段弧（球服衣领） Z1 V, K2 {; [) v* J; H' d
3．画多段线，镜像画出球衣
7 A1 v S0 B+ j: D- G0 E( i2 g4．画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更改对齐点属性
, P$ v( [" \+ }+ r5．把多段线和属性复制到块中, ?/ U. U5 `* E, T' L4 u w
6．提示用户点选球员位置和姓名, G+ c/ w: x- ^7 S
7．插入块，修改球衣号码属性、球员姓名属性+ C: B+ W; x2 E" j# B. ^
# p5 y- g1 V: ~& q( B以下是源码，附有详细的注释，如果有疑问，建议用变量跟踪法研究一下。6 M. u6 [+ y* b2 H5 c% Y- i
Sub team()
B+ {8 d, {- [; m( r$ z; I9 O" [Dim playerlay As AcadLayer '定义球员图层. n) X- m7 U- u& d% \3 w
Dim playerblock As AcadBlock '定义块变量% E4 o5 k4 ~5 p6 b0 s/ S' b
Dim arcc(0 To 2) As Double '圆弧圆心
) [3 A; A7 `+ RDim linep1(0 To 2) As Double '线条端点1+ }9 w. P7 {5 T+ t
Dim linep2(0 To 2) As Double '线条端点2
" Q7 B w* e0 ?& i+ a( h8 \' VDim pline(0 To 20) As Double '定义队服右侧多段线7个顶点6 y, {# {% I& t9 f) ~. @
Dim basep(0 To 2) As Double '块基点/ ]* v( y. u4 Q0 l% q
Dim playernumberpoint(0 To 2) As Double '块属性插入点
! H' _) m; V# qDim mytxt As AcadTextStyle '定义mytxt变量为文本样式& Z( Q( A/ E4 Y; X n. `
Dim blockRef As AcadBlockReference '定义块属性变量( W0 v( s7 `; v- w& w
Dim Attr3 As Variant '插入块属性变量
1 {, Q. M2 C0 X0 h! j/ R5 r" Q4 E' f- ^; \9 I9 L, w9 n& M5 x
Set playerblock = ThisDrawing.Blocks.Add(basep, "球员") '定义一个"球员"的块
; e" j9 F8 W1 w/ l) B( j! C& W
( l6 `: S( u/ N; h0 _+ Sarcc(0) = 0' [( c$ y K" W( C) O
arcc(1) = 430( t t* p4 b2 [. l2 b
Call playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '画弧并加入块中
# \4 r; ^& }: B" J, n9 I: z
3 n7 y5 F# J9 b% k' ]pline(0) = 0
- R2 W* G0 R' vpline(1) = 20
) @# d; p; E7 l4 K) B- M
, R& _' i+ F$ T$ L7 q. `, p2 [pline(3) = 100
' q+ o, e. v$ J/ m; Bpline(4) = 207 ?( ?2 |9 x8 v0 v" v0 i3 d
9 F0 r1 ~0 Z( t7 y; _! g4 B
pline(6) = 100& W& ?/ ]' m8 Z# q" u9 h
pline(7) = 250
3 u$ y: ?$ r; P `3 i t$ X7 r
7 F6 M' `) ?# R1 o' R! npline(9) = 1257 o$ @/ f S: p" L, N( y1 `
pline(10) = 207
$ f" I5 A% a' W' l( F% m3 ?9 n7 C/ z$ i$ ~# r
pline(12) = 2121 f, Z% ^& n4 ]
pline(13) = 257
7 w" ?5 k2 ^4 y
) E W8 S/ r/ I- d
( S* h+ j' @$ x# J9 _3 Opline(15) = 1124 f- n$ z4 l3 K$ w
pline(16) = 430
4 v- v! u) W, K2 c; L# s7 B7 [- i$ P, U, _/ B
# Q4 r, Y; V9 |5 R2 d/ z4 T' I) D! ]2 Q
pline(18) = 504 ~! u% K+ `7 t; L* k' v( c; x
pline(19) = 430
1 O7 W4 z4 B4 x+ b: L; E) l3 }4 R7 u
Set line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '画队服右侧多段线, E- V6 G# q4 @% L, N+ ~0 d/ _
' I" C0 ~* d3 Y1 l
linep2(1) = 1 '镜像轴第二点位于Y轴上任一点( k' |" W7 q3 X4 I: }" K
Set line2 = line1.Mirror(linep1, linep2) '镜像获得另一半多段线; z9 y- o( p) [) T' g7 |
1 T" f, N O+ E: o4 X/ `# s) rDim p(0 To 2) As Double '定义坐标变量3 G4 e+ R( |2 B4 J, v
Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式2 g% R6 _' x2 V
mytxt.fontFile = "c:\windows\fonts\simfang.ttf" '设置字体文件为仿宋体
; ]% a. r& l' \3 o8 }: g8 LThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt- J3 e. {) Y* F) X- o# ?8 i/ E
: [4 K( c8 x" m- z1 W& x
playernumberpoint(0) = 0 '块属性位置
' j7 D5 g) r, k' b. S- Uplayernumberpoint(1) = 200+ j) K A" r- [! i3 ?$ ]! l- Q+ ?" O
Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "号码", playernumberpoint, "X", 0) '画块属性, X* k% e2 S- Y q
attr1.Alignment = 7 '居中6 j, u! B2 S* G% \
attr1.TextAlignmentPoint = playernumberpoint '重定义对齐点* c5 i3 Z1 ]9 G, I: |
Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) '画块属性, d& q/ G# S, [/ `) p; _- @
attr2.Alignment = 7 '居中
7 R1 s* _! l U5 T9 o5 r/ Q1 ^7 H* L. m2 a
, F$ p( W/ z/ `9 H/ H4 w$ {
Dim objCollection(0 To 3) As Object '创建选择集
! {; `5 M' q& V8 `0 PSet objCollection(0) = line1 '线条1加入选择集
7 ~ t3 u& }; `5 Y' eSet objCollection(1) = line2 '线条2加入选择集. [# p. j) ^# K, a, P8 }0 q, m6 _
Set objCollection(2) = attr1 '属性1加入选择集7 }5 H0 T/ o/ Q0 d% r& e R/ z# Z
Set objCollection(3) = attr2 '属性2加入选择集
5 A* ?0 t6 w/ _$ R% ^- ?2 z/ Y' s s4 S7 c5 `
Call ThisDrawing.CopyObjects(objCollection, playerblock) '把选择集加入块中
5 O2 ]* @6 h! x
L4 ~1 R! W; S9 f, yFor Each element In objCollection '在选择集中进行循环) t: d) N& d8 z# Z: f
element.Delete '删除线条和属性(此操作并不影响已创建的块)- H4 I, q7 `3 D2 Z, Z& R5 j; f
Next
; n; P0 s. _2 S* u: T- N2 B: m' @3 K, V0 q2 @
3 h$ c- L( j3 |
Set playerlay = ThisDrawing.Layers.Add("球员") '新建图层: [" g0 K o) [
playerlay.color = 2 '为黄色
/ n1 i& l2 i$ E" B4 D. m. [1 {: SThisDrawing.ActiveLayer = playerlay '将当前图层设置为球员图层
! d, p" T! k3 |. _1 D% Y% i2 P
1 t5 [) y' b7 v. p1 U& {8 tDim p1 As Variant '块插入点位置) k0 r" ^9 E8 ?* w) a9 y6 I+ e; H. p
; F5 c7 {" g) HFor i = 1 To 11 '插入块& R% g' \4 P: p2 T: ~4 b
pstring = CStr(i) & "号球员位置："
7 O3 @2 u. R; q; g6 S: \2 ^ p1 = ThisDrawing.Utility.GetPoint(, pstring) '点选球员位置坐标
) a) |9 l; s, i& e8 s9 h nstring = ThisDrawing.Utility.GetString(30, "球员姓名："); n1 Q$ ]9 t! G& N6 Z! _1 s. z- ?4 E
Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球员", 1, 1, 1, 0) '插入块9 _& G2 l$ \0 O6 C8 e! h1 K
Attr3 = blockRef.GetAttributes '获取块属性
# F% X) ~- U# j Attr3(0).TextString = CStr(i) '赋值球员号码+ j' @+ g7 e! s* B' z$ A4 v. V
Attr3(1).TextString = nstring '赋值球员姓名
7 q7 X) m& ~. |& A% R+ m& [& dNext
& Y( W6 I9 |- `$ X1 ]2 X' s
3 k7 i# d: Q' gEnd Sub) A. y! \# V3 F+ q
1 ^5 k* U# a' z" k. Y5 j本课思考题：
+ W3 ^- k! D; P H1、在本课例程的最后一段增加出错陷阱代码，当用户输入非正常数值时退出程序
. ]1 e* j7 o' A, L5 W( N# O7 f* X2、画一个简易路灯块，用属性块做为路灯编号，由用户点选路灯位置，程序画路灯时自动为路灯编号 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2007-1-24 09:48
谢谢,我是菜鸟不是很懂,感觉很好 啊!
