Hello guys (and girls),
I have a routine to purge a drawing. I'm able to purge layers, blocks, material, dimstyle, linetype, mleaderstyle, mlinestyle, textstyle and table style. But i'm not able to figure out how to purge shape (font). Here an extract of my routine:
Public Enum ItemType As Integer
Block = 0
Layer = 1
Material = 2
Dimstyle = 3
MLeaderstyle = 4
MLine = 5
Shape=6
TableStyle = 7
TextStyle = 8
Linetype = 9
End Enum
Private Function PurgeItem(ByVal ItemType As ItemType, Optional ByVal ItemName As String = "") As Integer
Dim returnCode As Integer = 0
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
'' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Create an ObjectIdCollection to hold the object ids for each table record
Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
'Detect which table to retrieve
Select Case ItemType.ToString
Case "Layer"
'' Open the Layer table for read
Dim acLyrTbl As LayerTable
acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, _
OpenMode.ForRead)
'' Step through each layer and add it to the ObjectIdCollection
For Each acObjId As ObjectId In acLyrTbl
acObjIdColl.Add(acObjId)
Next
Case "Block"
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, _
OpenMode.ForRead)
'' Step through each block and add it to the ObjectIdCollection
For Each acObjId As ObjectId In acBlkTbl
If ItemName = "" Then
acObjIdColl.Add(acObjId)
Else
Dim acblock As BlockTableRecord
acblock = acTrans.GetObject(acObjId, OpenMode.ForRead)
If ItemName.EndsWith("*") Then
Dim strTemp = ItemName.Substring(0, ItemName.IndexOf("*"))
If acblock.Name.StartsWith(strTemp) Then
acObjIdColl.Add(acObjId)
End If
ElseIf acblock.Name.ToUpper.Trim = ItemName.ToUpper.Trim Then
acObjIdColl.Add(acObjId)
End If
End If
Next
Case "Material"
'' Open the Material table for read
Dim acMaterialTbl As DBDictionary
acMaterialTbl = acTrans.GetObject(acCurDb.MaterialDictionaryId, _
OpenMode.ForRead)
'' Step through each material and add it to the ObjectIdCollection
For Each dicID In acMaterialTbl
Dim key As String = dicID.Key
If (key <> "ByBlock") AndAlso (key <> "ByLayer") AndAlso (key <> "Global") Then
acObjIdColl.Add(dicID.Value)
End If
Next
Case "Dimstyle"
'' Open the dimstyle table for read
Dim acDimTbl As DimStyleTable
acDimTbl = acTrans.GetObject(acCurDb.DimStyleTableId, _
OpenMode.ForRead)
'' Step through each dimstyle and add it to the ObjectIdCollection
For Each acObjId As ObjectId In acDimTbl
acObjIdColl.Add(acObjId)
Next
Case "Linetype"
'' Open the Linetype table for read
Dim acLinetype As LinetypeTable
acLinetype = acTrans.GetObject(acCurDb.LinetypeTableId, _
OpenMode.ForRead)
'' Step through each linetype and add it to the ObjectIdCollection
For Each acObjId As ObjectId In acLinetype
acObjIdColl.Add(acObjId)
Next
Case "MLeaderstyle"
'' Open the mleaderstyle table for read
Dim acMLeaderTbl As DBDictionary
acMLeaderTbl = acTrans.GetObject(acCurDb.MLeaderStyleDictionaryId, _
OpenMode.ForRead)
'' Step through each multileaderstyle and add it to the ObjectIdCollection
Dim dicID As DBDictionaryEntry
For Each dicID In acMLeaderTbl
If dicID.Value.IsValid Then
acObjIdColl.Add(dicID.Value)
End If
Next
Case "MLinestyle"
'' Open the mlinestyle table for read
Dim acMLineTbl As DBDictionary
acMLineTbl = acTrans.GetObject(acCurDb.MLeaderStyleDictionaryId, _
OpenMode.ForRead)
'' Step through each mlinestylee and add it to the ObjectIdCollection
Dim dicID As DBDictionaryEntry
For Each dicID In acMLineTbl
If dicID.Value.IsValid Then
acObjIdColl.Add(dicID.Value)
End If
Next
Case "Shape"
'' Open the Shape table for read
Dim acShapeTbl as ??????? or
Dim acShapeTbl As DBDictionary
acShapeTbl = acTrans.GetObject(acCurDb.???????, _
OpenMode.ForRead)
'' Step through eachshape and add it to the ObjectIdCollection
Dim dicID As DBDictionaryEntry
For Each dicID In acShapeTbl
If dicID.Value.IsValid Then
acObjIdColl.Add(dicID.Value)
End If
Next
Case "Textstyle"
'' Open the Textstyle table for read
Dim acTextTbl As TextStyleTable
acTextTbl = acTrans.GetObject(acCurDb.TextStyleTableId, _
OpenMode.ForRead)
'' Step through each textstyle and add it to the ObjectIdCollection
For Each acObjId As ObjectId In acTextTbl
acObjIdColl.Add(acObjId)
Next
Case "Tablestyle"
'' Open the Layer table for read
Dim acTableTbl As DBDictionary
acTableTbl = acTrans.GetObject(acCurDb.TableStyleDictionaryId, _
OpenMode.ForRead)
'' Step through each multileaderstyle and add it to the ObjectIdCollection
Dim dicID As DBDictionaryEntry
For Each dicID In acTableTbl
If dicID.Value.IsValid Then
acObjIdColl.Add(dicID.Value)
End If
Next
End Select
'' Remove the layers (or other object) that are in use and return the ones that can be erased
acCurDb.Purge(acObjIdColl)
'' Step through the returned ObjectIdCollection
For Each acObjId As ObjectId In acObjIdColl
Using locked As Autodesk.AutoCAD.ApplicationServices.DocumentLock = acDoc.LockDocument()
Dim obj As DBObject = acTrans.GetObject(acObjId, OpenMode.ForWrite)
'Dim acSymTblRec As SymbolTableRecord
'acSymTblRec = acTrans.GetObject(acObjId, _
' OpenMode.ForWrite)
Try
'' Erase the unreferenced layer
obj.Erase(True)
'acSymTblRec.Erase(True)
returnCode = returnCode + 1
Catch Ex As Autodesk.AutoCAD.Runtime.Exception
'' Layer (or other object) could not be deleted
Application.ShowAlertDialog("Error:" & vbLf & Ex.Message)
End Try
End Using
Next
'' Commit the changes and dispose of the transaction
acTrans.Commit()
End Using
Return returnCode
end function
In the shape Section I don't know which table or dictionary to use???
Anyone have an idea???
Regards,
André
