After Adding Xdata to a Dynamic Block with attribute, It disappear from screen.

[JanetDavidson]

Hello Again a lady who is Touble Maker.

My code add xdata to any object properly except for a dynamic block with attribute. Strange ! Ha ?. After code excutes it disappears from screen . Even undo make strange thing. I guess I screw the database somehow. But even audit doesn't show any fix applied.

I don't know how I did it ,Maybe because I am lady and not suppose to code !. Attach is a sample drawing. And below is my code. I really need a gentleman help me what is wrong with it.

I simplified the code as much as possible  and made it easy/ready to copy and paste  and test .

Regards,

Janet .

   <CommandMethod("pppp")> _
    Shared Sub test1()
        Dim Mydwg As Document = Application.DocumentManager.MdiActiveDocument
        Dim Mydb As Database = Mydwg.Database
        Dim Myed As Editor = Mydwg.Editor
        Dim MyRegisterApplication As String = "My_R_Cad"
        Dim psRes As PromptSelectionResult = Myed.GetSelection
        If psRes.Status = PromptStatus.OK Then
            Dim mySSet As SelectionSet = psRes.Value
            For Each myssObj As SelectedObject In mySSet
                If Not IsDBNull(myssObj) Then
                    Using Tr As Transaction = Mydwg.TransactionManager.StartTransaction()
                        Try
                            Dim Myrb As New ResultBuffer
                            Dim MydbObj As DBObject = Tr.GetObject(myssObj.ObjectId, OpenMode.ForWrite)
                            Dim MyEntity As Entity = DirectCast(Tr.GetObject(myssObj.ObjectId, OpenMode.ForRead), Entity)
                            Dim myxData As ResultBuffer = MyEntity.GetXDataForApplication(MyRegisterApplication)
                            If myxData Is Nothing Then
            Dim Myrat As RegAppTable = DirectCast(Tr.GetObject(Mydb.RegAppTableId, OpenMode.ForRead, False), RegAppTable)
                                If Not Myrat.Has(MyRegisterApplication) Then
                                    Myrat.UpgradeOpen()
                                    Dim ratr As New RegAppTableRecord()
                                    ratr.Name = MyRegisterApplication
                                    Myrat.Add(ratr)
                                    Tr.AddNewlyCreatedDBObject(ratr, True)
                                End If
                                Dim lstXdata As List(Of Object) = New List(Of Object)
                                For I = 1 To 10
                                    lstXdata.Add(I.ToString)
                                Next
                                Myrb.Add(New TypedValue(1001, MyRegisterApplication))
                                For Each MyVal As String In lstXdata
                                    Myrb.Add(New TypedValue(1000, MyVal))
                                Next
                                MydbObj.XData = Myrb
                                Myrb.Dispose()
                            End If
                            Myrb = MydbObj.GetXDataForApplication(MyRegisterApplication)
                            Dim MyvalueArray As TypedValue() = Myrb.AsArray
                            For I = 1 To 10
                                Dim tv As TypedValue = MyvalueArray(I)
                                MyvalueArray.SetValue(New TypedValue(tv.TypeCode, "test" + (I + 100).ToString), I)
                            Next
                            Myrb.Dispose()
                            Myrb = New ResultBuffer(New TypedValue(1001, MyRegisterApplication))
                            For Each tv1 As TypedValue In MyvalueArray
                                Myrb.Add(tv1)
                            Next
                            MydbObj.XData = Myrb
                            Myrb.Dispose()
                            Tr.Commit()
                            MsgBox("Done")
                        Catch ex As System.Exception
                            MsgBox(ex.Message & ex.StackTrace)
                        End Try
                    End Using
                End If
            Next
        End If
    End Sub

[hgasty1001 · Accepted solution]

Hi,

You can try defining a separeted sub or function to add the Xdata, like this:

Public Sub AddXdata(ByRef acObj As DBObject, ByVal valueList As List(Of String), ByRef tr As Transaction, ByRef db As Database, ByVal regap As String)
        Dim acRegAppTbl As RegAppTable
 
        acRegAppTbl = tr.GetObject(db.RegAppTableId, OpenMode.ForRead)
 
        If acRegAppTbl.Has(regap) = False Then
            Dim acRegAppTblRec As RegAppTableRecord = New RegAppTableRecord()
            acRegAppTblRec.Name = regap
            acRegAppTbl.UpgradeOpen()
            acRegAppTbl.Add(acRegAppTblRec)
            tr.AddNewlyCreatedDBObject(acRegAppTblRec, True)
        End If
 
        Dim acResBuf As ResultBuffer = New ResultBuffer()
 
        acResBuf.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, regap))
        For Each Str As String In valueList
            acResBuf.Add(New TypedValue(DxfCode.ExtendedDataAsciiString, Str))
        Next
        Try
            acObj.XData = acResBuf
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
 
        acResBuf.Dispose()
    End Sub

An then try to add the Xdata using only one transaction, like this:

<CommandMethod("AcXD")> _
    Public Sub AcXd()
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim db As Database = HostApplicationServices.WorkingDatabase()
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim regap As String = "Myregap"
        Dim ValueList As New List(Of String)
 
        For i = 0 To 10
            ValueList.Add(i.ToString)
        Next
 
        Using acTrans As Transaction = db.TransactionManager.StartTransaction()
            Try
                Dim acSSPromptOptions As PromptSelectionOptions = New PromptSelectionOptions
 
                Dim acSSPrompt As PromptSelectionResult = doc.Editor.GetSelection(acSSPromptOptions)
                If acSSPrompt.Status = PromptStatus.OK Then
                    Dim acSSet As SelectionSet = acSSPrompt.Value
                    For Each myssObj As SelectedObject In acSSet
                        If Not IsDBNull(myssObj) Then
                            Dim myObj As DBObject = acTrans.GetObject(myssObj.ObjectId, OpenMode.ForWrite)
 
                            AddXdata(myObj, ValueList, acTrans, db, regap)
 
                        End If
                    Next
                End If
            Catch ex As Exception
                ed.WriteMessage(ex.Message)
            End Try
            acTrans.Commit()
        End Using
    End Sub

Gaston Nunez

[JanetDavidson]

Gaston,

Thanks Very Much. But it does the same thing.

if a block with attribute selected . it would be disappeared after code executed .

I  feel helpless.

But Thanks Anyways Gaston for second time. The first time you were like Zorro.

I don't know why as a woman I have to pick this kind of job and stuck in it. You know women are not as sharp as men in programming. All the best programmers are men . Why ??? God Knows.

Anyways.

Regards,

Janet.

[JanetDavidson]

Gaston, I found something maybe this narrow down help find the reason  . If the name of RegApplication assinged to "My_R_Cad" . this will happen. Not any other name.

Does it help to find the reason why it does that?

Regards,

Janet.

[JanetDavidson]

Gaston,

Sorry for confusion.

Your code works fine. It did the job.

It was my fault . I had this overrule for blocks which made that disappearance happens.

Sorry and Thanks Again Gaston.

Regards,

Janet.