.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

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

10 REPLIES 10
SOLVED
Reply
Message 1 of 11
luisibad
710 Views, 10 Replies

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

 

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

                           

                        Next

                        AcadBlockRec.AppendEntity(AcadBlockRef)

                        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

 

 

 

10 REPLIES 10
Message 2 of 11
Hallex
in reply to: luisibad

You've ignored my previous answer on your question,
so I would not to help more
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 3 of 11
luisibad
in reply to: Hallex

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

 

 

Message 4 of 11
Hallex
in reply to: luisibad

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
Message 5 of 11
luisibad
in reply to: Hallex

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....
Message 6 of 11
luisibad
in reply to: luisibad

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

Message 7 of 11
luisibad
in reply to: luisibad

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

Message 8 of 11
Hallex
in reply to: luisibad

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
Message 9 of 11
luisibad
in reply to: Hallex

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                     

   EndIf      

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 Smiley Happy

Message 10 of 11
luisibad
in reply to: luisibad

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

       

Next

 

Again Hallex thanks for your help! I hope to count on your help if I'll have more questions....

 

 

Message 11 of 11
luisibad
in reply to: luisibad

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

       

Next

 

Again Hallex thanks for your help! I hope to count on your help if I'll have more questions....

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost