TheSwamp

Code Red => .NET => Topic started by: slappy on June 07, 2010, 10:39:31 AM

Title: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 07, 2010, 10:39:31 AM
Essentially I am attempting to completely purge all items from a DWG 2010 file.  I've had a lot of success using the following code for blocks, registered apps, layers, etc.

Code: [Select]
Dim rat As RegAppTable = DirectCast(tr.GetObject(db.RegAppTableId, OpenMode.ForRead), RegAppTable)
Dim ltt As LinetypeTable = DirectCast(tr.GetObject(db.LinetypeTableId, OpenMode.ForRead), LinetypeTable)
Dim blt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim lat As LayerTable = DirectCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
Dim dst As DimStyleTable = DirectCast(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
Dim tst As TextStyleTable = DirectCast(tr.GetObject(db.TextStyleTableId, OpenMode.ForRead), TextStyleTable)

However, table styles, Material, and Multi-leaders seem more elusive.  I assume because they are associated to Dictionaries vs, record tables.

Any thoughts?  All comments are appreciated.

Sorry for the formating, for some reason this forums posing editor doesn't like to work with me. :realmad:

Thanks

Chris
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: gile on June 07, 2010, 11:22:36 AM
Hi,

You can have a look here (http://www.theswamp.org/index.php?topic=33516.0) and there (http://www.theswamp.org/index.php?topic=25880.0).
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 08, 2010, 12:13:21 PM
You can have a look here (http://www.theswamp.org/index.php?topic=33516.0) and there (http://www.theswamp.org/index.php?topic=25880.0).

I like the idea of using ObjectIdGraph but I can't find any documentation of context.  Being new to all of this.  Can someone offer up some general idea on how to use this method.

Thanks

Chris
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 09, 2010, 01:42:29 PM
OK, merging the ideas of gile, Chuck G. and Kean Walmsley I've come up with this:

Code: [Select]
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports System.IO

Namespace Purger
    Public Class PurgeFiles
        Public Sub PurgeDatabase(ByVal db As Database)
            'Dim idCount As Integer = 0
            Dim tr As Transaction = db.TransactionManager.StartTransaction()
            Using tr
                Dim locked As New List(Of LayerTableRecord)()
                Dim lt As LayerTable = DirectCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
                For Each layerId As ObjectId In lt
                    Dim ltr As LayerTableRecord = DirectCast(tr.GetObject(layerId, OpenMode.ForRead), LayerTableRecord)
                    If ltr.IsLocked = True Then
                        ltr.UpgradeOpen()
                        ltr.IsLocked = False
                        locked.Add(ltr)
                    End If
                Next
                Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                For Each btrId As ObjectId In bt
                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(btrId, OpenMode.ForRead), BlockTableRecord)
                    If Not btr.IsLayout Then
                        Continue For
                    End If
                    For Each id As ObjectId In btr
                        Dim crv As Curve = TryCast(tr.GetObject(id, OpenMode.ForRead), Curve)
                        If crv IsNot Nothing Then
                            If crv.GetDistanceAtParameter(crv.EndParam) = 0.0 Then
                                crv.UpgradeOpen()
                                crv.[Erase]()
                            End If
                            Continue For
                        End If
                        Dim txt As DBText = TryCast(tr.GetObject(id, OpenMode.ForRead), DBText)
                        If txt IsNot Nothing Then
                            If txt.TextString.Trim() = String.Empty Then
                                txt.UpgradeOpen()
                                txt.[Erase]()
                            End If
                            Continue For
                        End If
                        Dim mTxt As MText = TryCast(tr.GetObject(id, OpenMode.ForRead), MText)
                        If mTxt IsNot Nothing AndAlso GetTextString(mTxt).Trim() = String.Empty Then
                            mTxt.UpgradeOpen()
                            mTxt.[Erase]()
                        End If
                    Next
                Next
                For Each ltr As LayerTableRecord In locked
                    ltr.IsLocked = True
                Next
                ' Create the list of objects to "purge"
                Dim idsToPurge As New ObjectIdCollection()
                ' Add all the Registered Application names
                Dim rat As RegAppTable = DirectCast(tr.GetObject(db.RegAppTableId, OpenMode.ForRead), RegAppTable)
                Dim ltt As LinetypeTable = DirectCast(tr.GetObject(db.LinetypeTableId, OpenMode.ForRead), LinetypeTable)
                Dim blt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim lat As LayerTable = DirectCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
                Dim dst As DimStyleTable = DirectCast(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
                Dim tst As TextStyleTable = DirectCast(tr.GetObject(db.TextStyleTableId, OpenMode.ForRead), TextStyleTable)
                Dim mat As DBDictionary = DirectCast(tr.GetObject(db.MaterialDictionaryId, OpenMode.ForRead), DBDictionary)
                Dim mlst As DBDictionary = DirectCast(tr.GetObject(db.MLeaderStyleDictionaryId, OpenMode.ForRead), DBDictionary)
                Dim mlnt As DBDictionary = DirectCast(tr.GetObject(db.MLStyleDictionaryId, OpenMode.ForRead), DBDictionary)
                Dim tabt As DBDictionary = DirectCast(tr.GetObject(db.TableStyleDictionaryId, OpenMode.ForRead), DBDictionary)
                Dim dicID As DBDictionaryEntry
                Dim OId As ObjectId
                For Each OId In rat
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each OId In ltt
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each OId In blt
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each OId In lat
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each OId In dst
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each OId In tst
                    If OId.IsValid Then
                        idsToPurge.Add(OId)
                    End If
                Next
                For Each dicID In mat
                    Dim key As String = dicID.Key
                    If (key <> "ByBlock") AndAlso (key <> "ByLayer") AndAlso (key <> "Global") Then
                        idsToPurge.Add(dicID.Value)
                    End If
                Next
                For Each dicID In mlst
                    If dicID.Value.IsValid Then
                        idsToPurge.Add(dicID.Value)
                    End If
                Next
                For Each dicID In mlnt
                    If dicID.Value.IsValid Then
                        idsToPurge.Add(dicID.Value)
                    End If
                Next
                For Each dicID In tabt
                    If dicID.Value.IsValid Then
                        idsToPurge.Add(dicID.Value)
                    End If
                Next
                ' Call the Purge function to filter the list
                db.Purge(idsToPurge)
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument
                Dim ed As Editor = doc.Editor
                ' Erase each of the objects we've been
                ' allowed to
                Dim errorobj As String = "Nothing"
                Try
                    For Each id As ObjectId In idsToPurge
                        Dim obj As DBObject = tr.GetObject(id, OpenMode.ForWrite)
                        errorobj = obj.ToString
                        obj.Erase()
                    Next
                Catch ex As Exception
                    MsgBox(errorobj.ToString, MsgBoxStyle.Critical)

                End Try

                tr.Commit()
            End Using
            'Return idCount
        End Sub
        Private Function GetTextString(ByVal mtxt As MText) As String
            Dim result As String = mtxt.Contents
            While result.Contains(MText.BlockBegin)
                result = result.Substring(0, result.IndexOf(MText.BlockBegin)) & result.Substring(result.IndexOf(MText.BlockEnd) + 1)
            End While
            Return result
        End Function
        'Public Sub RunAudit(ByVal db As Database)
        '    Dim tr As Transaction = db.TransactionManager.StartTransaction()
        '    Using tr
        '        Dim DBobjectList As AuditInfo
        '        DBobjectList.

        '        For Each dbObj As Object In DBobjectList

        '            db.Audit(dbObj)
        '        Next
        '    End Using
        '    tr.Commit()
        'End Sub
    End Class

End Namespace

So far it mostly works. Two things:

First it doesn't purge the Registered Apps like is should.  Even though stepping through the process it acts like it does.
Second I had to ignore the Material "GLOBAL" because it errors that it can't be erased. Even though it can be purged using the purge command.

Please comment on my grossly bad coding and thoughts on where to go from here.

Thanks
Chris
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 18, 2010, 10:00:22 AM
No comments?  Anyone...? Hello?!?

Chris
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 18, 2010, 04:08:32 PM
Well I found the solution, if anyone is interested... :pissed:

I was accessing the Application.DocumentManager.Mdiactivedocument.Database when I should have been accessing the HostApplicationServices.WorkingDatabase from DatabaseServices.

This slight modification allowed for purging of Registered applications.  Which intern removed my Global Materials problem as well.

Ha, all that on my own....   :-P
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: Kerry on June 18, 2010, 06:22:19 PM
Well I found the solution, if anyone is interested... :pissed:

< .. >
Ha, all that on my own....   :-P

good !!  so I don't need to feel guilty about sleeping :-D
Title: Re: Purge Table, Multileader, and Material styles in VB.NET
Post by: slappy on June 21, 2010, 02:23:26 PM
.. sleeping
We'll have none of that. :police:

Chris