Hi,
Here's what could be your 'Eraser' method. I also made some changes (removed unusefull statements) to the BlockTest one.
It seems to work (VB is not at all my favorite language).
Code:
Private Sub Eraser()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim filter As TypedValue() = {New TypedValue(0, "INSERT"), New TypedValue(2, "Standard,Compact,Handicap,Van")}
Dim psr As PromptSelectionResult = ed.SelectAll(New SelectionFilter(filter))
If psr.Status <> PromptStatus.OK Then
Return
End If
Using doc.LockDocument()
Using tr As Transaction = db.TransactionManager.StartTransaction()
For Each id As ObjectId In psr.Value.GetObjectIds()
Dim br As BlockReference = DirectCast(tr.GetObject(id, OpenMode.ForWrite), BlockReference)
br.[Erase]()
Next
tr.Commit()
End Using
End Using
End Sub
Private Sub BlockTest(blockName As String)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using doc.LockDocument()
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim blockTable As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
If Not blockTable.Has(blockName) Then
ed.WriteMessage(vbLf & "{0} block does not exist, now inserting source file!", blockName)
Dim filename As String = "C:\mkacadd_Hybrid\Civil3D\CAD data\Support\Blocks\StallCount.dwg"
Dim blkId As ObjectId
Using dbdwg As New Database(False, True)
dbdwg.ReadDwgFile(filename, FileShare.Read, True, "")
blkId = db.Insert(Path.GetFileNameWithoutExtension(filename), dbdwg, True)
End Using
' Purge StallCount block
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkId, OpenMode.ForWrite), BlockTableRecord)
btr.[Erase]()
End If
Me.Hide()
Dim id As ObjectId = blockTable(blockName)
Dim modelSpace As BlockTableRecord = _
DirectCast(tr.GetObject(blockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
Dim ppo As New PromptPointOptions(vbLf & "Specify insertion point, (press ESC, SHIFT or ENTER to return): ")
ppo.AllowNone = True
Dim pao As New PromptAngleOptions(vbLf & "Specifiy the rotation: ")
pao.UseBasePoint = True
pao.DefaultValue = 0.0
pao.UseDefaultValue = True
While True
Dim ppr As PromptPointResult = ed.GetPoint(ppo)
If ppr.Status <> PromptStatus.OK Then
Exit While
End If
Dim pts As Point3d = ppr.Value
pao.BasePoint = pts
Dim pdr As PromptDoubleResult = ed.GetAngle(pao)
If pdr.Status = PromptStatus.Cancel Then
Exit While
End If
Dim angle As Double = pdr.Value
Dim br As New BlockReference(pts, id)
br.Rotation = angle
br.TransformBy(ed.CurrentUserCoordinateSystem)
modelSpace.AppendEntity(br)
tr.AddNewlyCreatedDBObject(br, True)
db.TransactionManager.QueueForGraphicsFlush()
End While
tr.Commit()
End Using
End Using
Counter()
Me.Show()
End Sub