How to count the number of instances of a block using VBA

Hi G'men,

I'm using VBA to retrieve the block names that are used in a drawing. Here i lack knowledge about block instances. If there are two numbers of similar blocks with same name, how to retrieve their instance number to VBA.

Can anyone help me on this regard.

Thanks,
Kamalesh.

 

Be careful of word-wrapping here!

Put the following code in a class module called 'Class1'

Public PartNumber As String
Public Count As Long



Public the following code in the ThisDrawing module

'DXF Group Code Constants
Const ENTITY = 0 'an entity

Public Components As New Collection

Public Function CreateSelectionSet(SelectionSet As AcadSelectionSet, _
FilterCode As Integer, _
FilterValue As String) As Boolean
Dim intFilterCode(0) As Integer
Dim varFilterValue(0) As Variant

'assume success
CreateSelectionSet = True

intFilterCode(0) = FilterCode
varFilterValue(0) = FilterValue

SelectionSet.Select acSelectionSetAll, , , intFilterCode, varFilterValue

If SelectionSet.Count < 1 Then
CreateSelectionSet = False
End If
End Function

Public Sub CountBlockRefs()
Dim objSS As AcadSelectionSet
Dim BlockRef As AcadBlockReference
Dim Index As Long
Dim Attribs As Variant
Dim AttributeRef As AcadAttributeReference
Dim Count As Long
Dim Component As New Class1
Dim MessageString As String

On Error Resume Next
ThisDrawing.SelectionSets("Inserts").Delete
On Error GoTo 0

Set objSS = ThisDrawing.SelectionSets.Add("Inserts")

'zero the Components class object
Set Components = Nothing

If CreateSelectionSet(objSS, ENTITY, "INSERT") Then
For Index = 0 To objSS.Count - 1
Set BlockRef = objSS(Index)
On Error Resume Next
Set Component = Components(BlockRef.Name)

If Err Then
Err.Clear

On Error GoTo 0

Component.Count = 1
Component.PartNumber = BlockRef.Name

Components.Add Component, Component.PartNumber

Else
Components(BlockRef.Name).Count = Components(BlockRef.Name).Count
+ 1
End If

Set Component = Nothing
Next Index

With Components
For Index = 1 To .Count
MessageString = MessageString & .Item(Index).PartNumber & vbTab &
"Qty: " & .Item(Index).Count & vbCrLf
Next Index
End With
End If

If Components.Count Then
MsgBox MessageString

Else
MsgBox "There are no components in this drawing!", vbCritical,
"Error - No Components"
End If
End Sub

i lack knowledge about block instances. If there are two numbers of similar
blocks with same name, how to retrieve their instance number to VBA.