.NET

Reply
Distinguished Contributor
VB_Autocad_guy
Posts: 136
Registered: ‎07-24-2009
Message 1 of 9 (788 Views)
Accepted Solution

Refine Block Definition with New Block

788 Views, 8 Replies
05-14-2012 12:18 PM

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? 

 

 

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

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.

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 9 (774 Views)

Re: Refine Block Definition with New Block

05-14-2012 01:20 PM in reply to: VB_Autocad_guy

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Moderator
Alexander.Rivilis
Posts: 1,450
Registered: ‎04-09-2008
Message 3 of 9 (774 Views)

Re: Refine Block Definition with New Block

05-14-2012 01:22 PM in reply to: VB_Autocad_guy

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


Пожалуйста не забывайте про Утвердить в качестве решения! Утвердить в качестве решения и Give Kudos!Баллы
Please remember to Accept Solution! Accept as Solution and Give Kudos!Kudos

*Expert Elite*
chiefbraincloud
Posts: 753
Registered: ‎02-13-2008
Message 4 of 9 (762 Views)

Re: Refine Block Definition with New Block

05-14-2012 03:06 PM in reply to: VB_Autocad_guy

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.

Dave O.                                                                  Sig-Logos32.png
Distinguished Contributor
VB_Autocad_guy
Posts: 136
Registered: ‎07-24-2009
Message 5 of 9 (757 Views)

Re: Refine Block Definition with New Block

05-14-2012 03:46 PM in reply to: chiefbraincloud

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!

Distinguished Contributor
VB_Autocad_guy
Posts: 136
Registered: ‎07-24-2009
Message 6 of 9 (713 Views)

Re: Refine Block Definition with New Block

05-15-2012 08:39 AM in reply to: VB_Autocad_guy

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

 

Distinguished Contributor
VB_Autocad_guy
Posts: 136
Registered: ‎07-24-2009
Message 7 of 9 (708 Views)

Re: Refine Block Definition with New Block

05-15-2012 08:51 AM in reply to: VB_Autocad_guy

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. 

*Expert Elite*
chiefbraincloud
Posts: 753
Registered: ‎02-13-2008
Message 8 of 9 (705 Views)

Re: Refine Block Definition with New Block

05-15-2012 08:57 AM in reply to: VB_Autocad_guy

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.

Dave O.                                                                  Sig-Logos32.png
Distinguished Contributor
VB_Autocad_guy
Posts: 136
Registered: ‎07-24-2009
Message 9 of 9 (699 Views)

Re: Refine Block Definition with New Block

05-15-2012 10:08 AM in reply to: chiefbraincloud

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!

:smileyhappy:

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.