[编程交流] VBA创建attblocks

Sub Block_edit()
Dim objCount As Integer
Dim mspaceObj As AcadObject
Dim att As AcadAttributeReference
Dim block As AcadBlockReference
Dim i As Integer
objCount = ActiveDocument.ModelSpace.Count
For i = 0 To objCount - 1
   Set mspaceObj = ThisDrawing.ModelSpace.Item(i)
   If mspaceObj.ObjectName = "AcDbBlockReference" Then
       Set block = mspaceObj
       retval = block.GetAttributes()
        For Each c In retval
           Set att = c
           Set new_att = ThisDrawing.ModelSpace.AddAttribute(att.Height, acAttributeModeNormal, "", att.InsertionPoint, att.TagString, att.TextString)
       Next c
   End If
Next
   
End Sub