в блоке содержится 0 объектов

> Кулик Алексей aka kpblc
я попытался найти разницу между этим блоком и другими. потом вставил блок с таким именем но с масштабом 1-1-1 и при этом программа разаботала. оказалось что у блока был масштаб разный по направлениям.
но даже при этом проблема взрыва его не была решена програмно. если же их всех сделать равными то проблема была решена.
конечно тупо масштабировать блок разными в направлениях.
если была решена проблема со взрывом то как-то можно былобы решить проблему.
надеюсь на Вашу помощь

> Саша
Как вариант
- Записываешь масштабы блока и точку вставки
- Изменяешь масштабы на 1:1:1
- Взрываешь
- Масштабируешь все субпримитивы относительно точки
вставки по сохраненным значениям
~'J'~

УВАЖАЕМЫЕ ГОСПОДА ПРОГРАММИСТЫ!!!!
ПОМОГИТЕ ПОЖАЙЛУСТА ОТРЕДАКТИРОВАТЬ ПРОГРАМНЫЙ КОД!!!!
КОД, КОТОРЫЙ Я НАШЕЛ, ИЩЕТ ТОЛЬКО КОЛИЧЕСТВО БЛОКОВ, А МНЕ ОЧЕНЬ-ОЧЕНЬ НУЖНО ЧТОБЫ ОН ВЫДАВАЛ ИМЕНА НАЙДЕННЫХ БЛОКОВ, А ТАКЖЕ КОЛИЧЕСТВО КАЖДОГО ВИДА.
У МЕНЯ В ЧЕРТЕЖЕ СОТНИ РАЗНЫХ БЛОКОВ С РАЗНЫМИ ИМЕНАМИ И ПРИХОДИТСЯ СЧИТАТЬ ИХ ВРУЧНУЮ. ПОД КОНЕЦ ДНЯ МОЯ ГОЛОВА СТАНОВИТСЯ КВАДРАТНОЙ!!!
НАДЕЮСЬ НА ВАШУ ПОМОЩЬ. ВОТ МОЙ КОД:
Public Function SelectOnlyOnScreen() As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim intType(0) As Integer
Dim varData(0) As Variant
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "Only" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("Only")
intType(0) = 0 'Фильтры выбора
varData(0) = "INSERT" '"INSERT" для выбора блока
objSelSet.SelectOnScreen intType, varData
Set SelectOnlyOnScreen = objSelSet
End Function
Public Sub BlockCount()
Dim acSelSet As AcadSelectionSet
Set acSelSet1 = SelectOnlyOnScreen
MsgBox "Найдено опор: " & CStr(acSelSet.Count) & " шт."
End Sub

Во-первых, "и нечего так орать" (с)
Во-вторых, справка разработчика из-под AutoCAD отлично все описывает.
В-третьих, есть [штатная] команда bcount. Идет вместе с Express Tools (правда, она не обрабатывает динамические блоки).
В-четвертых, код я бы писал на лиспе.
В-пятых, если сильно хочется VBA (также без дин.блоков):

Option Explicit
Option Base 0
Public Type typRes
  sName As String
  lRange As Long
End Type
Public Sub CountBlockWithNames()
Dim oSelSet As AcadSelectionSet, SelSetName As String
Dim fType(0) As Integer, fData(0) As Variant
Dim oAcadEnt As AcadEntity
Dim Result() As typRes, lCounter As Long, AddNew As Boolean
  SelSetName = "bc"
  For Each oSelSet In ThisDrawing.SelectionSets
    If oSelSet.Name = SelSetName Then
      oSelSet.Delete
      Exit For
    End If
  Next oSelSet
  Set oSelSet = ThisDrawing.SelectionSets.Add(SelSetName)
  fType(0) = 0: fData(0) = "INSERT"
  oSelSet.SelectOnScreen fType, fData
  For Each oAcadEnt In oSelSet
    On Error GoTo lErrorReDim
    If UBound(Result) < 0 Then
      ReDim Result(0)
      'On Error GoTo 0
      Result(0).sName = oAcadEnt.Name
      Result(0).lRange = 1
    Else
      AddNew = True
      For lCounter = 0 To UBound(Result)
        If Result(lCounter).sName = oAcadEnt.Name Then
          Result(lCounter).lRange = Result(lCounter).lRange + 1
          AddNew = False
          Exit For
        End If
      Next lCounter
      If AddNew Then
        ReDim Preserve Result(UBound(Result) + 1)
        Result(UBound(Result)).sName = oAcadEnt.Name
        Result(UBound(Result)).lRange = 1
      End If
    End If
  Next oAcadEnt
  oSelSet.Delete
  ' Сервисная часть - показать MsgBox
  Dim MessageString As String
  For lCounter = 0 To UBound(Result)
    If MessageString = "" Then
      MessageString = Result(lCounter).sName & " : " & CStr(Result(lCounter).lRange)
    Else
      MessageString = MessageString & vbCrLf & _
        Result(lCounter).sName & " : " & CStr(Result(lCounter).lRange)
    End If
  Next lCounter
  MsgBox MessageString
  Exit Sub
lErrorReDim:
  ReDim Result(0)
  Err.Clear
  Resume Next
End Sub

ОГРОМНОЕ, ГРОМАДНОЕ, ГИГАНТСКОЕ  СПАСИБО КУЛИК АЛЕКСЕЮ ЗА ЕГО ПОМОЩЬ!!!!
ВЫ ОЧЕНЬ-ОЧЕНЬ МНЕ ПОМОГЛИ!!! НЕ ЗНАЮ ЧТОБЫ Я БЕЗ ВАС ДЕЛАЛ!!!