Опять блоки и атрибуты :-(

Хэлп!!!

Эх. Если б мог бы, то переделал бы конечно.

> fixo
Этот код как я поняла находит определенный блок с определенными атрибутами. А если блоков не один, а много???
:)

ПРАВИЛЬНО Я СДЕЛАЛА???
:)
ПРОТЕСТИРОВАТЬ ПОКА НЕ УСПЕЛА
Option Explicit
Const blkName As String = "ДЕТАЛЬ"    ' <-- change block name
Const attName1 As String = "AT1"    ' <-- change attribute tag
Const attName2 As String = "AT2"    ' <-- change attribute tag
Const attValue1 As String = "0.001"    ' <-- change 1st attribute value
Const attValue2 As String = "ABC"    ' <-- change 2nd attribute value
'~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Private Function CountBlocksByAttributes (blkname as string, attName1 as string, _
attName2 as string, attValue1 as string, attValue2 as string)
as integer
Dim (count1 to count150) as INteger
count1 =  CountBlocksByAttributes (blkname, attName1, attName2, attValue1, attValue2)
count2 =  CountBlocksByAttributes (blkname, attName1, attName2, attValue1, attValue2)
и т.д. перечислить все варианты count
    Dim oSset As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim oBlkRef As AcadBlockReference
    Dim oAtt As AcadAttributeReference
    Dim attArr() As AcadAttributeReference
    Dim attVal1 As String
    Dim attVal2 As String
    Dim i As Long
    Dim counter As Integer
    Dim ftype(1) As Integer
    Dim fdata(1) As Variant
    Dim dxfCode, dxfValue
    On Error GoTo Err_Control
    ftype(0) = 0: ftype(1) = 2
    fdata(0) = "INSERT": fdata(1) = blkName
    dxfCode = ftype: dxfValue = fdata
    With ThisDrawing.SelectionSets
        While .Count > 0
            .Item(0).Delete
        Wend
        Set oSset = .Add("$Blocks$")
    End With
    oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
    For Each oEnt In oSset
        Set oBlkRef = oEnt
        attArr = oBlkRef.GetAttributes
        On Error Resume Next
        For i = 0 To UBound(attArr)
            Set oAtt = attArr(i)
            Select Case oAtt.TagString
            Case "AT1"
                attVal1 = oAtt.TextString
            Case "AT2"
                attVal2 = oAtt.TextString
            End Select
        Next i
        If StrComp(attVal1, attValue1, vbTextCompare) = 0 And _
           StrComp(attVal2, attValue2, vbTextCompare) = 0 Then
            counter = counter + 1
        End If
    Next oEnt
    If Err Then
        Err.Clear
    End If
    MsgBox "Всего блоков с такими атрибутами: " & counter
Err_Control:
    If Err.Number <> 0 Then
        MsgBox Err.Description
    End If
End Function