Help! with this code to insert one block with 3 attributes...

Anonymous · ‎04-24-2013

Hello! I need some help

I have this one file .txt with this features:

Point North East Z Description

1 8618063,68 312415,09 75,87 T1

2 8618138,38 312428,89 70,57 B_RIO SECO

3 8618132,23 312427,75 71,90 ARENAL

4 8618126,23 312426,64 72,50 ARENAL

5 8618112,22 312424,06 73,77 ARENAL

6 8618099,78 312421,76 75,35 ARENAL

7 8618089,51 312419,86 75,84 ARENAL

8 8618132,23 312427,75 71,94 J

9 8618112,23 312424,06 73,88 J

10 8618099,82 312421,78 75,36 ARENAL

11 8618089,48 312419,87 75,85 E_1

And I generated this code for read this file and insert one block with attributes for each line of text…..

If txtPath.Text() = "" Then

MsgBox("Select DB .txt.", MsgBoxStyle.Exclamation)

End If

On Error GoTo ControlErroresBD

Dim AcadDocPt As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

Dim AcadCurrentDBPt As Database = AcadDocPt.Database

Dim AcadEdPt As Editor = AcadDocPt.Editor

Dim FileBD As String = txtPath.Text()

Dim Ext As String

Ext = Path.GetExtension(FileBD)

If (Not IO.File.Exists(FileBD)) Then

MsgBox("The DB doesn’t exist", MsgBoxStyle.Critical)

Return

Using Reader As New IO.StreamReader(FileBD)

While Not Reader.EndOfStream

Dim Fila As String = Reader.ReadLine()

Dim Valores As String() = Fila.Split(New String() {}, StringSplitOptions.RemoveEmptyEntries)

Dim PtX, PtY, PtZ As Double

Dim NPt, Cota, Descripcion As String

NPt = Valores(0)

PtY = Valores(1)

PtX = Valores(2)

PtZ = Valores(3)

