VB Macro to Count Blocks

I hope you can use some of this code to manage what you want, I am at work now but I have some lisp code that can be used if you want !!

Use scale factors with XP option of ZOOM command

Use VBA to access blocks and block reference data

Use VBA to access blocks and block reference data

Published date: 2002-02-21
ID: TS70489

Applies to:
AutoCAD® 2002
AutoCAD® 2000i
AutoCAD® 2000
AutoCAD® Release 14

Issue



This document explains how to access blocks and block reference data using VBA (Visual Basic for Applications).
Solution



Overview

You can use VBA to manage blocks and block references.

A block is a collection of objects that you associate together to form a single object, called a block definition.  When you insert a block in a drawing, you create a block reference. That is, the block reference references the block definition. It is important to know the difference between a block definition and a block reference, because it helps you to understand how you can manipulate these objects in VBA.

We explain how to do this by commenting a short program that illustrates the process. The following sections use commented code examples that show you how to access blocks (block definitions) and block reference data using VBA.

Create the application interface

Assume that you have defined a main form in VBA, with the following controls:
ListBox named lstBlockObject  
ListBox named lstBlockReference  
Command Button named cmdCreateBlock  
Command Button named cmdLister  
Command Button named cmdChangeColor

Create a module and add the following declarations.

'Blocks collection
Public blkColl As AcadBlocks
'Block object
Public BlkObj As AcadBlock
'Block reference object
Public BlkRefrence As AcadBlockReference
'ModelSpace collection
Public mspace As AcadModelSpace
'PaperSpace collection
Public pspace As AcadPaperSpace
Public count As Integer
Public I As Integer
Public elem As Object
Public subelem As Object
'Block insertion point
Public blkInsPnt (0 To 2) As Double
Public circleObj As AcadCircle
'Circle center point
Public center(0 To 2) As Double
'Circle radius
Public radius As Double
Public lineObj as AcadLine
'Line start point
Public startPnt (0 To 2) As Double
'Line end point
Public endPnt (0 To 2) As Double

Add the following declarations to the Initialize event of the form.

'Returns the ModelSpace collection
Set mspace = ThisDrawing.ModelSpace
'Returns the PaperSpace collection
Set pspace = ThisDrawing.PaperSpace
'Returns the blocks collection
Set blkColl = ThisDrawing.Blocks

Create a block

To create a block reference, first you must create a block definition (block). You do this using the Add method. After you create the block you can insert an instance of it into the drawing using the InsertBlock method. In this example, we create a block in model space that is made up of a circle and a line.

Add the following code to the Click event procedure of the cmdCreateBlock button.

blkInsPnt(0) = 0#: blkInsPnt(1) = 0#: blkInsPnt(2) = 0#
'Add the block to the blocks collection
Set BlkObj = blkColl.Add(blkInsPnt, "NewBlock")

Add elements to block

This section provides the code examples that add the elements to the block.

Add the circle

center(0) = 0#: center(1) = 0#: center(2) = 0#
radius = 1
'Add the circle to the block
Set circleObj = BlkObj.AddCircle(center, radius)

Add the line

startPnt(0) = 1#: startPnt(1) = 1#: startPnt(2) = 0#
endPnt(0) = 5#: endPnt(1) = 5#: endPnt(2) = 0#
'Add the line to the block
Set lineObj = BlkObj.AddLine(startPnt, endPnt)

Insert the block in model space

The following code example inserts the block in model space.

