extract attribute values from an block in an External Reference using VBA ?

[Anonymous]

is it possible to extract attribute values from an block in an External Reference using VBA ?

[Alfred.NESWADBA]

Hi,

yes, you will have to go into the database of the XRef, then you have access to the blockreference, and so to the attribute-values.

- alfred -

[Anonymous]

Thank you Alfred.

did you see anthing i missed as in your concept?

After setting filter code & Filter Value, the code:

blkset.Select acSelectionSetAll, , , fitype, fidata
'Debug.Print vbCrLf & blkset.Count
If blkset.Count > 0 Then
i = 0: j = 0: k = 0
Do While clname = "" And i < blkset.Count
    Set tmpblk = blkset.Item(i)
        If TypeOf tmpblk Is AcadExternalReference Then
            For j = 0 To ThisDrawing.Blocks.Count - 1
                Set xrblk = ThisDrawing.Blocks.Item(j)
                If xrblk.Name = "MYXREF" Then
                    Set xrda = xrblk.XRefDatabase
                    For k = 0 To xrda.Blocks.Count - 1
                    'For j = 0 To ThisDrawing.Blocks.Count - 1
                        entname = xrda.Blocks.Item(j).Name
                        If entname = "MYXREF|BLKWITHATTRIBS" Then
                            clname = "MYXREF|BLKWITHATTRIBS"
                            xrtype = "xref"
                            Exit For
                        End If
                    Next k
                Else
                    If clname <> "" Then
                    Exit For
                    End If
                End If
            Next j
        Else
            Set blkobj = ThisDrawing.Blocks.Item(tmpblk.Name)
            xrtype = "block"
        End If
        
    If clname <> "" Then
       Exit Do
     Else
         i = i + 1
     End If
    
Loop
Else

Regards,

Vidjeane.M

[Anonymous]

Thank you Alfred.

did you see anthing i missed as in your concept?

After setting filter code & Filter Value, the code:

blkset.Select acSelectionSetAll, , , fitype, fidata
'Debug.Print vbCrLf & blkset.Count
If blkset.Count > 0 Then
i = 0: j = 0: k = 0
Do While clname = "" And i < blkset.Count
    Set tmpblk = blkset.Item(i)
        If TypeOf tmpblk Is AcadExternalReference Then
            For j = 0 To ThisDrawing.Blocks.Count - 1
                Set xrblk = ThisDrawing.Blocks.Item(j)
                If xrblk.Name = "MYXREF" Then
                    Set xrda = xrblk.XRefDatabase
                    For k = 0 To xrda.Blocks.Count - 1
                    'For j = 0 To ThisDrawing.Blocks.Count - 1
                        entname = xrda.Blocks.Item(j).Name
                        If entname = "MYXREF|BLKWITHATTRIBS" Then
                            clname = "MYXREF|BLKWITHATTRIBS"
                            xrtype = "xref"
                            Exit For
                        End If
                    Next k
                Else
                    If clname <> "" Then
                    Exit For
                    End If
                End If
            Next j
        Else
            Set blkobj = ThisDrawing.Blocks.Item(tmpblk.Name)
            xrtype = "block"
        End If
        
    If clname <> "" Then
       Exit Do
     Else
         i = i + 1
     End If
    
Loop
Else

the problem is i am not getting clname. it always returns "".

Regards,

Vidjeane.M

[Alfred.NESWADBA · Accepted solution]

Hi,

>> the problem is i am not getting clname. it always returns "".

Not tried, but I guess your string to verify the name of the blockdefinition within the XRef might be wrong.

If you open the database from the XRef, you have blocks with names, and as long as in that database there were no XRefs bound the name "MYXREF|BLKWITHATTRIBS" will not be valid, try "BLKWITHATTRIBS" in the "if"-line instead.

If that don't work do a

   Debug.Print entname

a line before your if and you see what names are found as blockdefinitions in the XRef.

to come back to your title: this just scans the block definitions within the XRef, it does not access the BlockReferences in ModelSpace (or any other space or blockdefinition if needed)

- alfred -

[Anonymous]

alfred,

thakn you for your feedback.

will try & update you on this.

regards,

Vidjeane.M