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
Solved! Go to Solution.
Sorry! I had it like spam, your answer.... and it was for that reason that I post it again... sorry for my english!
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
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
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....
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 🙂
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
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....
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.