• bob
  • Восстановленный участник
  • На форуме с 8 сентября 2003г.
  • Сообщений: 9
  • Спасибо: 0

Тема: Ошибка: "Cannot be erased by caller"

Dim Blk As AcadBlock
For Each Blk In OldDoc.Blocks
    Blk.Delete
Next Blk
Мне надо убить все блоки.
В рантайме ошибка при попытке удалить блок : "Cannot be erased by caller" Невозномно удалить вызавателем? :)

  • bender
  • Восстановленный участник
  • На форуме с 5 мая 2003г.
  • Сообщений: 345
  • Спасибо: 0

Re: Ошибка: "Cannot be erased by caller"

Задача, если я правильно понял, сводится к очистке базы чертежа от всех блоков. Ошибка выдается, скорее всего, из-за того, что в чертеже (именно в чертеже, т. е. в пр-ве модели и во всех листах) остался какой-то блок. При попытке удалить его из таблицы описания блоков и выдается ошибка. Сл-но, Вам сначала надо найти все такие блоки и, или удалить их, или развалить. При этом следует помнить о:
1. внешних ссылках;
2. об уровне вложенности (коих может быть очень и очень много).
И, если первая задача достаточно простая, то вторая совсем даже не тривиальная.
Как и все в АКАДе это можно сделать десятком разных способов. Например: через Quick Select выделять блоки, взрывать их и повторять эту операцию до тех пор, пока блоков не останется. Перед этим все внешние ссылки надо перевести в блоки (Insert-Xref Manager-Bind). После чего - purge. Если програмно, то будет это выглядеть приблизительно так, как описано ниже. В данном примере "чистится" активный чертеж.

Option Explicit
Option Compare Text
Option Base 0
Sub deleteBlocks()
Dim blockObj As AcadBlock
Dim blockRefObj As AcadBlockReference
Dim entObj As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim explodeObj As Variant
Dim varData(0) As Variant
Dim intType(0) As Integer
Dim i As Long
Dim control As Boolean
On Error GoTo Exit_Here
ThisDrawing.ActiveSpace = acModelSpace
For Each blockObj In ThisDrawing.Blocks
    If blockObj.IsXRef Then
        ThisDrawing.Blocks.Item(blockObj.Name).Bind False
    End If
Next
intType(0) = 0
varData(0) = "INSERT"
For Each objSelSet In ThisDrawing.SelectionSets
    If objSelSet.Name = "Temporary" Then
        ThisDrawing.SelectionSets.Item("Temporary").Delete
        Exit For
    End If
Next
labelSelSet:
Set objSelSet = ThisDrawing.SelectionSets.Add("Temporary")
objSelSet.Select acSelectionSetAll, filtertype:=intType, filterdata:=varData
If objSelSet.Count > 0 Then
    GoTo controlLabel
Else
    GoTo deleteLabel
End If
controlLabel:
GoSub delBlockObj
GoTo labelSelSet
delBlockObj:
For Each blockRefObj In objSelSet
    blockRefObj.Explode
    'если надо удалить примитивы, входящие в блок, то
    'explodeObj = blockRefObj.Explode
    'For i = LBound(explodeObj, 1) To UBound(explodeObj, 1)
    '    explodeObj(i).Delete
    'Next
    blockRefObj.Delete
Next
ThisDrawing.SelectionSets.Item("Temporary").Delete
Return
deleteLabel:
On Error Resume Next
For Each blockObj In ThisDrawing.Blocks
    If blockObj.IsLayout = False Then
        control = blockObj.IsLayout
        For Each entObj In blockObj
            If entObj.ObjectName = "AcDbBlockReference" Then
                control = controlInBlock(ThisDrawing.Blocks.Item(entObj.Name))
                If control = False Then
                    entObj.Delete
                Else
                    Exit For
                End If
            End If
        Next
    Else
        control = True
    End If
    If control = False Then
        blockObj.Delete
    End If
Next
If control = False Then
    GoTo deleteLabel
Else
    GoTo Exit_Here
End If
'если не жалко другого "мусора", как то слои, размерные и текстовые стили и т. п., то все, начиная от метки deleteLabel,
'можно заменить на
'ThisDrawing.PurgeAll
'или, если жалко, то
'ThisDrawing.SendCommand "_-PURGE" & vbCr & "B" & vbCr & "*" & vbCr & "N" & vbCr
GoTo Exit_Here
Exit_Here:
ThisDrawing.Regen acAllViewports
Set blockObj = Nothing
Set blockRefObj = Nothing
Set objSelSet = Nothing
Set explodeObj = Nothing
End Sub
Public Function controlInBlock(ByVal blockObj As AcadBlock) As Boolean
Dim entObj As AcadEntity
Dim blockObjL2 As AcadBlock
controlInBlock = False
For Each entObj In blockObj
    If entObj.ObjectName = "AcDbBlockReference" Then
        For Each blockObjL2 In ThisDrawing.Blocks
            If blockObjL2.Name = entObj.Name Then
                controlInBlock = True
                Exit For
            End If
        Next
    End If
    If controlInBlock = True Then
        GoTo Exit_Here
        Exit For
    End If
Next
Exit_Here:
Set entObj = Nothing
Set blockObjL2 = Nothing
End Function