[VBA程序]：[急用]在VBA中，插入有属性的块，怎样给属性赋值？

indal

在VBA中，插入有属性的块，怎样给属性赋值？
能否来个例子？

gjliang

Sub lhjc()
Dim blockA00 As String
Dim insertpoint As Variant
ThisDrawing.ActiveTextStyle.BigFontFile = "C:\Program Files\AutoCAD 2002\Fonts\Hztxtg.shx"  '设置文字样式
ThisDrawing.ActiveTextStyle.fontFile = "C:\Program Files\AutoCAD 2002\Fonts\italic.shx"
On Error Resume Next
insertpoint = ThisDrawing.Utility.GetPoint(, "输入插入点：")
blockA00 = "C:\Program Files\AutoCAD 2002\design\att\tukuang\A00.dwg"
If Err Then
Err.Clear
Exit Sub
End If
Dim blockobjA00 As AcadBlockReference
Set blockobjA00 = ThisDrawing.ModelSpace.InsertBlock(insertpoint, blockA00, 1, 1, 1, 0)
ThisDrawing.SendCommand "attedit" & vbCrLf & "(entlast)" & vbCr   '取得最后插入实体属性
If blockobjA00.Layer = "图框" Then
Exit Sub
Else:
Set tukuang = ThisDrawing.Layers.Add("图框")
blockobjA00.Layer = "图框"
End If
ZoomAll
End Sub

前提是先做好一个外部的属性块,然后用程序调用.

indal

不太理解
假如有一个块，它带有一个属性，这个属性的预定值为12.34，但在插入后，我要把值赋为34.56，应怎样呢？

efan2000

将块插入到图纸中后，返回块引用对象，然后使用HasAttributes判断有没有属性，用GetAttributes返回所有的属性，接着枚举，找到需要的属性，更改其值。

2. 
   
3.   [FONT=courier new]
   
4. 本例创建一个块，然后向块中添加属性。接着将块插入到图形中。然后返回属性数据，并在消息框中显示。块参照中的属性数据将被更新，并再次返回和显示属性数据。
   
5. 
   
6. Sub Ch10_GettingAttributes()
   
7.     ' 创建块
   
8.     Dim blockObj As AcadBlock
   
9.     Dim insertionPnt(0 To 2) As Double
   
10.     insertionPnt(0) = 0
    
11.     insertionPnt(1) = 0
    
12.     insertionPnt(2) = 0
    
13.     Set blockObj = ThisDrawing.Blocks.Add _
    
14.                           (insertionPnt, "TESTBLOCK")
    
15.    
    
16.     ' 定义属性定义
    
17.     Dim attributeObj As AcadAttribute
    
18.     Dim height As Double
    
19.     Dim mode As Long
    
20.     Dim prompt As String
    
21.     Dim insertionPoint(0 To 2) As Double
    
22.     Dim tag As String
    
23.     Dim value As String
    
24.     height = 1#
    
25.     mode = acAttributeModeVerify
    
26.     prompt = "Attribute Prompt"
    
27.     insertionPoint(0) = 5
    
28.     insertionPoint(1) = 5
    
29.     insertionPoint(2) = 0
    
30.     tag = "Attribute Tag"
    
31.     value = "Attribute Value"
    
32.    
    
33.     ' 在块上创建属性定义对象
    
34.     Set attributeObj = blockObj.AddAttribute _
    
35.                         (height, mode, prompt, _
    
36.                         insertionPoint, tag, value)
    
37.    
    
38.    
    
39.     ' 插入块
    
40.     Dim blockRefObj As AcadBlockReference
    
41.     insertionPnt(0) = 2
    
42.     insertionPnt(1) = 2
    
43.     insertionPnt(2) = 0
    
44.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
    
45.                      (insertionPnt, "TESTBLOCK", 1, 1, 1, 0)
    
46.     ZoomAll
    
47.    
    
48.     ' 获取块参照的属性
    
49.     Dim varAttributes As Variant
    
50.     varAttributes = blockRefObj.GetAttributes
    
51.    
    
52.     ' 将属性标记和值移至
    
53.     ' 要在 Msgbox 中显示的字符串中
    
54.     Dim strAttributes As String
    
55.     strAttributes = ""
    
56.     Dim I As Integer
    
57.     For I = LBound(varAttributes) To UBound(varAttributes)
    
58.         strAttributes = strAttributes + "  Tag: " + _
    
59.                     varAttributes(I).TagString + vbCrLf + _
    
60.                     "   Value: " + varAttributes(I).textString
    
61.     Next
    
62.     MsgBox "The attributes for blockReference " + _
    
63.                    blockRefObj.Name & " are: " & vbCrLf _
    
64.                    & strAttributes
    
65.    
    
66.     ' 更改属性值
    
67.     ' 注意：没有 SetAttributes。一旦包含
    
68.     ' 变量数组，就拥有了对象。
    
