.NET

Reply
Contributor
luisibad
Posts: 17
Registered: ‎03-15-2008
Message 1 of 2 (158 Views)

Help to insert block with 3 atrtibutes

158 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

 

AcadBlockRec.AppendEntity(AcadBlockRef)

AcadTransPt.AddNewlyCreatedDBObject(AcadBlockRef,True)

AcadTransPt.Commit()

                   

EndIf

               

EndUsing

 

 

 

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 2 (130 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)
                    bref.AttributeCollection.AppendAttribute(attRef)
                    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)
                            attRef.AdjustAlignment(db)
                        End If
                    End If

                End If
            Next
        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
            Try
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    ' to force update drawing screen
                    doc.TransactionManager.EnableGraphicsFlush(True)
                    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.")
                        Return
                    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
                        Return
                    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))
                    bref.TransformBy(ucs)
                    bref.AddContext(occ.CurrentContext)

                    'add blockreference to current space
                    btr.AppendEntity(bref)
                    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
                    tr.TransactionManager.QueueForGraphicsFlush()
                    tr.Commit()
                End Using
            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(ex.Message)
            Finally
                ' Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Pokey")
            End Try
        End Sub

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.