大家看看，错在哪里了！？
目的：在选中的块中，再附加一些属性代码如下：
For count = 0 To ThisDrawing.ModelSpace.count - 1
Set tempblock = ThisDrawing.ModelSpace.Item(count)
If tempblock.ObjectName = "AcDbBlockReference" Then
If tempblock.HasAttributes Then
attheight = 1
atttmode = acAttributeModeVerify
attinspoint(0) = 10
attinspoint(1) = 10
attinspoint(2) = 0
Set attobject = tempblock.AddAttribute(attheight, attmode, "图纸名称", attinspoint, "图纸名称", name_text)
attobject.Invisible = True
可是，一运行，就说方法错误或不支持此属性。
麻烦大家给个解决办法！
相关的引用全吗？具体在 工具\引用 里
可能是这一句有问题。If tempblock.ObjectName = "AcDbBlockReference" Then
可能是这一句有问题。If tempblock.ObjectName = "AcDbBlockReference" Then改为
If TypeOf tempblock is AcadBlockReference Then
试一下
Re:大家看看，错在哪里了！？
在块引用（AcDbBlockReference）中不能再添加属性。如果要添加属性的话，应在块（AcDbBlock）中。示例程序如下：
Sub Main()
Dim EntObj As AcadEntity
Dim BlockObj As AcadBlock
Dim iPt(0 To 2) As Double
Dim i As Integer
For i = 0 To ThisDrawing.ModelSpace.Count - 1
Set EntObj = ThisDrawing.ModelSpace(i)
If EntObj.ObjectName = "AcDbBlockReference" Then
Set BlockObj = ThisDrawing.Blocks(EntObj.Name)
iPt(0) = 10: iPt(1) = 10: iPt(2) = 0
BlockObj.AddAttribute 1, acAttributeModeVerify, "图纸名称", iPt, "图纸名称", ""
End If
Next
End Sub
以上程序中没有对重复块引用进行判断，遇到这种情况时应在块中检查属性是否存在，如存在则不添加。最后，在R14或R2000里应对所有块引用重新插入，在R2002中系统可自动更新，这一步不必处理。
页:
[1]