[编程交流] AutoCAD vba“找不到键”er

Public Sub BlkDefAttLayerChg()
Dim objAttribs As Collection
Dim objAttrib As AcadAttribute
Dim objBlock As AcadBlock
Dim strAttribs As String
Dim m_AttLayerNameNew As String
Dim strattribsl As String
'' get the block
  For Each objBlock In ThisDrawing.Blocks
     
     
     'Set objBlock = ThisDrawing.Blocks.Item(objBlock.Name) ''''not needed
     If InStr(objBlock.Name, "_Space") = 0 Then 'Don't process Model and Paper space blocks
        Set objAttribs = GetAttributes(objBlock)
        '' show some information about each
        For Each objAttrib In objAttribs
        
           'm_AttLayerNameNew = "TestLayer" ''''used for testing.  Layer must be present
     
           objAttrib.Layer = m_AttLayerNameNew ' Assign new layer name
           strattribsl = objAttrib.Layer 'is this needed if it's already set in m_AttLayerNameNew
        Next
     End If
  Next
End Sub
Function GetAttributes(objBlock As AcadBlock) As Collection
On Error Resume Next
Dim objEnt1 As AcadEntity
Dim objAttribute As AcadAttribute
Dim coll As New Collection
'' iterate the block
For Each objEnt1 In objBlock
'' if it's an attribute
If objEnt1.ObjectName = "AcDbAttributeDefinition" Then
'' cast to an attribute
Set objAttribute = objEnt1
'' add attribute to the collection
coll.Add objAttribute, objAttribute.TagString '***This causes the error
End If
Next
'return collection
Set GetAttributes = coll
End Function