Autocad VBA初級(jí)教程(第十三課 塊操作)

    定義塊方法：

Set blocksobj=ThisDrawing.Blocks.Add(基點(diǎn), 塊名)
把選擇集加入塊中的方法：
ThisDrawing.CopyObjects(選擇集,塊)
插入塊方法：
ThisDrawing.ModelSpace.InsertBlock(插入點(diǎn),塊名, X軸比例,Y軸比例,Z軸比例, 旋轉(zhuǎn)角度)
畫塊屬性方法：
ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入點(diǎn), 顯示字符,默認(rèn)值)
一共有五種模式，在輸入時(shí)會(huì)有提示，其中最常用的是“acAttributeModeNormal”普通模式

下面的例題是利用屬性塊畫足球場(chǎng)的陣型圖。
程序畫出一個(gè)球員塊，然后把塊寫到用戶指定位置，球員號(hào)碼由程序自動(dòng)遞增，把球員姓名改為用戶輸入值。畫足球場(chǎng)請(qǐng)參閱上一課內(nèi)容。

編程思路：
1．定義一個(gè)空塊
2．在塊中畫一段�。ㄇ蚍�衣領(lǐng)）
3．畫多段線，鏡像畫出球衣
4．畫塊屬性，由于塊屬性默認(rèn)的對(duì)齊方式是左對(duì)齊，而球員號(hào)碼應(yīng)該居中，所以必須把塊的對(duì)齊屬性改為居中。但是當(dāng)這個(gè)屬性更改時(shí)塊屬性對(duì)齊點(diǎn)會(huì)自動(dòng)歸零，所以不得不再次更改對(duì)齊點(diǎn)屬性
5．把多段線和屬性復(fù)制到塊中
6．提示用戶點(diǎn)選球員位置和姓名
7．插入塊，修改球衣號(hào)碼屬性、球員姓名屬性

以下是源碼，附有詳細(xì)的注釋，如果有疑問(wèn)，建議用變量跟蹤法研究一下。
Sub team()
Dim playerlay As AcadLayer '定義球員圖層
Dim playerblock As AcadBlock '定義塊變量
Dim arcc(0 To 2) As Double '圓弧圓心
Dim linep1(0 To 2) As Double '線條端點(diǎn)1
Dim linep2(0 To 2) As Double '線條端點(diǎn)2
Dim pline(0 To 20) As Double '定義隊(duì)服右側(cè)多段線7個(gè)頂點(diǎn)
Dim basep(0 To 2) As Double '塊基點(diǎn)
Dim playernumberpoint(0 To 2) As Double '塊屬性插入點(diǎn)
Dim mytxt As AcadTextStyle '定義mytxt變量為文本樣式
Dim blockRef As AcadBlockReference '定義塊屬性變量
Dim Attr3 As Variant '插入塊屬性變量

Set playerblock = ThisDrawing.Blocks.Add(basep, "球員") '定義一個(gè)"球員"的塊

arcc(0) = 0
arcc(1) = 430
Call playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '畫弧并加入塊中

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

pline(3) = 100
pline(4) = 20

pline(6) = 100
pline(7) = 250

pline(9) = 125
pline(10) = 207

pline(12) = 212
pline(13) = 257

pline(15) = 112
pline(16) = 430

pline(18) = 50
pline(19) = 430

Set line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '畫隊(duì)服右側(cè)多段線

linep2(1) = 1 '鏡像軸第二點(diǎn)位于Y軸上任一點(diǎn)
Set line2 = line1.Mirror(linep1, linep2) '鏡像獲得另一半多段線

Dim p(0 To 2) As Double '定義坐標(biāo)變量
Set mytxt = ThisDrawing.TextStyles.Add("mytxt") '添加mytxt樣式
mytxt.fontFile = "c:\windows\fonts\simfang.ttf" '設(shè)置字體文件為仿宋體
ThisDrawing.ActiveTextStyle = mytxt '將當(dāng)前文字樣式設(shè)置為mytxt

playernumberpoint(0) = 0 '塊屬性位置
playernumberpoint(1) = 200
Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "號(hào)碼", playernumberpoint, "X", 0) '畫塊屬性
attr1.Alignment = 7 '居中
attr1.TextAlignmentPoint = playernumberpoint '重定義對(duì)齊點(diǎn)
Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, "姓名", playernumberpoint, "???", 0) '畫塊屬性
attr2.Alignment = 7 '居中

Dim objCollection(0 To 3) As Object '創(chuàng)建選擇集
Set objCollection(0) = line1 '線條1加入選擇集
Set objCollection(1) = line2 '線條2加入選擇集
Set objCollection(2) = attr1 '屬性1加入選擇集
Set objCollection(3) = attr2 '屬性2加入選擇集

Call ThisDrawing.CopyObjects(objCollection, playerblock) '把選擇集加入塊中

For Each element In objCollection '在選擇集中進(jìn)行循環(huán)
  element.Delete '刪除線條和屬性(此操作并不影響已創(chuàng)建的塊)
Next

Set playerlay = ThisDrawing.Layers.Add("球員") '新建圖層
playerlay.color = 2 '為黃色
ThisDrawing.ActiveLayer = playerlay '將當(dāng)前圖層設(shè)置為球員圖層

Dim p1 As Variant '塊插入點(diǎn)位置

For i = 1 To 11 '插入塊
  pstring = CStr(i) & "號(hào)球員位置："
  p1 = ThisDrawing.Utility.GetPoint(, pstring) '點(diǎn)選球員位置坐標(biāo)
  nstring = ThisDrawing.Utility.GetString(30, "球員姓名：")
  Set blockRef = ThisDrawing.ModelSpace.InsertBlock(p1, "球員", 1, 1, 1, 0) '插入塊
  Attr3 = blockRef.GetAttributes '獲取塊屬性
  Attr3(0).TextString = CStr(i) '賦值球員號(hào)碼
  Attr3(1).TextString = nstring '賦值球員姓名
Next

End Sub

本課思考題：
1、在本課例程的最后一段增加出錯(cuò)陷阱代碼，當(dāng)用戶輸入非正常數(shù)值時(shí)退出程序
2、畫一個(gè)簡(jiǎn)易路燈塊，用屬性塊做為路燈編號(hào)，由用戶點(diǎn)選路燈位置，程序畫路燈時(shí)自動(dòng)為路燈編號(hào).