Cota = Valores(3

Descripcion = Valores(4)

Using AcadTransPt As Transaction = AcadCurrentDBPt.TransactionManager.StartTransaction()

Dim BloqueName As String = txtName.Text()

Dim AcadBlkTblIns As BlockTable

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

If AcadBlkTblIns.Has(BloqueName) Then

Dim AcadBlockRec As BlockTableRecord = AcadTransPt.GetObject(AcadBlkTblIns(BlockTableRecord.ModelSpace),

OpenMode.ForWrite)

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

Dim AcadBlock As BlockTableRecord

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

Dim AcadBlockRef As New BlockReference(New Point3d(PtX, PtY, PtZ), AcadBlock.ObjectId)

‘To the end of this line I can insert the block,,,,,,, but I don’t know how to write the attributes…… I tried with the next code but it doesn’t work…. Some help! My bloque has 3 attributes and every tag named with “PN”, “CD” and “CT”

Dim AcadObj As Entity

For Each acObjId As ObjectId In AcadBlockRef.AttributeCollection

AcadObj = AcadTransPt.GetObject(acObjId, OpenMode.ForWrite)

Dim acAttDef As AttributeDefinition = TryCast(AcadObj, AttributeDefinition)

Dim acAttRef As AttributeReference = New AttributeReference

acAttRef.SetAttributeFromBlock(acAttDef, AcadBlockRef.BlockTransform)

acAttDef.Tag = "PN"

acAttDef.TextString = NPt

acAttRef.TextString = acAttDef.TextString

acAttDef.Tag = "CD"

acAttDef.TextString = Descripcion

acAttRef.TextString = acAttDef.TextString

acAttDef.Tag = "CT"

acAttDef.TextString = Cota

acAttRef.TextString = acAttDef.TextString

AcadTransPt.AddNewlyCreatedDBObject(AcadBlockRef, True)

AcadTransPt.Commit()

End If

End Using

End While

End Using

ControlErroresBD:

MsgBox(Err.Number & vbNewLine & Err.Description, MsgBoxStyle.Critical)

End Sub

Hallex · ‎04-25-2013

You've ignored my previous answer on your question,
so I would not to help more

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎04-25-2013

Sorry! I had it like spam, your answer.... and it was for that reason that I post it again... sorry for my english!

Hallex · ‎04-26-2013

Okay, then try this code, change block name etc:

    Public Shared Function ReadCSV(filename As String, sep As String) As List(Of String())
        Dim listData As New List(Of String())
        Dim line As String() = New String() {}
        Using parser As New Microsoft.VisualBasic.FileIO.TextFieldParser(filename)
            parser.SetDelimiters(sep)
            While Not parser.EndOfData
                line = parser.ReadFields()
                listData.Add(line)
            End While
        End Using
        Return listData
    End Function

    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

    Public Shared Sub testAttributedBlocksInsert(ByRef lst As List(Of String()))
        If lst Is Nothing Then Return
        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 = "MY_BLOCK" ' <--- blockname
        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
                Dim PtX As Double
                Dim PtY As Double
                Dim PtZ As Double
                Dim NPt As String
                Dim Cota As String
                Dim Descripcion As String
                For i As Integer = 0 To lst.Count - 1
                    'Dim blkData() As String = New String() {}
                    'blkData = lst(i)
                    Dim blkData() As String = lst(i)
                    'For Each blkData As String() In lst
                    NPt = String.Empty
                    Cota = String.Empty
                    Descripcion = String.Empty
                    PtX = New Double
                    PtY = New Double
                    PtZ = New Double

                    NPt = blkData(0).ToString()
                    'ed.WriteMessage(vbLf + "NPT: " + vbTab + "{0}" + vbLf, NPt)
                    Double.TryParse(blkData(1), PtY)
                    Double.TryParse(blkData(2), PtX)
                    Double.TryParse(blkData(3), PtZ)
                    Cota = blkData(3).ToString()
                    Descripcion = blkData(4).ToString()

                    '  Dim lstAtt As List(Of String) = New List(Of String)(New String() {NPt, Descripcion, Cota})
                    ''      Or
                    Dim lstAtt As List(Of String) = {NPt, Descripcion, Cota}.ToList()
                    ' insert the block in the current space
                    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 = New Point3d(PtX, PtY, PtZ).TransformBy(ucs)
                    '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() {"PN", "CD", "CT"}), lstAtt) 'check right order of attributes


                    bref.RecordGraphicsModified(True) ' to force updating a block reference
                    tr.TransactionManager.QueueForGraphicsFlush()
                Next
                doc.TransactionManager.FlushGraphics()
                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
    ' event on insert button click
    Private Sub btnInsert_Click(sender As System.Object, e As System.EventArgs) Handles btnInsert.Click
        Dim FileBD As String = txtPath.Text() '"C:\Test\Blocks.txt"

        If (Not IO.File.Exists(FileBD)) Then

            MsgBox("The DB doesn’t exist", MsgBoxStyle.Critical)

            Return
        End If
        'read your text file and parse
        Dim lst As List(Of String()) = ReadCSV(FileBD, vbTab) ' tab delimited!
        If lst.Count = 0 Then Return
        'remove headers from list
        lst.RemoveAt(0)
        ' insert blocks
        testAttributedBlocksInsert(lst)
        Me.Close()

    End Sub

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎04-26-2013

Thanks for your answer..... Your code will help me a lot! This weekend I'll study its proccess... If I have some doubts I'll let you know....

Anonymous · ‎04-27-2013

Hi Hallex! I follow your code and it's amazing because it works, but I have one problem with one attribute... because just wrote 2 attributes from 3.... I changed the order but still with the error..... and I have some questions and I hope that you'll be able to help.....

in your code you used:

Dim ucs AsMatrix3d = ed.CurrentUserCoordinateSystem

and:

Dim occ AsObjectContextCollection = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES")

and also:

you used too: DirectCast and list, and the last "list" could it be useful to use one array?

Again Thanks for your help.... you're a master

Anonymous · ‎04-27-2013

I forgot ask, why you used that code?..... I would like to learn about it.... and about to read one file.... I follow the option

TextFieldParser, but if I want one code that read diferents files..... for example ".txt, .csv, .prn, .xlsx,...." I mean file that have diferents delimeters... would I have to create one code for everything? or there's one possiblity to do it in one code.

sorry for my english!

Thanks again for your help....

Hallex · ‎04-27-2013

You can avoid put particular attribute value and use

default value insted, say this wa, change this line of code:

attRef.TextString = listValues(found)

on this one:

If listValues(found)<> String.Empty then

attRef.TextString = listValues(found)

else

attRef.TextString=attDef.textString

end if

Instead of DirectCast you can use CType instead

Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem

this is means the matrix of the current ucs

This expression is means to use it if your object has annotation scale:

Dim occ As ObjectContextCollection = db.ObjectContextManager.GetContextCollection("ACDB_ANNOTATIONSCALES")

otherwise it will be ignored in the code

Again, sorry for my poor English too 🙂

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎05-11-2013

Hi Hallex! Again with the same problem with insert Attributes I just got to insert 2 of 3

I followed your code:

If

LstTags.Contains(AttDef.Tag) Then

Dim found AsInteger = LstTags.BinarySearch(AttDef.Tag)

If found>= 0 Then

If ListValues(AttFound) <> String.Empty Then

AttRef.TextString = ListValues(found)

Else

AttRef.TextString = AttDef.TextString

EndIf

And I still don't understand why it doesn't read the first value? I mean "0"

now why found contains -4? when listTags contains 3 values I mean "PT, CD, CT"

Again Thanks for your help! and you know I'm learning with you help

Anonymous · ‎05-13-2013

Hi! I did it... this is the code....

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 AsAttributeDefinition = DirectCast(ent, AttributeDefinition)

Dim attRef AsNewAttributeReference()

attRef.SetAttributeFromBlock(attDef, BRef.BlockTransform)

BRef.AttributeCollection.AppendAttribute(attRef)

tr.AddNewlyCreatedDBObject(attRef,True)

If listTags.Contains(attDef.Tag) Then

AttRef.TextString = ListValues(Count)

AttRef.AdjustAlignment(AcadCurrentDB)

End If

Count = Count + 1

End If

Anonymous · ‎05-13-2013

Sorry! I forgot this line

Hi! I did it... this is the code....

Dim Count As Int16 = 0 'I've added this line

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 AsAttributeDefinition = DirectCast(ent, AttributeDefinition)

Dim attRef AsNewAttributeReference()

attRef.SetAttributeFromBlock(attDef, BRef.BlockTransform)

BRef.AttributeCollection.AppendAttribute(attRef)

tr.AddNewlyCreatedDBObject(attRef,True)

If listTags.Contains(attDef.Tag) Then

AttRef.TextString = ListValues(Count)

AttRef.AdjustAlignment(AcadCurrentDB)

End If

Count = Count + 1

End If

Community

Help! with this code to insert one block with 3 attributes...

Help! with this code to insert one block with 3 attributes...

Help! with this code to insert one block with 3 attributes...