|
|
Autocad VBA初级教程 第十三课块操作
定义块方法：0 Z4 N& q* X' R- {( g
0 ^& s5 E# h$ U* m3 g0 [Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名)
+ z; [8 P3 I" @ H" m# V把选择集加入块中的方法：
! V3 [0 R |$ }: b+ _; NThisDrawing.CopyObjects(选择集,块). v+ M( @! m( {- Y, r; \, D
插入块方法：
, k6 `) L* o1 s4 z5 BThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度)
! z1 H/ O3 o& F4 k/ `6 g3 N0 S画块属性方法：: d/ @& B% F5 ~) i+ H: U
ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值)
0 }! L! T u0 ~& Z# ~' n+ {一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式
- b4 h, Q! G- p+ K8 G7 e4 \4 y9 r5 C" O q! j3 a
* L% x5 D% N W2 |$ O
下面的例题是利用属性块画足球场的阵型图。
8 ^ Q$ D" l5 \3 F" }- ^# W8 f7 v- l程序画出一个球员块，然后把块写到用户指定位置，球员号码由程序自动递增，把球员姓名改为用户输入值。画足球场请参阅上一课内容。$ L i! l$ j2 ~( A
! |& [7 l% t6 j' b& l& P( d, A7 n4 h
) w, z% O# B" D! k9 K
$ E6 D, b* s- s3 Y7 X5 F# r9 t4 d2 s
8 z/ m1 D( ]0 m3 n6 M7 b N' y
) E' P2 ]" S& g/ Q2 O+ Y Z b编程思路：' ]# U. e8 f, ^9 l* _9 w+ n
1．定义一个空块
1 ^" v2 a! j) X0 K* X2．在块中画一段弧（球服衣领）
8 U2 Q- ]4 @. T3．画多段线，镜像画出球衣, U2 P( q% T, |
4．画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更改对齐点属性: K" c4 k" {: _
5．把多段线和属性复制到块中
; T- k: B& m; Z6．提示用户点选球员位置和姓名3 h. I/ O0 I t
7．插入块，修改球衣号码属性、球员姓名属性' R5 }* H6 g! ~) l. t. J0 C
& g* q; W# m! e! q
以下是源码，附有详细的注释，如果有疑问，建议用变量跟踪法研究一下。$ z3 U( s8 ~ C2 I- h, R
Sub team()
# Z+ D5 P# {: iDim playerlay As AcadLayer '定义球员图层. Y0 q7 G! ~. Z) D
Dim playerblock As AcadBlock '定义块变量0 R6 g, L0 S4 Y! H$ u' j5 \, y
Dim arcc(0 To 2) As Double '圆弧圆心: J6 }- i5 R0 c- ]( _( w* U
Dim linep1(0 To 2) As Double '线条端点1
! L2 k/ a6 i+ mDim linep2(0 To 2) As Double '线条端点2
- d8 l5 ~- E' G p! i2 E# ]0 f NDim pline(0 To 20) As Double '定义队服右侧多段线7个顶点% _+ Z& J X8 E0 n$ v: ~5 T6 I
Dim basep(0 To 2) As Double '块基点
2 g# A4 O) Q8 ?4 ~7 p- ]4 @Dim playernumberpoint(0 To 2) As Double '块属性插入点
6 Q! D0 L( \: ADim mytxt As AcadTextStyle '定义mytxt变量为文本样式
; m g$ m, H0 Q( _; d+ FDim blockRef As AcadBlockReference '定义块属性变量, n9 l# T* {4 G1 n- ]0 d' o
Dim Attr3 As Variant '插入块属性变量; ]$ J+ r# A8 }. C" B
" @ ]& ]' o0 b( ?- t' _Set playerblock = ThisDrawing.Blocks.Add(basep, "球员") '定义一个"球员"的块
$ T- y& s4 p) ?! S* I8 o# b1 }& _$ v3 N Z3 A9 @; A
arcc(0) = 0
% z& e/ K' O) Z" d aarcc(1) = 430
+ q% o3 w( z, g9 z7 ACall playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '画弧并加入块中
! A7 j/ \' G# m* {- h# t, l! n: v6 j' Z" w7 E, T
pline(0) = 0
- g# u1 b( R1 |5 ]% `6 }& S% `pline(1) = 202 t/ w7 |# P# f
( F4 D1 N( }' Y: i2 E" ypline(3) = 100
_! B# h5 j6 N3 V- z% zpline(4) = 20
$ c; D6 o' w' I) z( i# J" _% p% \2 U$ L( {: e
pline(6) = 100* e2 F( `6 s2 w
pline(7) = 250
4 s, Q4 j2 A- O/ o" |* Y- n9 ?5 h( e% H4 [
pline(9) = 1252 L% w0 ~2 \& |
pline(10) = 207$ a7 A5 R+ ?: y5 v$ n$ ~3 Z' u$ }
4 J6 Q, a9 H, M' d4 v
pline(12) = 212
' A# M: r, @# n! C% \pline(13) = 257/ _% w! W Q4 {; `/ Y$ O J
4 i$ m. F; [( A- K; C5 v
; v* D/ u$ k1 z( I
pline(15) = 112
, O. M$ `* n5 p7 `pline(16) = 430
5 |) ]1 V; O" s9 }7 r4 J9 x4 j- \
& ]7 x0 D0 R( X. _9 ^# c9 q
pline(18) = 50
! x( X' j, w0 v1 ^8 [' y0 _pline(19) = 430
* ]6 `9 E/ g% ~ s' b$ `/ G6 y8 m* |3 k" q8 ?0 S0 I k
Set line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '画队服右侧多段线
! m( n! ]2 t- o/ S: x# W. R# [" v8 S- E
linep2(1) = 1 '镜像轴第二点位于Y轴上任一点
, Q; L: y; l& pSet line2 = line1.Mirror(linep1, linep2) '镜像获得另一半多段线0 v. o# w! ]. Z ?6 }3 k1 \
' S: N# `: C \& U. c/ G- {Dim p(0 To 2) As Double '定义坐标变量; d, y8 D6 j: T1 C: p% ]5 U' w
Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt样式% z9 n Y8 L# A
mytxt.fontFile = "c:\windows\fonts\simfang.ttf" '设置字体文件为仿宋体
* W+ y/ s0 e' GThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt
+ B$ p) j( `: j2 q) U- v0 p( a$ v9 M. O3 L) h s4 T
playernumberpoint(0) = 0 '块属性位置
7 U5 O, d9 j* J. Nplayernumberpoint(1) = 200
6 p* ~8 e4 Z6 Y! E, ~$ K" SSet attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "号码", playernumberpoint, "X", 0) '画块属性
4 c" v. y4 N2 q( X/ Hattr1.Alignment = 7 '居中
: g5 x# {5 o; ~8 j6 N7 ]attr1.TextAlignmentPoint = playernumberpoint '重定义对齐点" A9 N# F% O2 E4 w" o0 U Z: v# |
Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) '画块属性
. l& x$ R( Q0 K) P( |5 K/ Qattr2.Alignment = 7 '居中% K1 x8 J# y# c n: w* d
) ^# b3 }, B3 r5 A, R6 |! Z3 G
* F% T e8 P: B2 t) Q$ V5 wDim objCollection(0 To 3) As Object '创建选择集
0 j2 |$ ]8 s0 M* zSet objCollection(0) = line1 '线条1加入选择集$ X, M6 `: s) Z7 d
Set objCollection(1) = line2 '线条2加入选择集
& q: g! k- s9 C6 E/ N( U ?Set objCollection(2) = attr1 '属性1加入选择集
( w* {+ G, W9 W9 XSet objCollection(3) = attr2 '属性2加入选择集3 |, b" [: ^( [% R7 d5 ?2 C z
& r, u. V9 l2 _& M, K8 d3 b, H
Call ThisDrawing.CopyObjects(objCollection, playerblock) '把选择集加入块中
0 [% b5 T( b" K! b- Q( r i7 M# W, ~1 M: i7 v
For Each element In objCollection '在选择集中进行循环- t( D \0 U) Z. G& s' a' R) Q
element.Delete '删除线条和属性(此操作并不影响已创建的块)+ h- `4 }! M+ K) Q+ q
Next
8 a/ [6 l5 N4 f+ p. z' `2 {# z4 f# J
- f5 I+ O/ i7 D. x. m" \( vSet playerlay = ThisDrawing.Layers.Add("球员") '新建图层
6 L! Y( n M, M% U( _ C" X" nplayerlay.color = 2 '为黄色, B, S& ^$ p; y+ ^- h! N* T$ `- [
ThisDrawing.ActiveLayer = playerlay '将当前图层设置为球员图层
: Q5 G; A$ C1 C& w) {# }4 L5 W
) Z" E- N m- \ LDim p1 As Variant '块插入点位置
9 F- k: v' ?$ l% L2 h" b2 _/ y1 C+ K% V6 u* _2 k. ^7 K
For i = 1 To 11 '插入块
8 v8 H- u- Z7 t3 N, ^2 K) U pstring = CStr(i) & "号球员位置："# I! s8 S' \4 E3 M
p1 = ThisDrawing.Utility.GetPoint(, pstring) '点选球员位置坐标6 K* E# n) t0 {! F4 G- o/ C
nstring = ThisDrawing.Utility.GetString(30, "球员姓名：")
# s8 m4 x5 W! K9 y$ ^ Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球员", 1, 1, 1, 0) '插入块
8 s' S. q# `' V8 E' N8 O' A3 T1 ] Attr3 = blockRef.GetAttributes '获取块属性$ f+ O8 Z) R6 j9 m
Attr3(0).TextString = CStr(i) '赋值球员号码
) e k4 F1 a9 Z# c8 a: l6 R Attr3(1).TextString = nstring '赋值球员姓名
! s# M5 F: a" E& m+ s; ~; PNext2 k- O l% C6 P
; A3 k8 ?) M; }: ~3 QEnd Sub; P0 w' j2 p, k; D- @* e. V
+ _1 p% H# [8 g. F本课思考题：
. A9 g2 Q: W+ \1、在本课例程的最后一段增加出错陷阱代码，当用户输入非正常数值时退出程序
5 W2 i* Y4 F, ^- h2、画一个简易路灯块，用属性块做为路灯编号，由用户点选路灯位置，程序画路灯时自动为路灯编号 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2007-1-24 09:48
谢谢,我是菜鸟不是很懂,感觉很好 啊!
