topic Re: access the objects in the block definition object in VBA Forum

access the objects in the block definition object

jeremye86 — Fri, 10 Aug 2018 14:28:16 GMT

how can i access the objects in the block definition object?

I have a book that says

set objentity=blockobject.item(index)

set objentity=blockobject(index)

This does not work for me and the only way i could get it to work is to explode block as follows
blockObjects2 = objBlockRef.Explode
Set objentity= blockObjects2(0)

How can i do this without exploding the block? I just want to access the first item, thus the 0 for index.

Re: access the objects in the block definition object

Ed__Jobe — Fri, 10 Aug 2018 14:41:47 GMT

Can you show all your code? What do you want to do? Are you trying to access the block definition or the reference?

Re: access the objects in the block definition object

jeremye86 — Fri, 10 Aug 2018 15:07:03 GMT

        FilterData(0) = "INSERT"
        FilterType(0) = 0
        Set oSset = acadDoc.SelectionSets.Add("SS1")
        oSset.Select acSelectionSetAll, FilterType, FilterData
        rowperimsht = 1
        lngRow = 1
        For Each objInSelect In oSset
            On Error Resume Next
            effName = objInSelect.EffectiveName
            On Error GoTo 0
           
            If effName = "perimShtDyn" Then
                BlkAtts = objInSelect.GetAttributes
                PerimShtDimsArray(rowperimsht, 1) = BlkAtts(0).textString  ' pm name
                PerimShtDimsArray(rowperimsht, 2) = 1  'qty
                BlkAtts = objInSelect.GetDynamicBlockProperties
                PerimShtDimsArray(rowperimsht, 3) = Round(BlkAtts(0).Value, 3) 'radius
                PerimShtDimsArray(rowperimsht, 4) = Round(BlkAtts(2).Value, 3) 'left len
                PerimShtDimsArray(rowperimsht, 5) = Round(BlkAtts(4).Value, 3)  'right len
                PerimShtDimsArray(rowperimsht, 6) = Round(BlkAtts(6).Value, 3)  ' bottom len
                PerimShtDimsArray(rowperimsht, 7) = Round(BlkAtts(8).Value, 3)   'sht angle
                blockObjects2 = objInSelect.Explode
                PerimShtDimsArray(rowperimsht, 8) = blockObjects2(0).Area
                rowperimsht = rowperimsht + 1
            End If
            effName = ""
        Next objInSelect

I'm trying to get the area of the polyline in the block. The code above gets the area correctly but i don't want to the block exploded. I attached the block in reply.

Re: access the objects in the block definition object

jeremye86 — Fri, 10 Aug 2018 15:09:41 GMT

i believe i am accessing the reference

Re: access the objects in the block definition object

norman.yuan — Mon, 13 Aug 2018 13:49:35 GMT

You do not need to explode to find entities in a block definition (AcadBlock). Simply loop through the block definition to identiy the entity in the block definition. In your case, Assume, the block definition has a closed LwPolyline, which you need to know its area. So the code would be like:

@jeremye86 wrote:

        FilterData(0) = "INSERT"
        FilterType(0) = 0
        Set oSset = acadDoc.SelectionSets.Add("SS1")
        oSset.Select acSelectionSetAll, FilterType, FilterData
        rowperimsht = 1
        lngRow = 1
        
        Dim area As Double

        For Each objInSelect In oSset
            On Error Resume Next
            effName = objInSelect.EffectiveName
            On Error GoTo 0
           
            If effName = "perimShtDyn" Then
                BlkAtts = objInSelect.GetAttributes
                PerimShtDimsArray(rowperimsht, 1) = BlkAtts(0).textString  ' pm name
                PerimShtDimsArray(rowperimsht, 2) = 1  'qty
                BlkAtts = objInSelect.GetDynamicBlockProperties
                PerimShtDimsArray(rowperimsht, 3) = Round(BlkAtts(0).Value, 3) 'radius
                PerimShtDimsArray(rowperimsht, 4) = Round(BlkAtts(2).Value, 3) 'left len
                PerimShtDimsArray(rowperimsht, 5) = Round(BlkAtts(4).Value, 3)  'right len
                PerimShtDimsArray(rowperimsht, 6) = Round(BlkAtts(6).Value, 3)  ' bottom len
                PerimShtDimsArray(rowperimsht, 7) = Round(BlkAtts(8).Value, 3)   'sht angle
                area = GetArea(objInSelect.Name)
                PerimShtDimsArray(rowperimsht, 8) = area
                rowperimsht = rowperimsht + 1
            End If
            effName = ""
        Next objInSelect

Private Function GetArea(blkName As String) As Double

Dim area As Double

Dim blk As AcadBlock

Dim ent As AcadEntity

Dim poly As AcadLWPolyline

Set blk=ThisDrawing.Blocks(blkName)

For Each ent In blk

If TypeOf ent Is AcadLWPolyline Then

Set poly = ent

area = poly.Area

Exit For

End If

GetArea=area

End Function

HTH

Re: access the objects in the block definition object

jeremye86 — Mon, 13 Aug 2018 23:55:41 GMT

thanks for the help but not working as well

error 438 (object doesnt support this property or method) with this line

Set blk=ThisDrawing.Blocks(blkName)

Re: access the objects in the block definition object

norman.yuan — Tue, 14 Aug 2018 14:19:59 GMT

Well, not seeing all your code (and the drawing the code runs upon), I am not sure what is wrong. But to quickly prove my point, following code works perfectly with my AutoCAD 2018:

Option Explicit

Public Sub GetArea()

    Dim ent As AcadEntity
    Dim pt As Variant
    Dim blkRef As AcadBlockReference
    
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a block:"
    If Not ent Is Nothing Then
        If TypeOf ent Is AcadBlockReference Then
            Set blkRef = ent
            GetBlockArea blkRef
        Else
            MsgBox "Selected entity is not a block!"
        End If
    End If
    
End Sub

Private Sub GetBlockArea(blkRef As AcadBlockReference)
    
    Dim blkName As String
    Dim blk As AcadBlock
    Dim ent As AcadEntity
    Dim poly As AcadLWPolyline
    Dim area As Double
    
    blkName = blkRef.Name
    Set blk = ThisDrawing.Blocks(blkName)
    For Each ent In blk
        If TypeOf ent Is AcadLWPolyline Then
            Set poly = ent
            If poly.Closed Then
                area = poly.area
                Exit For
            End If
        End If
    Next
    
    If area > 0# Then
        MsgBox "Block Name" & vbTab & blkRef.Name & "(" & blkRef.EffectiveName & ")" & vbCrLf & _
        "Block Area: " & vbTab & area
    Else
        MsgBox "cannot find closed polyline in the selected block """ & blkName & """!"
    End If
    
End Sub

The following video shows how the code works with 3 block references (of a dynamic block definition):

Re: access the objects in the block definition object

jeremye86 — Tue, 14 Aug 2018 14:59:53 GMT

thanks Norman, i was able to get your code to work.

I'm going to do a speed test to see if your code or

exploding a block reference to get the objects that define it is faster.

I found that i can just delete the exploded objects after getting the properties.

Re: access the objects in the block definition object

jeremye86 — Thu, 16 Aug 2018 14:31:50 GMT

Norman,

I did a speed test and your method is almost 3 times faster . Also you helped me answer my original question. Instead of looping through all object in the block definition i was able to get the first object by using 0 as index.

blkName = objInSelect.Name
Set blk = acadDoc.Blocks(blkName)
PerimShtDimsArray(rowperimsht, 8) = blk(0).area