Set BlkRefrence = mspace.InsertBlock(blkInsPnt, "NewBlock", 1#, 1#, 1#, 0)
'Zooming the block
ZoomExtents

Access the Block and BlockReference Objects

VBA provides a link to the active drawing in the current AutoCAD session through the ThisDrawing object. By using ThisDrawing, you gain immediate access to the current Document object and all of its methods and properties, and all of the other objects in the hierarchy.

To access a block, you refer to the ThisDrawing object; to access a block reference you refer to the ModelSpace or PaperSpace collection.

Access the block objects

You now need to scan the Block collection, retrieve block names and put them in the ListBox lstBlockObject. There are two ways to scan the Block collection.

You can use an index to scan the Block collection. Once you know how many items the collection contains, you can use a For.Next conditional statement. To do this, add the following code to the Click event procedure of the cmdLister button.

'Returns number of blocks in the blocks collection
count = blkColl.count
'Clear the list box
lstBlockObject.Clear
'Create the block list
For I = 0 To count - 1
 lstBlockObject.AddItem blkColl.Item(I).Name
Next
lstBlockObject.ListIndex = 0

Note: In a collection of N items, the index goes from 0 to N-1.

However, a better way is to use a For Each.In.Next conditional statement. For example, the following statements repeat a block of statements for each object in a collection or each element in an array. VBA automatically sets a variable each time the loop runs. Therefore you could rewrite the previous code using the following example.

'Clear the list box
lstBlockObject.Clear
'Create the block list
For Each elem in ThisDrawing.Blocks
 lstBlockObject.AddItem elem.Name
Next
lstBlockObject.ListIndex = 0

By using this alternative code you
Reduce the number of operations.
Improve code readability.
Reduce the number of user variables.
Reduce the need for error checking (for example, the range control for conditional statements).
Implement a more elegant programming style.

Access the block references

To retrieve similar entities, you perform a similar set of operations; but instead of searching the Blocks collection, you need to search the ModelSpace or PaperSpace collection of an AutoCAD ActiveDocument. To do this, add the following code to the Click event procedure of the cmdLister button.

'Clear the list box
lstBlockReference.Clear
'Create the block list
'Scanning the Model Space collection
For Each elem In mspace
 'Filter only the block references
 If elem.EntityName = "AcDbBlockReference" Then
  lstBlockReference.AddItem elem.Name
 End If
Next
lstBlockReference.ListIndex = 0

At this point, every time you click the Create block button, you only have one block called NEWBLOCK in the ListBox lstBlockObject. However, a new block reference called NEWBLOCK is added to the ListBox lstBlockReference. The new block reference is appended, because you created a new reference to the block (block definition).

Note: Even if the block reference has the same name as existing block references, the handle is different. To AutoCAD, they are different objects.

Modify objects within the block

You can modify an object within a block without exploding the block. To do this, you need to go inside the block object, retrieve the entity to modify and change its properties. The following code example changes the color property of the line to Red.

Add the following code to the Click event procedure of the cmdChangeColor button:

'Scanning the blocks collection
For Each elem In blkColl'Searching the block we want
 If elem.Name = "NewBlock" Then
 'Scanning the block entities
  For Each subelem In elem
    'Filter the line
    If subelem.EntityName = "AcDbLine" Then
     'Assign a new color
     subelem.Color = acRed
    End If
  Next
 End If
Next
'Regenerating the drawing
ThisDrawing.Regen True

This code changes the color property for the line in all block references called NEWBLOCK. What actually happens is that the code changes the color property for the line in the block object (the block definition) and the references are updated because they reference the block object.
See also


Using VBA to modify how AutoCAD DesignCenter inserts blocks

Removing invisible text from a drawing

Drawing is completely empty but file size is very large


Regards
oldelphi

Here is the exact code you need:

Sub main()
  Dim blk As AcadEntity
  Dim ent As AcadEntity
  Dim newblk As AcadBlockReference
  Dim pnt As Variant
  Dim cnt As Integer
  Dim blkName As String
 
  On Error GoTo ExitError
 
  AppActivate ("AutoCAD")
  ThisDrawing.Utility.GetEntity blk, pnt, "Select block:"
  If TypeName(blk) = "IAcadBlockReference" Then
       blkName = blk.Name
       For Each ent In ThisDrawing.ModelSpace
          If TypeName(ent) = "IAcadBlockReference" Then
             If ent.Name = blkName Then
                cnt = cnt + 1
             End If
          End If
       Next
    Else
     MsgBox "You've selected a " & TypeName(blk) & Chr(13) & "A block must be selected."
     Exit Sub
  End If
  MsgBox cnt & " occurences of " & blkName
  Exit Sub

ExitError:
  MsgBox Err.Description
End Sub