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?
Solved! Go to Solution.
Solved by chiefbraincloud. Go to Solution.
Solved by Alexander.Rivilis. Go to Solution.
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'~
That post and comments can be good start for you: http://adndevblog.typepad.com/autocad/2012/05/redefining-a-block.html
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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.
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!
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
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.
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.
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!
Can't find what you're looking for? Ask the community or share your knowledge.