'这个函数的功能是删除当前图纸空间中没有引用的块
'也就是曾经作过块,但是插入的实体被删除了,所以
'要把这个块删掉,否则下次做块将把以前的实体保留在
'块中
Public Sub DelBlock(ByVal blkName As String)
Dim blkObj As AcadBlock
Dim entobj As AcadBlockReference
Dim foundobj As Boolean
foundobj = False
blkName = Trim(blkName)
For Each blkObj In ThisDrawing.Blocks
If blkObj.ObjectName = "AcDbBlockTableRecord" And blkObj.Name = blkName Then
For Each entobj In ThisDrawing.ModelSpace
If entobj.ObjectName = "AcDbBlockReference" And entobj.Name = blkName Then
foundobj = True
End If
Next
If foundobj = False Then
ThisDrawing.SendCommand "purge" & vbCr & "b" & vbCr & blkName & vbCr & "y" & vbCr & "y" & vbCr
End If
End If
Next
End Sub