[VBA程序]：用VBA是否有办法在插入属性块时候，不让使用默认属性值，而提示用户输入？

XDSoft

2. 
   
3. [FONT=courier new]
   
4. VBA block insertion not requesting attributes  
   
5. ID    14792  
   
6. Applies to:    AutoCAD 2000
   
7. AutoCAD 2000I
   
8. AutoCAD 2002
   
9. 
   
10. This document is part of    Attribute   Block Reference   COM-ActiveX Interfaces   VBA     
    
11. 
    
12. 
    
13. Question
    
14. If a block has attribute definitions, AutoCAD inserts all attributes with its
    
15. default values and does not ask for the attribute values. Is there a function
    
16. that asks for the attributes?
    
17. Answer
    
18. There is no ready-to-use function that asks for the attributes. Therefore, you
    
19. will need to write your own function.
    
20. 
    
21. After inserting the attribute you can use the AcadBlockReference.GetAttributes
    
22. method to get all attributes. Then you can iterate the attributes and ask for
    
23. the values. If you want to use the original prompt string, you have to get the
    
24. block definition object and to look for the right attribute in it. There you
    
25. can get the prompt string.
    
26. 
    
27. The following function inserts the block 'test' and iterates the attributes.
    
28. The 'UserForm1' object is a user form which contains:
    
29. 
    
30. - An "OK" button which has to be pressed after entering the value for the current
    
31. attribute and which hides the form
    
32. - Three text boxes:
    
33. TextBox1 : receives the attribute name (locked)
    
34. TextBox2 : receives the attribute prompt string (locked)
    
35. TextBox3 : there you can enter the value of the attribute
    
36. 
    
37. 
    
38. Sub test()
    
39. 
    
40.    Dim insPt As Variant
    
41.    Dim insert As Object
    
42.    Dim attribs As Variant
    
43.    Dim attrib As Object
    
44.    
    
45.    ' Activate AutoCAD
    
46.    AppActivate ThisDrawing.Application.Caption
    
47.    
    
48.    ' Get insertion point for insert entity
    
49.    insPt = ThisDrawing.Utility.GetPoint(, "Select insert point: ")
    
50. 
    
51.    ' Insert it
    
