Topic: ObjectDBX - Dynamic blocks and effective names...

[Yosso]

There's a spreadsheet tool that is available on the AUGI forum which will open up a folder of drawings and pull out blocks from the drawings and populate the excel sheet with the attributes.  Works great, if you don't have dynamic blocks.

The secret sauce is related to the "EffectiveName" of the block, but I'm having trouble understanding how to get the effective name of the block.

Here's the code excerpt:

Code: [Select]

For Each MyBlock In MyDbx.Blocks
                If MyBlock.IsDynamicBlock Then
                  If UCase(MyBlock.EffectiveName) = UCase(Range("BlkName").Value) Then
                        BlkExist = True
                        Exit For
                    End If
                End If
                If UCase(MyBlock.Name) = UCase(Range("BlkName").Value) Then
                    BlkExist = True
                    Exit For
                End If
 Next MyBlock

Here's the error number and description:

Error #438
Object doesn't support this property or method

Any assistance would be greatly appreciated.

[n.yuan]

Not seeing more related code, I could not say I understand exact purpose of the code you showed.

However, the error message is expected:

The "For Each..." loop goes through a drawing's block definitions to see whether a block definition exists in drawing.

So, MyBlock as declared as AcadBlock, not AcadBlockreference, therefore, MyBlock.EffectiveName is wrong and raises the exception.

A block definition, be it dynamic block or not, always has a name, while a block reference, if being a dynamic block reference, could have an "annomynous block" name, thus, a read-only "EffectiveName" is needed to indicate from which dynamic block definition it is derived.

It is obvious that the tool you get has a bug when dealing with dynamic block.

[Yosso]

Right, the tool has  a problem with Dynamic blocks.     

I do appreciate the explanation of the Effective name.

I am trying to modify the existing code, but have yet to be successful, but am making progress (see below).

Just purchased the Jerry Winter VB.net book, going to try the VB.net approach, maybe.

Here's the original code (which works just fine with non-dynamic blocks).

Code: [Select]

