Not able to copy attributes of one block to other using vb.net code

[AbhilashDK2014]

Hi All,

 

I am a complete newbie for AutoCad and AutoCad.NET. I am stuck with a problem. I am asking the user to select a block reference which has three attribures namely LINEUP, BAY and HL. Then I am trying to create a copy of it. But the attributes LINEUP and BAY (Values of these) are not being copied. Can You please help me out with this issue.

 

Original Block With Attributes : See Image OriginalBlockWithAttributes.png

New Block Without Values of the Attributes : See Image NewBlockWithoutAttributes.png

 

Here is the VB.NET Code :

 

<CommandMethod("WithAttr2")> _
       Public Sub WithAttr2()
           Dim doc As Document = Application.DocumentManager.MdiActiveDocument
           Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
           Dim database As Database = ed.Document.Database
           Dim blockName As String
           Dim blockRef1 As BlockReference
           Dim options As PromptEntityOptions = New PromptEntityOptions("\nSelect block reference")
           options.SetRejectMessage("\nSelect only block reference")
           options.AddAllowedClass(GetType(BlockReference), False)

           Dim acSSPrompt As PromptEntityResult = ed.GetEntity(options)

           Using tx As Transaction = database.TransactionManager.StartTransaction()

               Dim blockRef As BlockReference = TryCast(tx.GetObject(acSSPrompt.ObjectId, OpenMode.ForRead), BlockReference)

               Dim block As BlockTableRecord = Nothing
               If (blockRef.IsDynamicBlock) Then

                   'get the real dynamic block name.
                   block = TryCast(tx.GetObject(blockRef.DynamicBlockTableRecord, OpenMode.ForRead), BlockTableRecord)

               Else

                   block = TryCast(tx.GetObject(blockRef.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)
               End If


               If (block <> Nothing) Then
                   Dim sfilter As New SelectionFilter(New TypedValue() {New TypedValue(CInt(DxfCode.Start), "INSERT"), New TypedValue(2, block.Name)})
                   Dim res As PromptSelectionResult = ed.SelectAll(sfilter)
                   If res.Status = PromptStatus.OK Then
                       'display result
                       MsgBox("--->  Selected " & res.Value.Count & " objects", res.Value.Count)
                       Dim Objectset As SelectionSet = res.Value
                       For Each id As ObjectId In Objectset.GetObjectIds()
                           blockRef1 = TryCast(tx.GetObject(id, OpenMode.ForRead), BlockReference)
                           MsgBox(blockRef1.Name)
                           blockName = blockRef1.Name
                           'Dim pt As New Point3d(0, 0, 0)
                           'ACADBlockMgr.InsertBlockWithAtt(blockRef1.Name, pt)
                       Next
                   End If
               End If
               tx.Commit()
           End Using
           Using trans As Transaction = database.TransactionManager.StartTransaction

               Dim blkTable As BlockTable = TryCast(database.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
               Dim blkRecId As ObjectId = blkTable(blockName)
               MsgBox(blkRecId.ToString())
               If blkRecId <> ObjectId.Null Then
                   Dim blkTableRecord As BlockTableRecord = trans.GetObject(blkRecId, OpenMode.ForRead)
                   Using acBlkRef As New BlockReference(New Point3d(2, 2, 0), blkTableRecord.Id)
                       Dim currentSpaceBlkTableRec As BlockTableRecord = trans.GetObject(database.CurrentSpaceId, OpenMode.ForWrite)
                       currentSpaceBlkTableRec.AppendEntity(acBlkRef)
                       trans.AddNewlyCreatedDBObject(acBlkRef, True)
                       'Check For Attributes
                       If blkTableRecord.HasAttributeDefinitions Then
                           'Add attributes from Block Table Records
                           For Each objId As ObjectId In blkTableRecord
                               Dim dbObj As DBObject = trans.GetObject(objId, OpenMode.ForRead)
                               If TypeOf dbObj Is AttributeDefinition Then
                                   Dim attrDef As AttributeDefinition = dbObj
                                   MsgBox(attrDef.Tag & " " & attrDef.TextString)
                                   If Not attrDef.Constant Then
                                       Using attRef As New AttributeReference
                                           attRef.SetAttributeFromBlock(attrDef, acBlkRef.BlockTransform)
                                           attRef.Position = attRef.Position.TransformBy(acBlkRef.BlockTransform)
                                           attRef.TextString = attrDef.TextString
                                           acBlkRef.AttributeCollection.AppendAttribute(attRef)
                                           trans.AddNewlyCreatedDBObject(attRef, True)
                                       End Using
                                   End If
                               End If
                           Next
                       End If
                   End Using
               End If
               trans.Commit()
           End Using
       End Sub

 

What am I doing wrong here. Please let me know.

 

Thanks in Advance,

Abhilash D K