Refine Block Definition with New Block

[Anonymous]

How do I redefine a block... 

I want to insert the new block definition in the place of the old one and overwrite it. 

The new block has more attributes than the older instance. 

What a good method of going about that? 

[Hallex]

Not sure about if this helps, this one is  similar on your task

   <CommandMethod("BlockReplaceTest", "breplace", CommandFlags.Session Or CommandFlags.Modal Or CommandFlags.UsePickSet Or CommandFlags.Redraw)> _
        Public Sub TestBlockReplaceByName()
            ' objects initializing
            Dim doc As Document = acApp.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim db As Database = doc.Database

            Try

                Using doc.LockDocument()

                    Using tr As Transaction = db.TransactionManager.StartTransaction()

                        Dim psto As New PromptStringOptions(vbLf & "Enter a replacement block name: ")

                        psto.AllowSpaces = True

                        psto.DefaultValue = "MyBlock"  'old block

                        Dim stres As PromptResult

                        stres = ed.GetString(psto)

                        If stres.Status <> PromptStatus.OK Then
                            Return
                        End If

                        Dim oldblock As String = stres.StringResult

                        ed.WriteMessage(vbLf & "Text Entered" & vbTab & "{0}", oldblock)

                        psto = New PromptStringOptions(vbLf & "Enter a block name to be replaced: ")

                        psto.AllowSpaces = True

                        psto.DefaultValue = "NewBlock"    'new block

                        stres = ed.GetString(psto)

                        If stres.Status <> PromptStatus.OK Then

                            Return

                        End If

                        Dim newblock As String = stres.StringResult

                        Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)

                        If Not bt.Has(newblock) Then
                            Return
                        End If

                        Dim newblkId As ObjectId = bt(newblock)

                        acApp.SetSystemVariable("nomutt", 1)

                        Dim tvs As TypedValue() = {New TypedValue(0, "insert"), New TypedValue(2, oldblock)}

                        Dim filt As New SelectionFilter(tvs)

                        Dim pso As New PromptSelectionOptions()

                        pso.MessageForRemoval = "You must select the blocks only"

                        pso.MessageForAdding = vbLf & "Select replacement blocks: "

                        AddHandler ed.SelectionAdded, AddressOf ed_SelectionAdded

                        Dim res As PromptSelectionResult = ed.GetSelection(pso, filt)

                        If res.Status <> PromptStatus.OK Then
                            Return
                        End If

                        Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

                        Dim sset As SelectionSet = res.Value

                        For Each obj As SelectedObject In sset

                            Dim ent As Entity = TryCast(DirectCast(obj.ObjectId.GetObject(OpenMode.ForRead), Entity), Entity)

                            Dim oldblk As BlockReference = TryCast(ent, BlockReference)

                            Dim ip As Point3d = oldblk.Position

                            Dim scl As Scale3d = oldblk.ScaleFactors

                            Dim rot As Double = oldblk.Rotation

                            Dim newblk As New BlockReference(ip, newblkId)

                            newblk.SetPropertiesFrom(ent)

                            newblk.Rotation = rot

                            newblk.ScaleFactors = scl

                            btr.AppendEntity(newblk)

                            tr.AddNewlyCreatedDBObject(newblk, True)

                            ApplyAttributes(db, tr, newblk)

                            oldblk.UpgradeOpen()

                            oldblk.Erase()

                            oldblk.Dispose()

                        Next

                        tr.Commit()

                    End Using

                End Using

            Catch ex As System.Exception

                ed.WriteMessage(ex.Message & vbLf & ex.StackTrace)

            Finally

                acApp.SetSystemVariable("nomutt", 0)

                RemoveHandler ed.SelectionAdded, AddressOf ed_SelectionAdded

            End Try

        End Sub


        Private Sub ed_SelectionAdded(sender As Object, e As SelectionAddedEventArgs)
            ' you may want to add some action here
            DirectCast(sender, Editor).WriteMessage(vbLf & vbTab & "{0} blocks to selection added", e.AddedObjects.Count)
        End Sub


        Public Sub ApplyAttributes(db As Database, tr As Transaction, bref As BlockReference)

            Dim btrec As BlockTableRecord = TryCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

            If btrec.HasAttributeDefinitions Then

                Dim atcoll As Autodesk.AutoCAD.DatabaseServices.AttributeCollection = bref.AttributeCollection

                For Each subid As ObjectId In btrec

                    Dim ent As Entity = DirectCast(subid.GetObject(OpenMode.ForRead), Entity)

                    Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition)

                    If attDef IsNot Nothing Then

                        Dim attRef As New AttributeReference()

                        attRef.SetDatabaseDefaults()
                        'optional
                        attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)

                        attRef.Position = attDef.Position.TransformBy(bref.BlockTransform)

                        attRef.Justify = attDef.Justify
                        'must be added all other properties for right position, eg. alignment modes etc
                        attRef.Tag = attDef.Tag

                        attRef.AdjustAlignment(db)

                        atcoll.AppendAttribute(attRef)

                        tr.AddNewlyCreatedDBObject(attRef, True)

                    End If

                Next

            End If

        End Sub

