unable to read a particular block unless the block is a block reset is performed

[Anonymous]

Hi, I am not sure if anyone encounter this situation.

I have some codes to search for a particular block then print the attribute to excel. The problem I am faced with at the moment is that vba is not picking up the specified block but if I physically go in to the drawing and reset each block then vba will pick up those blocks. Does anyone have any idea to overcome this with out having to go into every drawing and resetting the blocks. Resetting the block is not an option because some of the blocks are dynamic blocks.

below is the code I am using to read to read the block.

Private Sub OpenFile(objfile As Object)

    Dim NewAcad As Boolean
    NewAcad = False
       
    Dim ACAD As AcadApplication 'Create ACAD variable of type AcadApplication
    On Error Resume Next 'This tells VBA to ignore errors
    Set ACAD = GetObject(, "AutoCad.Application") 'Get a running instance of the class AutoCAD.
    On Error GoTo 0 'This tells VBA to go back to NOT ignoring errors
    If ACAD Is Nothing Then 'Check to see if the above worked
        Set ACAD = New AcadApplication 'Set the ACAD variable to equal a new instance of AutoCAD
        NewAcad = True
    End If
    
    ACAD.Visible = True 'Once loaded, set AutoCAD to be visible
    
    Dim DWG As AcadDocument
    Dim releaseFile As String 'file name
    Set DWG = ACAD.Documents.Open(objfile)
    Dim FixError As Variant
    DWG.AuditInfo FixError ' audit and fix error in drawing
    DWG.PurgeAll ' purge drawing
    
Dim blkName As String
blkName = "TAG-PART"
Dim blk As AcadBlockReference
Dim blks As Variant
Dim attrs As Variant
Dim attr As Variant
Dim i As Integer


    blks = FindBlocksOnAllLayouts(DWG, blkName) ' found all blks(i) = "TAG-PART" in layout
    If VarType(blks) = vbEmpty Then
        MsgBox "No block """ & blkName & """ found in current drawing!"
    Else
        For i = 0 To UBound(blks)
        Set blk = blks(i) ' each "TAG-PART" stored in array
        attrs = blk.GetAttributes() ' get attribure from blk
            For Each attr In attrs ' for each attr in the all the attrs in the block "TAG-PART"
                'MsgBox attr.TagString & " = " & attr.TextString
                Cells(n + 1, 2) = attr.TagString
                Cells(n + 1, 3) = attr.TextString
                n = n + 1
                ROW_FIRST = n + 1
            Next
        Next
    End If
    DWG.Close True
    
End Sub

Function FindBlocksOnAllLayouts(DWG As AcadDocument, blkName As String)
Dim blks() As AcadBlockReference
Dim i As Integer
Dim ent As AcadEntity
Dim blk As AcadBlockReference

Dim Layout As AcadLayout
Set Layout = DWG.ModelSpace.Layout

Dim lay As AcadLayout
            For Each ent In Layout.block ' each entity in the block
                If TypeOf ent Is AcadBlockReference Then
                    Set blk = ent
                    If UCase(blk.Name) = UCase(blkName) Then ' if blk.name is TAG-PART
                        ReDim Preserve blks(i)
                        Set blks(i) = blk
                        i = i + 1
                    End If
                End If
            Next
FindBlocksOnAllLayouts = blks ' found block TAG-PART
End Function

[rkmcswain · Accepted solution]

You have to grab the EffectiveName property if I recall correctly. More info in these threads.

[Anonymous]

in addition, when I use autocad's "Export Attributes" to export the blocks. The block name is *U128 instead of the actual part name "TAG-PART".

I've attached the dwg with the blocks i am trying to extract from.

[norman.yuan]

That is because the block definition ("TAG-PART"?) is a dynamic block, thus, the cooresponding block reference may actually be a reference of an anonymous block definition that AutoCAD creates based on the block definition "TAG-PART" and the dynamic property values applied. That is why when you search block reference by its name, you need to use "EffectiveName". 

You may want to do a bit more homework on dynamic block since you are doing programming.