Sub getblocks()

Dim objBlockRef As AcadBlockReference
Dim oApp As AcadApplication
Dim ThisDrawing As AcadDocument

On Error Resume Next
'attempt to get last version of AutoCAD opened
Set oApp = GetObject(, "AutoCAD.Application")
If Err Then
MsgBox "Autocad application is not open so can't get blocks"
Err.Clear
Exit Sub

'attempt to create instantiation of last version of AutoCAD opened
Set oApp = CreateObject("AutoCAD.Application")
'no AutoCAD is available
If Err Then
MsgBox "Cannot start AutoCAD ... sorry!", vbExclamation, "Error starting AutoCAD"
End If
End If

oApp.Visible = True

Set ThisDrawing = oApp.ActiveDocument

For Each entity In ThisDrawing.PaperSpace


    If TypeOf entity Is AcadBlockReference Then
    If StrConv(entity.Name, vbUpperCase) = "BLOCKNAME" Then
    Attributes = entity.GetAttributes

    x = x + 1
    For i = LBound(Attributes) To UBound(Attributes)
    
    If Attributes(i).TagString = "ART" Then
	MsgBox Attributes(i).TagString
    End If
    

volgende:



Next entity


End Sub