VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Return attributes of blocks in XRef

7 REPLIES 7
SOLVED
Reply
Message 1 of 8
hakand
1511 Views, 7 Replies

Return attributes of blocks in XRef

Hey guys,

 

Just wondering how I would return attributes of blocks in my drawing's XRefs?

I've come across one example that is in VB but doesn't really help me much.

 

I currently have a list in a form that consists of all the XRefs in my drawing and I wish to return all blocks and attributes that are linked to the selected XRef.

 

Many Thanks!

HD

7 REPLIES 7
Message 2 of 8
Alfred.NESWADBA
in reply to: hakand

Hi,

 

check this

Public Sub listAttRefInXRef()
   Dim tBl As AcadBlock
   For Each tBl In ThisDrawing.Blocks
      If tBl.IsXRef Then
         'ok, we got a XRef, now scan it's modelspace for BlockReferences
         Dim tEnt As AcadEntity
         For Each tEnt In tBl.XRefDatabase.ModelSpace
            If TypeOf tEnt Is AcadBlockReference Then
               Dim tBlRef As AcadBlockReference
               Set tBlRef = tEnt
               If tBlRef.HasAttributes Then
                  'BlockReference has AttributeReferences
                  Dim tAtts As Variant
                  Dim i As Integer
                  tAtts = tBlRef.GetAttributes
                  For i = LBound(tAtts) To UBound(tAtts)
                     'output each AttributeReference
                     Debug.Print tBlRef.Handle & " " & tAtts(i).TagString & ": " & tAtts(i).TextString
                  Next
               End If
            End If
         Next
      End If
   Next
End Sub

 

 

HTH, - alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 3 of 8
hakand
in reply to: Alfred.NESWADBA

Thanks for your response Alfred!

 

Im sorry but I forgot to mention that I would be trying to achieve this in VB.net

 

This is what I currently have going but am stuck at a roadblock:

 

 

        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim tr As Transaction = db.TransactionManager.StartTransaction()

        Dim res As PromptSelectionResult = ed.SelectAll

        Dim selSet As SelectionSet = res.Value
        Dim idArray As ObjectId() = selSet.GetObjectIds()

 

 

 For Each blkId As ObjectId In idArray
 
                Dim obj As DBObject = tr.GetObject(blkId, OpenMode.ForRead)
                Dim blkRef As BlockReference = DirectCast(tr.GetObject(blkId, OpenMode.ForRead), BlockReference)
                Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkRef.BlockTableRecord, OpenMode.ForRead),      BlockTableRecord)

                If btr.IsFromExternalReference Then
 
                        MsgBox("yes")
 
                End If

Next

 

 

Instead of the message box, I want to get to the next step of picking up the attributes tho at that point btr is of External Reference type and doesn't contain any original block attributes (the Xref contains multiple blocks with multiple attributes so I need to drill down to this level).

 

Is there a way to turn btr to a certain type of object which is a collection of the blocks that the xref contains that I can cycle through?

 

so the code would be something like this (if possible?):

 

                   If btr.IsFromExternalReference Then
                             dim XrefBlockCollection as (some object array)

                             dim i as in int = 0

                      

                             For Each id As ObjectId In XrefBlockCollection

                                  Dim ad As AttributeDefinition = TryCast(tr.GetObject(id, OpenMode.ForRead), AttributeDefinition)
                                        If ad IsNot Nothing Then
                                            print( ad.tag & ad.textstring )
                                         End If

                             next

                             end while

                    End If

 

Much appreciated for all your time

HD

Message 4 of 8
Alfred.NESWADBA
in reply to: hakand

Hi,

 

