AutoCAD vba "key not found" error

[muck]

What does "key not found" mean in AutoCAD 2009 VBA. How do I begin to look

for this error.

Thank you,

[SEANT]

That’s typically shown when a routine tries to reference a named object that is not in the pertinent collection. For example, setting an object to a non-existent layer, or trying to insert a block reference with a name that isn’t part of the block table record.

[muck]

Here is my Code"

Please help if you see the problem.

 

 

Public Sub BlkDefAttLayerChg()

Dim objAttribs As Collection

Dim objAttrib As AcadAttribute

Dim objBlock As AcadBlock

Dim strAttribs As String

'' get the block

For Each objBlock In ThisDrawing.Blocks

'strBlockList = strBlockList & vbCr & objBlock.Name

'Next

 

Set objBlock = ThisDrawing.Blocks.Item(objBlock.Name)

'' get the attributes

Set objAttribs = GetAttributes(objBlock)

'' show some information about each

For Each objAttrib In objAttribs

'strAttribs = objAttrib.TagString & vbCrLf

'strAttribs = strAttribs & "Tag: " & objAttrib.TagString & vbCrLf & _

'"Prompt: " & objAttrib.PromptString & vbCrLf & " Value: " & _

'objAttrib.TextString & vbCrLf & " Mode: " & _

'objAttrib.Mode

'Private m_AttLayerNameOld As String

'Private m_AttLayerNameNew As String

 

 

'If objAttrib.Layer m_AttLayerNameNew Then

objAttrib.Layer = m_AttLayerNameNew ' Assign new layer name

'Else

'GoTo NextItem

'End If

strattribsl = objAttrib.Layer

'MsgBox strAttribs

'MsgBox strattribsl

'NextItem:

Next

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

'coll.Add objAttribute

End If

Next

'return collection

Set GetAttributes = coll

End Function

[SEANT]

I made a couple changes to see if it would help matters.

 

There were a couple of things that suggested that the posted code relied on code not posted. For instance, the layer name referenced with m_AttLayerNameNew was never set. In the code I posted I set it to a test layer that I made sure was available in the drawing.

 

Another change I made was to prevent the routine from running the GetAttributes() function with the standard AutoCAD blocks Modes_Space and Paper_Space.

 

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