22 | 02 | 2017

Count Blocks

The following code will show all blocks in modelspace

OPTION 1


Sub Countblocks()

'****************************************
'*** Code from VisibleVisual.com ********
'****************************************

Dim oBkRef As AcadBlockReference
Dim ent As AcadEntity
Dim a As Variant
Dim Value As String

Value = "The following blocks are in modelspace" & vbCr

For Each ent In ThisDrawing.ModelSpace

If ent.ObjectName = "AcDbBlockReference" Then
Set oBkRef = ent

Value = Value & "- " & oBkRef.EffectiveName & vbCr
End If
Next ent

MsgBox Value

End Sub

OPTION 2


Code above only displayes the blocks in modelspace but if multiple of the same blocks are in modelspace then double items exist. If we modificate the code and add a userform and listbox (called LstBlocks) then the code blow can display how many off the same blocks are in the drawing. (Make sure that the ColumnCount of the LstCount is set to 2)

Sub Countblocks()

'****************************************
'*** Code from VisibleVisual.com ********
'****************************************

Dim oBkRef As AcadBlockReference
Dim ent As AcadEntity

For Each ent In ThisDrawing.ModelSpace

If ent.ObjectName = "AcDbBlockReference" Then
Set oBkRef = ent


With LstBlocks

'Search if item exists in listbox
For n = 0 To .ListCount - 1
'Raise the amount with 1
If .list(n) = oBkRef.EffectiveName Then
.list(n, 1) = .list(n, 1) + 1
GoTo Nextn
End If
Next n

'If item does not exist then add item
LstBlocks.AddItem oBkRef.EffectiveName
LstBlocks.list(n, 1) = 1

Nextn:

End With

End If

Next ent

End Sub

The code will result in the following view:

Download the source code below (Registered users only). 

Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2174938
Latest Articles