- 积分
- 5301
- 明经币
- 个
- 注册时间
- 2010-9-27
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2011-2-10 18:47:08
|
显示全部楼层
给你个cad帮助里面的例子
本例创建一个块,然后向块中添加属性。接着将块插入到图形中。然后返回属性数据,并在消息框中显示。块参照中的属性数据将被更新,并再次返回和显示属性数据。
Sub Ch10_GettingAttributes()
' 创建块
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add _
(insertionPnt, "TESTBLOCK")
' 定义属性定义
Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1#
mode = acAttributeModeVerify
prompt = "Attribute Prompt"
insertionPoint(0) = 5
insertionPoint(1) = 5
insertionPoint(2) = 0
tag = "Attribute Tag"
value = "Attribute Value"
' 在块上创建属性定义对象
Set attributeObj = blockObj.AddAttribute _
(height, mode, prompt, _
insertionPoint, tag, value)
' 插入块
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2
insertionPnt(1) = 2
insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
(insertionPnt, "TESTBLOCK", 1, 1, 1, 0)
ZoomAll
' 获取块参照的属性
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes
' 将属性标记和值移至
' 要在 Msgbox 中显示的字符串中
Dim strAttributes As String
strAttributes = ""
Dim I As Integer
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes + " Tag: " + _
varAttributes(I).TagString + vbCrLf + _
" Value: " + varAttributes(I).textString
Next
MsgBox "The attributes for blockReference " + _
blockRefObj.Name & " are: " & vbCrLf _
& strAttributes
' 更改属性值
' 注意:没有 SetAttributes。一旦包含
' 变量数组,就拥有了对象。
' 更改这些对象就会改变图形中的对象。
varAttributes(0).textString = "NEW VALUE!"
' 再次获取属性
Dim newvarAttributes As Variant
newvarAttributes = blockRefObj.GetAttributes
' 再次显示标记和值
strAttributes = ""
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes + " Tag: " + _
newvarAttributes(I).TagString + vbCrLf + _
" Value: " + newvarAttributes(I).textString
Next
MsgBox "The attributes for blockReference " & _
blockRefObj.Name & " are: " & vbCrLf _
& strAttributes
End Sub
|
|