check this:

   <Runtime.CommandMethod("ADESK_scanXRefs")> _
   Public Shared Sub ADESK_scanXRefs()
      Dim tMsgStr As String = ""
      Dim tAcadDoc As ApplicationServices.Document = Nothing
      Dim tDocLock As ApplicationServices.DocumentLock = Nothing
      Dim tTrAct As DatabaseServices.Transaction = Nothing
      Try
         tAcadDoc = ApplicationServices.Application.DocumentManager.MdiActiveDocument
         tDocLock = tAcadDoc.LockDocument
         tTrAct = tAcadDoc.Database.TransactionManager.StartTransaction

         tMsgStr &= "Start scan for References" & vbNewLine

         'first get XRefs from list of Block-Definitions
         Dim tBlTab As DatabaseServices.BlockTable = CType(tTrAct.GetObject(tAcadDoc.Database.BlockTableId, DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockTable)
         For Each tObjID In tBlTab
            If (tObjID.IsValid) AndAlso (Not tObjID.IsErased) Then
               Dim tBlTabRec As DatabaseServices.BlockTableRecord = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockTableRecord)
               If tBlTabRec.IsFromExternalReference OrElse tBlTabRec.IsFromOverlayReference Then
                  'get database of XRef-file
                  Dim tDB As DatabaseServices.Database = tBlTabRec.GetXrefDatabase(False)
                  tMsgStr &= vbNewLine & vbNewLine & "XRef=" & tDB.Filename & vbNewLine
                  'then scan the XRef
                  tMsgStr &= scanXRef(tDB)
               End If
            End If
         Next

         tMsgStr &= "Scan finished"

      Catch ex As Exception
      Finally
         If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
         If tDocLock IsNot Nothing Then tDocLock.Dispose() : tDocLock = Nothing
      End Try

      'and now you have the result in the variable tMsgStr
      Debug.Print(tMsgStr)

   End Sub

   Private Shared Function scanXRef(ByRef DB As DatabaseServices.Database) As String
      Dim tRetStr As String = ""    'here the attribtues get listet
      Dim tTrAct As DatabaseServices.Transaction = Nothing
      Try
         tTrAct = DB.TransactionManager.StartTransaction()

         'get modelspace
         Dim tBlTab As DatabaseServices.BlockTable = CType(tTrAct.GetObject(DB.BlockTableId, DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockTable)
         Dim tBlTabRec As DatabaseServices.BlockTableRecord = CType(tTrAct.GetObject(tBlTab("*MODEL_SPACE"), DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockTableRecord)
         'now scan for blockreferences
         For Each tObjID As DatabaseServices.ObjectId In tBlTabRec
            If (tObjID.IsValid) AndAlso (Not tObjID.IsErased) AndAlso (tObjID.ObjectClass.DxfName = "INSERT") Then
               Dim tBlRef As DatabaseServices.BlockReference = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockReference)
               If (tBlRef.AttributeCollection IsNot Nothing) AndAlso (tBlRef.AttributeCollection.Count > 0) Then
                  'ok, we have attributes within the blockreference
                  For Each tAttID As DatabaseServices.ObjectId In tBlRef.AttributeCollection
                     If (tAttID.IsValid) AndAlso (Not tAttID.IsErased) Then
                        'get the AttributeReference and prepare it for export
                        Dim tAttRef As DatabaseServices.AttributeReference = CType(tTrAct.GetObject(tAttID, DatabaseServices.OpenMode.ForRead), DatabaseServices.AttributeReference)
                        tRetStr &= "BLockHandle=&h" & Hex(tBlRef.Handle.Value) & " / TAG=" & tAttRef.Tag & " / VALUE=" & tAttRef.TextString & vbNewLine
                     End If
                  Next
               End If
            End If
         Next

      Catch ex As Exception
         tRetStr &= "Error in XRef: " & DB.Filename & ", msg: " & ex.Message & vbNewLine
      Finally
         If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
      End Try
      Return tRetStr
   End Function

 

>> Im sorry but I forgot to mention that I would be trying to achieve this in VB.net

for .NET-specific questions there is a special forum >>>here<<<

 

- alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 5 of 8
hakand
in reply to: Alfred.NESWADBA

Wow that worked perfectly! ... Thanks so much for your help Alfred.

 

Sorry, didn't mean to post in the wrong section ... I was directed here from accidently posting another VB.net question in a general thread.

 

Is there anything I can add to:

Dim tDB As DatabaseServices.Database = tBlTabRec.GetXrefDatabase(True)

If the xref is no longer resolved? (the file no longer exists in which the xref is pointing to)

 

Because it errors out on the below line when it hits an Xref that is unresolved

Dim tDB As DatabaseServices.Database = tBlTabRec.GetXrefDatabase(False)

With the error message:

Object reference not set to an instance of an object.

 

Also is there a way I can pick up the constant attributes of the blocks in the Xref?

I tried adding in the code in which I use to target my active drawing below but was unsuccessfull, above this line of code in which you provided me: 

If (tBlRef.AttributeCollection IsNot Nothing) AndAlso (tBlRef.AttributeCollection.Count > 0) Then

 

My constant attribute code:

 

                      For Each id As ObjectId In tBlTabRec
                            Dim ad As AttributeDefinition = TryCast(tTrAct.GetObject(id, OpenMode.ForRead), AttributeDefinition)
                            If ad IsNot Nothing Then
                                If ad.Constant = True Then
                                    If ad.Tag.ToUpper = "CATEGORY" Then
                                        grouparray.Add(ad.TextString)
                                    End If
                                End If
                            End If
                        Next

 

I wish to check all the block's constant attributes before cycle through the attributecollection.


Much appreciated for the time you've spent.

HD

Message 6 of 8
Alfred.NESWADBA
in reply to: hakand

Hi,

 

>> Is there anything I can add to [...] If the xref is no longer resolved?

Yes, do a Try-Catch around it so it stays in the loop for scanning XRefs

 

>> Also is there a way I can pick up the constant attributes of the blocks in the Xref?

IMHO the code you provided (searching for constant AttributeDefinitions in the BlockTableRecord) is ok, do that before the check for the AttributeReferences in the AttributeCollection of the BlockReference. So that's 2 steps and ok.

Maybe this answers the question better: No you don't find constant attribtues in the AttributeCollection.

 

- alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 7 of 8
wouter
in reply to: Alfred.NESWADBA

Hi,

 

Is it possible to rebuild the code with a hashtable for the collected attribute-output instead of the string?

 

When I try to collect the attributes in a hashtable in the scanXref function it only works for just 1 xref.

Is het possible to merge hashtables from the different xrefs?

 

tnx!

Wouter

 

 

 

Message 8 of 8
Alfred.NESWADBA
in reply to: wouter

Hi,

 

>> Is it possible to rebuild the code with a hashtable for the collected attribute-output instead of the string?

Yes, it is possible, just create a hashtable and add the values from the attribtute into it.

I don't understand the question, sorry.

 

>> When I try to collect the attributes in a hashtable in the scanXref function it only works for just 1 xref.

Then either create a key using the XRef-Name or make for each XRef a hashtable and create a new hashtable or collection and put the XRef-hashtable into it like a tree structure.

 

- alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)

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

Post to forums  

Autodesk Design & Make Report

”Boost