Reading and Writing to Block Attributes

[mgorecki]

Hi, this part of my code is supposed to look for a layout I just added, search through it's blocks that have attributes, and if the block with the specific attributes is found, it should open a dialog box and populate the two text boxes with the attribute text.  When the user changes the text in the dialog box and picks ok, I want it to go back and change the attribute values in the block.

I'm just not sure how to change the text value for the attributes.  Do I create an identical code that will search all over again only to write the values instad of read?  There has to be an easier way since I have the block located already.

    Public Sub replaceTitleText(ByVal pageNumber As Integer)
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim layoutCount As Integer = LayoutManager.Current.LayoutCount - 1

        Dim getTexttrans As Transaction = db.TransactionManager.StartTransaction()
        Try
            Dim myBT As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
            For Each btrID As ObjectId In myBT
                Dim myBTR As BlockTableRecord = btrID.GetObject(OpenMode.ForRead)
                ' If the block table record is a layout
                If myBTR.IsLayout Then
                    Dim layOut As Layout = myBTR.LayoutId.GetObject(OpenMode.ForRead)
                    ' If the layout is the new layout
                    If layOut.TabOrder = pageNumber Then
                        For Each id As ObjectId In myBTR
                            Dim obj As DBObject = id.GetObject(OpenMode.ForRead)
                            ' If the object is a block reference
                            If TypeOf obj Is BlockReference Then
                                Dim bref As BlockReference = DirectCast(obj, BlockReference)
                                ' If the block reference has attributes
                                If bref.AttributeCollection.Count <> 0 Then
                                    For Each attId As ObjectId In bref.AttributeCollection
                                        Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead)
                                        ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute
                                        ' get the current text values for the attributes
                                        Dim textTitle As String = ""
                                        Dim textDieSide As String = ""

                                        If attRef.Tag = "PAGE_TITLE" Then
                                            textTitle = attRef.TextString
                                        End If
                                        If attRef.Tag = "DIE_SIDE_VIEW" Then
                                            textDieSide = attRef.TextString
                                            'diaTitleText.txtDieSide.Visible = True
                                        End If
                                        ' If the block has either one of these attributes
                                        If Not textTitle = "" Or Not textDieSide = "" Then
                                            Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide)
                                            'diaTitleText.ShowDialog()
                                            If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then
                                                textTitle = diaTitleText.newTextTitle
                                                textDieSide = diaTitleText.newTextDieSide
                                            End If
                                        End If
                                    Next
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        Catch
            ed.WriteMessage("Error!")
        Finally

            getTexttrans.Commit()
        End Try
End Sub

[Alfred.NESWADBA · Accepted solution]

Hi,

>> Do I create an identical code that will search all over again only to write the values instad of read?

No, you could save the ObjectID of the AttributeReference and reopen it (writeable) when finished with the dialog and the values changed.

For Each attId As ObjectId In bref.AttributeCollection
  Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead)
  ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute
  ' get the current text values for the attributes
  Dim textTitle As String = ""
  Dim textDieSide As String = ""

  'CHANGE 1: prepare variables for the ObjectID of the AttRefs
  Dim textTitleAttRefID as ObjectID
  Dim textDieSideAttRefID as ObjectID
  'CHANGE 1 end

  If attRef.Tag = "PAGE_TITLE" Then
    textTitle = attRef.TextString
    textTitleAttRefID = attRef.ObjectID   'CHANGE 2 save the ObjectID
  End If
  If attRef.Tag = "DIE_SIDE_VIEW" Then
    textDieSide = attRef.TextString
    'diaTitleText.txtDieSide.Visible = True
    textDieSideAttRefID = attRef.ObjectID 'CHANGE 3: save the ObjectID
  End If
    ' If the block has either one of these attributes
  If Not textTitle = "" Or Not textDieSide = "" Then
    Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide)
    'diaTitleText.ShowDialog()
    If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then
      
      'CHANGE 4: open the AttRef's for write and save the new textvalues
      if textTitle <> diaTitleText.newTextTitle Then
        'only overwrite when value has changed
        textTitle = diaTitleText.newTextTitle
        if textTitleAttRefID.isValid Then  'check if the AttRef exists (seems as it does not have to exist)
          Dim tAttRefWRITE as AttributeReference = ctype(getTexttrans.GetObject(textTitleAttRefID,OpenMode.ForWrite),AttributeReference)
          tAttRefWRITE.TextString = textTitle 
        end if
      end if
      if textDieSide <> diaTitleText.newTextDieSideThen
        'only overwrite when value has changed
        textDieSide = diaTitleText.newTextDieSideThen
        if textDieSideAttRefID.isValid Then  'check if the AttRef exists (seems as it does not have to exist)
          Dim tAttRefWRITE as AttributeReference = ctype(getTexttrans.GetObject(textDieSideAttRefID, OpenMode.ForWrite),AttributeReference)
          tAttRefWRITE.TextString = textDieSideAttRefID 
        end if
      end if

      'CHANGE 5: you can remove this as it is built in CHANGE 4
      'textTitle = diaTitleText.newTextTitle
      'textDieSide = diaTitleText.newTextDieSide
    End If
  End If