69.     ' 更改这些对象就会改变图形中的对象。
    
70.     varAttributes(0).textString = "NEW VALUE!"
    
71.    
    
72.     ' 再次获取属性
    
73.     Dim newvarAttributes As Variant
    
74.     newvarAttributes = blockRefObj.GetAttributes
    
75.    
    
76.     ' 再次显示标记和值
    
77.     strAttributes = ""
    
78.     For I = LBound(varAttributes) To UBound(varAttributes)
    
79.         strAttributes = strAttributes + "  Tag: " + _
    
80.                     newvarAttributes(I).TagString + vbCrLf + _
    
81.                     "   Value: " + newvarAttributes(I).textString
    
82.     Next
    
83.     MsgBox "The attributes for blockReference " & _
    
84.                   blockRefObj.Name & " are: " & vbCrLf _
    
85.                   & strAttributes
    
86. End Sub
    
87. 
    
88.   [/FONT]
    

<br />   [FONT=courier new]<br /> 本例创建一个块，然后向块中添加属性。接着将块插入到图形中。然后返回属性数据，并在消息框中显示。块参照中的属性数据将被更新，并再次返回和显示属性数据。 <br /> <br /> Sub Ch10_GettingAttributes()<br />     ' 创建块<br />     Dim blockObj As AcadBlock<br />     Dim insertionPnt(0 To 2) As Double<br />     insertionPnt(0) = 0<br />     insertionPnt(1) = 0<br />     insertionPnt(2) = 0<br />     Set blockObj = ThisDrawing.Blocks.Add _<br />                           (insertionPnt, "TESTBLOCK")<br />     <br />     ' 定义属性定义<br />     Dim attributeObj As AcadAttribute<br />     Dim height As Double<br />     Dim mode As Long<br />     Dim prompt As String<br />     Dim insertionPoint(0 To 2) As Double<br />     Dim tag As String<br />     Dim value As String<br />     height = 1#<br />     mode = acAttributeModeVerify<br />     prompt = "Attribute Prompt"<br />     insertionPoint(0) = 5<br />     insertionPoint(1) = 5<br />     insertionPoint(2) = 0<br />     tag = "Attribute Tag"<br />     value = "Attribute Value"<br />     <br />     ' 在块上创建属性定义对象<br />     Set attributeObj = blockObj.AddAttribute _<br />                         (height, mode, prompt, _<br />                         insertionPoint, tag, value)<br />     <br />    <br />     ' 插入块<br />     Dim blockRefObj As AcadBlockReference<br />     insertionPnt(0) = 2<br />     insertionPnt(1) = 2<br />     insertionPnt(2) = 0<br />     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _<br />                      (insertionPnt, "TESTBLOCK", 1, 1, 1, 0)<br />     ZoomAll<br />     <br />     ' 获取块参照的属性<br />     Dim varAttributes As Variant<br />     varAttributes = blockRefObj.GetAttributes<br />     <br />     ' 将属性标记和值移至<br />     ' 要在 Msgbox 中显示的字符串中<br />     Dim strAttributes As String<br />     strAttributes = ""<br />     Dim I As Integer<br />     For I = LBound(varAttributes) To UBound(varAttributes)<br />         strAttributes = strAttributes + "  Tag: " + _<br />                     varAttributes(I).TagString + vbCrLf + _<br />                     "   Value: " + varAttributes(I).textString<br />     Next<br />     MsgBox "The attributes for blockReference " + _<br />                    blockRefObj.Name & " are: " & vbCrLf _<br />                    & strAttributes<br />     <br />     ' 更改属性值<br />     ' 注意：没有 SetAttributes。一旦包含<br />     ' 变量数组，就拥有了对象。<br />     ' 更改这些对象就会改变图形中的对象。<br />     varAttributes(0).textString = "NEW VALUE!"<br />     <br />     ' 再次获取属性<br />     Dim newvarAttributes As Variant<br />     newvarAttributes = blockRefObj.GetAttributes<br />     <br />     ' 再次显示标记和值<br />     strAttributes = ""<br />     For I = LBound(varAttributes) To UBound(varAttributes)<br />         strAttributes = strAttributes + "  Tag: " + _<br />                     newvarAttributes(I).TagString + vbCrLf + _<br />                     "   Value: " + newvarAttributes(I).textString<br />     Next<br />     MsgBox "The attributes for blockReference " & _<br />                   blockRefObj.Name & " are: " & vbCrLf _<br />                   & strAttributes<br /> End Sub<br /> <br />   [/FONT]<br />

gjliang

我的是先做好一个带有属性的块，然后保存为外部块，用程序调用时启动ate命令对属性块赋值。首先要把系统变量attdia的值改为1
具体：在上面程序内加一句ThisDrawing.SetVariable "attdia", 1在插入属性块时就会显示赋值对话框来重新赋值。