Posts: 17
Registered: ‎03-15-2008
Message 1 of 2 (162 Views)

Help to insert block with 3 atrtibutes

162 Views, 1 Replies
04-21-2013 03:01 AM

Sorry for my english, I created one code to insert one Block and this block has 3 attributes


Dim AcadDocPt AsDocument = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument


Dim AcadCurrentDBPt AsDatabase = AcadDocPt.Database


'Values Ptx, Pty, Ptz will use to insert block


Dim PtX, PtY, PtZ As Double


'Values NPt, Cota, Descripcion will use to attributes

'Just forget about Valores because will cacth value from .txt


Dim NPt, Cota, Descripcion As String

                NPt = Valores(0)

                PtY = Convert.ToDouble(Valores(1))

                PtX = Convert.ToDouble(Valores(2))

                PtZ = Convert.ToDouble(Valores(3))

                Cota = Valores(3)

                Descripcion = Valores(4)




Using AcadTransPt AsTransaction = AcadCurrentDBPt.TransactionManager.StartTransaction()


Dim BloqueName AsString = txtName.Text() 'Forget this value too, because will cacth value from form 


Dim AcadBlkTblIns AsBlockTable

                    AcadBlkTblIns = AcadTransPt.GetObject(AcadCurrentDBPt.BlockTableId,OpenMode.ForRead)



If AcadBlkTblIns.Has(BloqueName) Then


Dim AcadBlockRec AsBlockTableRecord

AcadBlockRec = AcadTransPt.GetObject(AcadBlkTblIns(BlockTableRecord.ModelSpace),OpenMode.ForWrite)


Dim AcadBlock AsBlockTableRecord

 AcadBlock = AcadTransPt.GetObject(AcadBlkTblIns.Item(BloqueName),OpenMode.ForRead, False)


'In this line I can insert the block using the values: Ptx, Pty and Ptz.... that will be obtain from file .txt........ and it works because I can se the blocks inserted in Autocad....           

Dim AcadBlockRef AsNewBlockReference(NewPoint3d(PtX, PtY, PtZ), AcadBlock.ObjectId)


'I would like to create here code to insert attibutes to the block... because

The block has 3 attributes to use.... help in this part because I just found

out information, but didn't help to my propose. please pay attention the block has 3 attributes and the values for then are: PNt, Cota and Descripcion. again sorry for my english. Thanks












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

Re: Help to insert block with 3 atrtibutes

04-21-2013 08:00 AM in reply to: luisibad

Here is code from my oldies,

change list of tags and values and the block name

to your suit


        Private Shared Sub ApplyAttibutes(ByRef db As Database, ByRef tr As Transaction, ByVal bref As BlockReference, ByVal listTags As List(Of String), ByVal listValues As List(Of String))
            Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

            For Each attId As ObjectId In btr
                Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
                If TypeOf ent Is AttributeDefinition Then
                    Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
                    Dim attRef As New AttributeReference()

                    attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
                    tr.AddNewlyCreatedDBObject(attRef, True)
                    If listTags.Contains(attDef.Tag) Then
                        Dim found As Integer = listTags.BinarySearch(attDef.Tag)
                        If found >= 0 Then
                            attRef.TextString = listValues(found)
                        End If
                    End If

                End If
        End Sub

        <CommandMethod("iab")> _
        Public Shared Sub testAttributedBlockInsert()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            ' change block name to your suit
            Dim blockName As String = "UserName"
            Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem 'get current UCS matrix
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    ' to force update drawing screen
                    Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForWrite), BlockTable)

                    ' if the block table doesn't already exists, exit
                    If Not bt.Has(blockName) Then
                        Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Block " & blockName & " does not exist.")
                    End If

                    ' insert the block in the current space
                    Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Specify insertion point: ")
                    If ppr.Status <> PromptStatus.OK Then
                    End If

                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                    Dim occ As ObjectContextCollection = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES")

                    Dim pt As Point3d = ppr.Value
                    Dim bref As New BlockReference(pt, bt(blockName))

                    'add blockreference to current space
                    tr.AddNewlyCreatedDBObject(bref, True)
                    ' set attributes to desired values
                    ApplyAttibutes(db, tr, bref, New List(Of String)(New String() {"TAG1", "TAG2", "TAG3", "TAG4"}), New List(Of String)(New String() {"Value #1", "Value #2", "Value #3", "Value #4"}))

                    bref.RecordGraphicsModified(True) ' to force updating a block reference
                End Using
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                ' Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Pokey")
            End Try
        End Sub


Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
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.