Next

Hope I have not overlooked something.

One more input to your code:

You set the .Commit for the transaction within the Finally-Statement (of the Try-Catch).

What does that mean? Finally runs after Catch, so it will also run if the code crashed somewhere within the Try-section. IMHO that does not make sense to .Commit the transaction even not knowing if the code run clean or failed. I would prefere to set the .Commit-statement in the Try-section/last code-line before Catch. So I know if this code-line is reached there was no error so far.

And there is a second problem you can solve with my version: Sometimes the .Commit itself throws an exception, every time it should commit something where object-creations or database-modifications where not prepared well. And for this exception you are out of a Try- and not before a Catch-section! That means this exception will throw up to the next/hierarchically above Catch ... if you have one ... if not AutoCAD crashes!

Hope my description is understandable and helps, good luck, - alfred -

[mgorecki]

Hi Alfred,

Thank you very much for your help.  I did what you suggested and after a few tweaks of my own, the code works great!

Public Sub replaceTitleText(ByVal pageNumber As Integer)
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim layoutCount As Integer = LayoutManager.Current.LayoutCount - 1
        Dim textTitle As String = ""
        Dim textDieSide As String = ""

        Dim getTexttrans As Transaction = db.TransactionManager.StartTransaction()
        Try
            Dim myBT As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
            For Each btrID As ObjectId In myBT
                Dim myBTR As BlockTableRecord = btrID.GetObject(OpenMode.ForRead)
                ' If the block table record is a layout
                If myBTR.IsLayout Then
                    Dim layOut As Layout = myBTR.LayoutId.GetObject(OpenMode.ForRead)
                    ' If the layout is the new layout
                    If layOut.TabOrder = pageNumber Then
                        For Each id As ObjectId In myBTR
                            Dim obj As DBObject = id.GetObject(OpenMode.ForRead)
                            ' If the object is a block reference
                            If TypeOf obj Is BlockReference Then
                                Dim bref As BlockReference = DirectCast(obj, BlockReference)
                                ' If the block reference has attributes
                                Dim attCounter As Integer = 1
                                If bref.AttributeCollection.Count <> 0 Then
                                    For Each attId As ObjectId In bref.AttributeCollection
                                        Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead)
                                        ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute
                                        ' get the current text values for the attributes
                                        Dim textTitleAttRefID As ObjectId
                                        Dim textDieSideAttRefID As ObjectId

                                        If attRef.Tag = "PAGE_TITLE" Then
                                            textTitle = attRef.TextString
                                            textTitleAttRefID = attRef.ObjectId
                                        End If
                                        If attRef.Tag = "DIE_SIDE_VIEW" Then
                                            textDieSide = attRef.TextString
                                            textDieSideAttRefID = attRef.ObjectId
                                        End If
                                        ' If all of the attributes in the block have been checked
                                        If attCounter = bref.AttributeCollection.Count Then
                                            Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide)
                                            If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then
                                                ' Open the AttRef's for write and save the new textvalues
                                                If textTitle <> diaTitleText.txtSheetTitle.Text Then
                                                    ' Only overwrite when value has changed
                                                    textTitle = diaTitleText.txtSheetTitle.Text
                                                    If textTitleAttRefID.IsValid Then  'check if the AttRef exists
                                                        Dim tAttRefWRITE As AttributeReference = CType(getTexttrans.GetObject(textTitleAttRefID, OpenMode.ForWrite), AttributeReference)
                                                        tAttRefWRITE.TextString = textTitle
                                                    End If
                                                End If
                                                If Not textDieSide = "" Then
                                                    If textDieSide <> diaTitleText.txtDieSide.Text Then
                                                        ' Only overwrite when value has changed
                                                        textDieSide = diaTitleText.txtDieSide.Text
                                                        If textDieSideAttRefID.IsValid Then  'check if the AttRef exists
                                                            Dim tAttRefWRITE As AttributeReference = CType(getTexttrans.GetObject(textDieSideAttRefID, OpenMode.ForWrite), AttributeReference)
                                                            tAttRefWRITE.TextString = textDieSide
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                        attCounter += 1
                                    Next
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        Catch
            ed.WriteMessage("Error!")
        Finally
            getTexttrans.Commit()
        End Try
    End Sub

 Again, thanks a lot.