~'J'~

[Alexander.Rivilis · Accepted solution]

That post and comments can be good start for you: http://adndevblog.typepad.com/autocad/2012/05/redefining-a-block.html

[chiefbraincloud · Accepted solution]

The post link Alexander provided is a good start, but does not address the issue of adding or subtracting attributes.  After using the method Stephen Prestons code, you would also need to open each BlockReference (could be in the same loop where he calls RecordGraphicsModified) and add or remove AttributeReferences from it based on the AttributeDefinitions found in the BlockTableRecord.

[Anonymous]

Thanks Chiefbraincloud, and everyone else... this will definetly get me started in the process. 

Just trying to get an idea of the basic workflow. 

The add attribute reference... okay I remember that. Used that one before somewhere. 

Thanks again!

[Anonymous]

So I'm getting the error eSelfReference....

I already have a different definintion of the block Test in my drawing. 

What I'm wanting to do is overwrite this version in the current drawing with the one c:\temp\test.dwg as my new blockdefinition. 

  <Autodesk.AutoCAD.Runtime.CommandMethod("ReplaceBlock")> _
    Public Sub ReplaceBlock()

        Dim myDwg As Document = Application.DocumentManager.MdiActiveDocument
        Dim myDB As Database = myDwg.Database
        Dim blockName As String = "TEST"

        Editor.WriteMessage("Replacing Block" & Environment.NewLine)

        Dim BlkDB As Database = New Database(False, True)
        BlkDB.ReadDwgFile("C:\\Temp\\TEST.dwg", System.IO.FileShare.Read, True, "")

        Using myTrans As Transaction = myDB.TransactionManager.StartTransaction()

            Dim blockTable As BlockTable = myTrans.GetObject(myDB.BlockTableId, OpenMode.ForRead, False, True)

            Dim myBlockDefId As ObjectId = myDB.Insert(blockName, BlkDB, True)

            If myBlockDefId <> ObjectId.Null Then

                Dim myBlockDef As BlockTableRecord = myTrans.GetObject(myBlockDefId, OpenMode.ForRead, False, True)

                Dim myBlockRefIds As ObjectIdCollection = myBlockDef.GetBlockReferenceIds(False, True)

                For Each id As ObjectId In myBlockRefIds
                    Dim myBlockRef As BlockReference = myTrans.GetObject(id, OpenMode.ForWrite, False, True)
                    myBlockRef.RecordGraphicsModified(True)


                    'Append Attribute References to the BlockReference
                    Dim myAttColl As DatabaseServices.AttributeCollection
                    Dim myEntID As ObjectId
                    Dim myEnt As DatabaseServices.Entity

                    myAttColl = myBlockRef.AttributeCollection
                    For Each myEntID In myBlockDef
                        myEnt = myEntID.GetObject(OpenMode.ForWrite)
                        If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then
                            Dim myAttDef As DatabaseServices.AttributeDefinition = _
                           CType(myEnt, AttributeDefinition)
                            Dim myAttRef As New DatabaseServices.AttributeReference
                            myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
                            myAttColl.AppendAttribute(myAttRef)
                            myTrans.AddNewlyCreatedDBObject(myAttRef, True)
                        End If
                    Next

                Next

            End If

            myTrans.Commit()
        End Using

        BlkDB.Dispose()

    End Sub

[Anonymous]

The other problem is it's Adding Duplicate Attribute Definitions. 

        'Append Attribute References to the BlockReference
                    Dim myAttColl As DatabaseServices.AttributeCollection
                    Dim myEntID As ObjectId
                    Dim myEnt As DatabaseServices.Entity

                    myAttColl = myBlockRef.AttributeCollection
                    For Each myEntID In myBlockDef
                        myEnt = myEntID.GetObject(OpenMode.ForWrite)
                        If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then

                            Dim myAttDef As DatabaseServices.AttributeDefinition = CType(myEnt, AttributeDefinition)
                            Dim myAttRef As New DatabaseServices.AttributeReference

                            myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
                            myAttColl.AppendAttribute(myAttRef)

                            myTrans.AddNewlyCreatedDBObject(myAttRef, True)
                        End 

Hmm... I need to test if the attribute already exists, and either overwrite it, or delete the old one, and re-create it. 

[chiefbraincloud]

I didn't try out your code, and I do see one problem, where you'll need to check if an attribute exists before...

I see you noticed that already. 

I'm guessing that your c:\temp\test.dwg has a block defined in it named test.  That is what I would expect to find if I got an eSelfReference exception.

Open your test.dwg and run the insert command.  See if there is a "test" block in the list, and if so, purge it, and save, then try your code again.

[Anonymous]

Yah. I purged the block out of the drawing. Now that part is working. 

Just trying to figure out the part if an attribute exists already. 

Thanks for the help!