52.    Set insert = ThisDrawing.ModelSpace.InsertBlock(insPt, "TEST", 1#, 1#, 1#, 0#)
    
53.    
    
54.    ' Ask for the attributes
    
55.    attribs = insert.GetAttributes
    
56.    For i = LBound(attribs) To UBound(attribs)
    
57.       Set attrib = attribs(i)
    
58.       UserForm1.TextBox1.Value = attrib.TagString
    
59.       UserForm1.TextBox2.Value = GetPromptString("TEST", attrib)
    
60.       UserForm1.TextBox3.Value = attrib.TextString
    
61.       UserForm1.Show
    
62.       If UserForm1.TextBox3.Value <> "" Then
    
63.          attrib.TextString = UserForm1.TextBox3.Value
    
64.       End If
    
65.    Next i
    
66. 
    
67. End Sub
    
68. 
    
69. The called function 'GetPromptString' finds the original prompt string of the
    
70. attribute:
    
71. 
    
72. 
    
73. Public Function GetPromptString(blockName, attrib) As String
    
74. 
    
75.    '
    
76.    ' This function extracts the prompt string
    
77.    ' of an attribute definition (AcadAttribute).
    
78.    ' The needed parameters are the block name
    
79.    ' and the attribute (AcadAttributeReference).
    
80.    '
    
81. 
    
82.    Dim blocks As Object
    
83.    Dim block As Object
    
84.    Dim count As Integer
    
85.    Dim i As Integer
    
86.    Dim ent As Object
    
87.    
    
88.    ' Get the block definition object of block 'blockName'
    
89.    Set block = ThisDrawing.blocks.Item(blockName)
    
90.    
    
91.    ' Find the attribute (specified by 'attrib')
    
92.    count = block.count
    
93.    For i = 0 To count - 1
    
94.       Set ent = block.Item(i)
    
95.       If ent.EntityType = acAttribute Then
    
96.          If ent.TagString = attrib.TagString Then
    
97.             GetPromptString = ent.PromptString
    
98.             Exit Function
    
99.          End If
    
100.       End If
     
101.    Next i
     
102.    
     
103.    GetPromptString = ""
     
104. 
     
105. End Function
     
106. 
     
107. [/FONT]

<br /> [FONT=courier new]<br /> VBA block insertion not requesting attributes  <br /> ID    14792  <br /> Applies to:    AutoCAD 2000<br /> AutoCAD 2000I<br /> AutoCAD 2002<br /> <br /> This document is part of    Attribute   Block Reference   COM-ActiveX Interfaces   VBA     <br /> <br /> <br /> Question <br /> If a block has attribute definitions, AutoCAD inserts all attributes with its <br /> default values and does not ask for the attribute values. Is there a function <br /> that asks for the attributes?<br /> Answer <br /> There is no ready-to-use function that asks for the attributes. Therefore, you <br /> will need to write your own function.<br /> <br /> After inserting the attribute you can use the AcadBlockReference.GetAttributes <br /> method to get all attributes. Then you can iterate the attributes and ask for <br /> the values. If you want to use the original prompt string, you have to get the <br /> block definition object and to look for the right attribute in it. There you <br /> can get the prompt string.<br /> <br /> The following function inserts the block 'test' and iterates the attributes. <br /> The 'UserForm1' object is a user form which contains:<br /> <br /> - An "OK" button which has to be pressed after entering the value for the current <br /> attribute and which hides the form<br /> - Three text boxes:<br /> TextBox1 : receives the attribute name (locked)<br /> TextBox2 : receives the attribute prompt string (locked)<br /> TextBox3 : there you can enter the value of the attribute<br /> <br /> <br /> Sub test()<br /> <br />    Dim insPt As Variant<br />    Dim insert As Object<br />    Dim attribs As Variant<br />    Dim attrib As Object<br />    <br />    ' Activate AutoCAD<br />    AppActivate ThisDrawing.Application.Caption<br />    <br />    ' Get insertion point for insert entity<br />    insPt = ThisDrawing.Utility.GetPoint(, "Select insert point: ")<br /> <br />    ' Insert it<br />    Set insert = ThisDrawing.ModelSpace.InsertBlock(insPt, "TEST", 1#, 1#, 1#, 0#)<br />    <br />    ' Ask for the attributes<br />    attribs = insert.GetAttributes<br />    For i = LBound(attribs) To UBound(attribs)<br />       Set attrib = attribs(i)<br />       UserForm1.TextBox1.Value = attrib.TagString<br />       UserForm1.TextBox2.Value = GetPromptString("TEST", attrib)<br />       UserForm1.TextBox3.Value = attrib.TextString<br />       UserForm1.Show<br />       If UserForm1.TextBox3.Value <> "" Then<br />          attrib.TextString = UserForm1.TextBox3.Value<br />       End If<br />    Next i<br /> <br /> End Sub<br /> <br /> The called function 'GetPromptString' finds the original prompt string of the<br /> attribute:<br /> <br /> <br /> Public Function GetPromptString(blockName, attrib) As String<br /> <br />    '<br />    ' This function extracts the prompt string<br />    ' of an attribute definition (AcadAttribute).<br />    ' The needed parameters are the block name<br />    ' and the attribute (AcadAttributeReference).<br />    '<br /> <br />    Dim blocks As Object<br />    Dim block As Object<br />    Dim count As Integer<br />    Dim i As Integer<br />    Dim ent As Object<br />    <br />    ' Get the block definition object of block 'blockName'<br />    Set block = ThisDrawing.blocks.Item(blockName)<br />    <br />    ' Find the attribute (specified by 'attrib')<br />    count = block.count<br />    For i = 0 To count - 1<br />       Set ent = block.Item(i)<br />       If ent.EntityType = acAttribute Then<br />          If ent.TagString = attrib.TagString Then<br />             GetPromptString = ent.PromptString<br />             Exit Function<br />          End If<br />       End If<br />    Next i<br />    <br />    GetPromptString = ""<br /> <br /> End Function<br /> <br /> [/FONT]

下面附件是完整的工程代码