Mark

[jamkhp]

 Hi I had a smimilar requirement, but  a little change, I would like to read the contents of the Titleblock and write it down to xl file, but the block is there in the model space, so here is what I have done, please suggest me that is there any other way so that I can improvise this code. thanks in advance

Public Sub ReadData(ByVal fName As String)
        Dim acdoc As Document = Application.DocumentManager.Open(fName, False, Nothing)
        acdoc = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acdoc.Database
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Using mydoclock As DocumentLock = acdoc.LockDocument()
                Try
                    Dim acBlkTbl As BlockTable = acCurDb.BlockTableId.GetObject(OpenMode.ForRead)
                    For Each acOjbid As ObjectId In acBlkTbl
                        Dim acBlkTblRec As BlockTableRecord = acOjbid.GetObject(OpenMode.ForRead)
                        For Each accObjId As ObjectId In acBlkTblRec
                            Dim acObj As DBObject = accObjId.GetObject(OpenMode.ForRead)
                            If TypeOf acObj Is BlockReference Then
                                Dim acBlkRef As BlockReference = DirectCast(acObj, BlockReference)
                                Dim acAttCount As Integer = 1
                                If acBlkRef.AttributeCollection.Count <> 0 Then
                                    For Each acAttId As ObjectId In acBlkRef.AttributeCollection
                                        Dim acAttRef As AttributeReference = acAttId.GetObject(OpenMode.ForRead)
                                        Dim macNum As String = ""
                                        Dim drgName As String = ""
                                        Dim drgNum As String = ""
                                        If acAttRef.Tag = "MACHINE_NO" Then

                                           ' Here I take the string and put in xl in another sub, for sake of simplicity I just used the msgbox
                                            MsgBox(acAttRef.TextString)
                                        End If
                                    Next
                                End If
                            End If
                        Next
                    Next
                Catch ex As System.Exception
                    MsgBox("This drawing does not contain and blocks")
                End Try
               
            End Using
        End Using
        acCurDb.Dispose()
        acdoc.CloseAndDiscard()

    End Sub

[Hallex]

I think for the particular block you might be want to use:

#Region "Read Attributes to Excel"
        <CommandMethod("ReadTitleBlockToExcel", "readbx", CommandFlags.Session)> _
     
   Public Sub TestCmd()
      
      ReadData("C:\Test\Temp\Title-1.dwg", "TitleBlock")
     
   End Sub

    
    Public Sub ReadData(ByVal fName As String, ByVal blkname As String)
     
       Dim acdoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.Open(fName, False, Nothing)
          
  acdoc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
    
        Dim acCurDb As Database = acdoc.Database
       
     Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
       
         Using mydoclock As DocumentLock = acdoc.LockDocument()
           
         Try
             
           Dim acBlkTbl As BlockTable = acCurDb.BlockTableId.GetObject(OpenMode.ForRead)
             
           If Not acBlkTbl.Has(blkname) Then
           
                 MsgBox("Block " + blkname + " does not exist")
             
               Exit Sub
            
            End If
              
          Dim btrec As BlockTableRecord = DirectCast(acTrans.GetObject(acBlkTbl(blkname), OpenMode.ForRead, False), BlockTableRecord)
                  
      Dim idcoll As ObjectIdCollection = btrec.GetBlockReferenceIds(True, True)

                        For Each id As ObjectId In idcoll
 
                            Dim acObj As DBObject = id.GetObject(OpenMode.ForRead)
                        
    If TypeOf acObj Is BlockReference Then
                        
        Dim acBlkRef As BlockReference = DirectCast(acObj, BlockReference)
                             
   Dim acAttCount As Integer = 1
                          
      If acBlkRef.AttributeCollection.Count <> 0 Then
                          
          For Each acAttId As ObjectId In acBlkRef.AttributeCollection
                        
                Dim acAttRef As AttributeReference = acAttId.GetObject(OpenMode.ForRead)
                       
                 Dim macNum As String = ""
                             
           Dim drgName As String = ""
                            
            Dim drgNum As String = ""
                             
           If acAttRef.Tag = "MACHINE_NO" Then
                                    
        'collect data here then pass it to XL after
                                   
         ' Here I take the string and put in xl in another sub, for sake of simplicity I just used the msgbox
                                
            MsgBox(acAttRef.TextString)
                           
             End If
                        
            Next
                    
            End If
                   
         End If
                    
    Next


                
    Catch ex As System.Exception
                   
     MsgBox("This drawing does not contain and blocks")
               
     End Try

          
      End Using
          
  End Using

            acdoc.CloseAndDiscard()

        End Sub

#End Region