SSGET Выбор по фильтру

Option Explicit

Sub SearchBlocks()

Dim bCount As Long
Dim oEnt As AcadEntity
Dim oLayout As AcadLayout
Dim oBlock As AcadBlock
Dim oblkRef As AcadBlockReference
Dim bName As String

bName = InputBox(vbNewLine & "Enter block name to search" _
& vbNewLine & "(case-nonsensitive):", "Block Name")
For Each oLayout In ThisDrawing.Layouts
For Each oEnt In oLayout.Block
If TypeOf oEnt Is AcadBlockReference Then
Set oblkRef = oEnt
If UCase(oblkRef.Name) = UCase(bName) Then
'' do something with this block here
bCount = bCount + 1
End If
End If
Next
Next

If bCount > 0 Then
MsgBox bCount & " blocks " & Chr(34) & bName & Chr(34) & " found"
Else
MsgBox "0 blocks found"
End If
End Sub