access the objects in the block definition object
Can you show all your code? What do you want to do? Are you trying to access the block definition or the reference?
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
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
End If
GetArea=area
End Function
HTH
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):
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
