| Count Blocks |
 |
 |
 |
| Tutorials | |||||||||||
|
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 SubOPTION 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 SubThe code will result in the following view: 
|
Comments
RSS feed for comments to this post