Sub GetBlockInfo()
    Dim DwgCnt As Integer
    Dim DwgName As String
    Dim StrPath As String
    Dim BlkExist As Boolean
    Dim intType(1) As Integer
    Dim varData(1) As Variant
    Dim BlkFound As Boolean
    Dim AttTitles As Boolean
    Dim ChkSht As Worksheet, DwgLstSht As Worksheet
   
    Dim MyDbx As AxDbDocument
    Dim MyLayouts As AcadLayouts
    Dim MyLayout As Variant
    Dim MyEnt As AcadEntity
    Dim MyBlock As AcadBlock
    Dim MyBlockR As AcadBlockReference
    Dim MyAtt As AcadAttributeReference
    Dim AttCt1, AttCt2 As Integer
    Dim Atts As Variant
    Dim MyBlkCount As Integer
   
    Set DwgLstSht = Sheets("DrawingList")
    Set ChkSht = Sheets("CheckList")
   
    GetFileNames
   
    ' Set up error control
    On Error GoTo Error_Control
   
    Init ' initialize global variables
   
    ' Get the Current Path
    StrPath = ThisWorkbook.Path
    If (Right(StrPath, 1) <> "\") Then
        StrPath = StrPath & "\"
    End If
   
    ' Unprotect sheet for drawing modifications
    DwgLstSht.Unprotect
    ChkSht.Unprotect
    ' Replace the Layout header since it was deleted when the attributes where cleared
    DwgLstSht.Cells(ROWOFF - 1, 2) = "Layout"
   
    ' Get the first drawing in the list and store in DwgName
    DwgCnt = 0
    AttTitles = False ' Set the Attribute Titles Flag to False (no titles yet)
    DwgName = DwgLstSht.Cells(DwgCnt + ROWOFF, 1)
   
    ' Call display status function
    temp = Status_Bar(True, "Activating ObjectDBX...")
    Set MyDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.18")
   
    While DwgName <> ""
        ' Call Display Status Function
        temp = Status_Bar(True, "Opening drawing " & DwgName)
       
        ' Open a drawing in ObjectDbx
        Set MyDbx = dbxOpen(StrPath, DwgName)
       
        ' If there are no errors and there is a file open
        If Err.Number = 0 And MyDbx.Name <> "" Then
           
            ' Determine if the chosen block is present in the drawing
            For Each MyBlock In MyDbx.Blocks
                If UCase(MyBlock.Name) = UCase(Range("BlkName").Value) Then
                    BlkExist = True
                    Exit For
                End If
            Next MyBlock
   
            ' If the block was found , then proceed
            If BlkExist Then
                BlkFound = False
               
                MyBlkCount = 0
                ' Iterate through all Layouts
                Set MyLayouts = MyDbx.Layouts
                For Each MyLayout In MyDbx.Layouts
                  ' Avoid Modelspace if the Check Modelspace checkbox is NOT checked
                  If Sheets("DrawingList").Model_Check.Value Or MyLayout.Name <> "Model" Then
                    ' Call display status function
                    temp = Status_Bar(True, "Searching " & DwgName & " Layout " & MyLayout.Name & " " & Range("BlkName").Value)
                   
                    ' Loop through each entity in the layout.block group
                    For Each MyEnt In MyLayout.Block
                        ' Check if the current Entity is a Block Reference
                        If TypeOf MyEnt Is AcadBlockReference Then
                            ' Check that the block name matches what we are looking for
                            If UCase(MyEnt.Name) = UCase(Range("BlkName").Value) Then
                                ' Store the current Entity as a Block Reference
                                Set MyBlockR = MyEnt
                                ' Make sure that the Block Reference has attributes
                                If MyBlockR.HasAttributes Then
                                    ' If we have already found a block in the current drawing, add another row
                                    If MyBlkCount > 0 Then
                                        DwgLstSht.Cells(DwgCnt + ROWOFF + 1, 1).EntireRow.Insert
                                        DwgCnt = DwgCnt + 1
                                        DwgLstSht.Cells(DwgCnt + ROWOFF, 1) = DwgName
                                        ChkSht.Cells(DwgCnt + ROWOFF, 1) = DwgName
                                    End If
                                    DwgLstSht.Cells(DwgCnt + ROWOFF, 2) = MyLayout.Name
                                    ChkSht.Cells(DwgCnt + ROWOFF, 2) = MyLayout.Name
                                   
                                    ' Store all attributes in the matrix Atts
                                    Atts = MyEnt.GetAttributes
                                   
                                    ' Step through each attribute in Atts
                                    For AttCt1 = LBound(Atts) To UBound(Atts)
                                        ' Get the next attribute
                                        Set MyAtt = Atts(AttCt1)
                                       
                                        ' Call Display Status Function
                                        temp = Status_Bar(True, "Accessing " & DwgName & " attributes: " & MyAtt.TagString & ".")
                                       
                                        ' Write the attribute information to DrawingList and CheckList sheets
                                        DwgLstSht.Cells(DwgCnt + ROWOFF, AttCt1 + COLOFF).NumberFormat = "@" 'C. White 27/09/11 added to ensure attribute is listed as a string in Excel
                                        DwgLstSht.Cells(DwgCnt + ROWOFF, AttCt1 + COLOFF) = MyAtt.TextString
                                        ChkSht.Cells(DwgCnt + ROWOFF, AttCt1 + COLOFF) = MyAtt.TextString
                                       
                                        ' If this is the first drawing, store the attribute tags in the header row
                                        If AttTitles = False Then
                                            DwgLstSht.Cells(ROWOFF - 1, AttCt1 + COLOFF) = MyAtt.TagString
                                            ChkSht.Cells(ROWOFF - 1, AttCt1 + COLOFF) = MyAtt.TagString
                                            If AttCt1 = UBound(Atts) Then
                                                AttTitles = True
                                            End If
                                        End If
                                    Next AttCt1
                                    MyBlkCount = MyBlkCount + 1
                                End If
                                Exit For
                            End If
                        End If
                    Next
                 End If
                Next
            End If
            ' Clean the mydbx variable
            Set MyDbx = Nothing
        ElseIf Err.Number = 0 And MyDbx.Name = "" Then
            ' Turn off the Status bar
            temp = Status_Bar(False)
            Exit Sub
        End If
       
        ' Clean up Variables
        Set MyBlock = Nothing
        Set MyBlockR = Nothing
        Set MyAtt = Nothing
       
        DwgCnt = DwgCnt + 1
        DwgName = Cells(DwgCnt + ROWOFF, 1)
    Wend

Error_Control:
    If Err.Number <> 0 Then
        Set MyBlock = Nothing
        Set MyAtt = Nothing
        If Err.Number = 13 Then
            MsgBox "Failed to initiate ObjectDbx, probably due to another version of Autocad...", vbCritical, "ObjectDBX Fail"
        Else
            MsgBox "Error #" & Err.Number & vbCr & Err.Description
        End If
    End If
   
   
    If Not MyDbx Is Nothing Then Set MyDbx = Nothing
    ' Adjust column widths to match the data in the cells
    DwgLstSht.Activate
    DwgLstSht.Columns.AutoFit
    DwgLstSht.Cells(4, 2) = Now
    DwgLstSht.Range("A6").Select

    ' Protect sheet
    DwgLstSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ChkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    ' Turn off the Status bar
    temp = Status_Bar(False)
End Sub


Thanks for the bump.

M.

[Yosso]

Making progress, was able to find and extract the dynamic blocks with their attributes with a few modifications to the original VBA code.

Next step is to extract the dynamic properties and the handle of the block instances in the drawings.

Thank you for reading. 

M.