how can I delete a block with vba, help me!

[jeans]

What do I do wrong in the code below:

when running the next error: object is referenced

Please, who can help me....


-------------code---------------

Dim k, btot As Integer
Dim bname As String

btot = ThisDrawing.Blocks.Count
For k = 0 To btot - 1
bname = ThisDrawing.Blocks.Item(k).Name
If bname = "testblock" Then
ThisDrawing.Blocks.Item(k).Delete
End If
Next k

[Murph]

Take a look at this and see if it will help you. It looks like you are trying to delete the block and not each block reference.


Public Function ExplodeEX(oBlkRef As AcadBlockReference)
Dim objEnt As AcadEntity
Dim anEnt As AcadEntity
Dim aBRef As AcadBlockReference
Dim objBlk As AcadBlock
Dim objDoc As AcadDocument
Dim objArray() As AcadEntity
Dim objSpace As AcadBlock
Dim intCnt As Integer
Dim varTemp As Variant
Dim varPnt As Variant
Dim dblScale As Double
Dim dblRot As Double
Dim strBName As String
On Error GoTo Err_Handler
strBName = oBlkRef.Name
'What document is the reference in?
Set objDoc = oBlkRef.Document
'Model space or layout?
Set objSpace = objDoc.ObjectIdToObject(oBlkRef.OwnerID)
Set objBlk = objDoc.Blocks(strBName)
objBlk.Delete
DeleteRefs:
For Each anEnt In ThisDrawing1.ModelSpace
If TypeOf anEnt Is AcadBlockReference Then
Set aBRef = anEnt
If aBRef.Name = strBName Then
aBRef.Delete
End If
End If
Next
For Each anEnt In ThisDrawing1.PaperSpace
If TypeOf anEnt Is AcadBlockReference Then
Set aBRef = anEnt
If aBRef.Name = strBName Then
aBRef.Delete
End If
End If
Next
oBlkRef.Delete
'Release memory
objDoc.PurgeAll
objDoc.PurgeAll
Set objDoc = Nothing
Set objBlk = Nothing
Set objSpace = Nothing
Exit_Here:
Exit Function
Err_Handler:
Select Case Err.Number
Case -2145386476 ' key not found
Resume Exit_Here
Case -2145386420 ' automation error
Resume Exit_Here
Case -2145386239 ' object is referenced
Resume DeleteRefs
Case Else
MsgBox Err.Number & Err.Description, vbOKOnly, "Uh Oh!"
Resume Exit_Here
End Select
End Function

[jeans]

:) Thanks a lot, It works ! :)

learning each time more and more....