Block Counter

[cadd4la]

Hello VBAer's

I am trying to write my first VBA program, understand what this code does, and as my knowledge of VBA grows add more features to this code. But because my job limits the amount of time that I can spend doing coding, I am looking to get help in getting me started w/ this code.

In version 1.0 - I am looking to have the block counter have a userform that will do block counting one of three ways:

- All the blocks in the drawing,
- by the user picking one of the blocks and it counts all of the blocks on that layer
or
- by the user enter the block name using a wildcard (i.e., S-*)

I also need it to minus 1 from the total count for the block in the legend.

I have started the layout of the userform.

I thank you for the help.

Kyle C.

[Ed Jobe]

The count part is easy. A selectionset object has a Count property. The part you need is building a filtered selectionset of blocks. If you search this forum for "block" and "filter", you should find the code and explanations you require.

[cadd4la]

Ed,

Couldn't find anything that I understand that would do as you said by doing a forum search, I also did a exchange search as well.

Thanks,

Kyle C.

The count part is easy. A selectionset object has a Count property. The part you need is building a filtered selectionset of blocks. If you search this forum for "block" and "filter", you should find the code and explanations you require.

[zoomharis]

Couldn't find anything that I understand that would do as you said by doing a forum search, I also did a exchange search as well.

Hi Kyle,
If you are working with blocks, the following thread may provide some help.

http://forums.augi.com/showthread.php?t=34880

Hope that helps.

har!s

[Ed Jobe]

Searching on just "filter" returned 17. I thought this one would suit you best. You are going to need several selecion methods though.

The first method is the easiest. Just filter your selection set for all blocks.

Second you will need to prompt the user for a name. I would suggest getting a list from the Blocks collection and populating a listbox, so the user doesn't have to guess what has been inserted and you avoid "speeling" errors. Then, when they select a name, build a filtered selection set. Tip: Instead of a wildcard, the user can select multiple names from the listbox if you enable multi-select.

[cadd4la]

Ed,

This is over my head .

I am trying to write my first VBA program...

Searching on just "filter" returned 17. I thought this one would suit you best. You are going to need several selecion methods though.

The first method is the easiest. Just filter your selection set for all blocks.

Second you will need to prompt the user for a name. I would suggest getting a list from the Blocks collection and populating a listbox, so the user doesn't have to guess what has been inserted and you avoid "speeling" errors. Then, when they select a name, build a filtered selection set. Tip: Instead of a wildcard, the user can select multiple names from the listbox if you enable multi-select.

[Opie]

Ed,

This is over my head .

Look at this post within th thread (Find a block attribute by Tag and replace Value), which Ed referred to above.

[cadd4la]

Opie,

The blocks that I need counted do not have attributes in them, I need them counted by all in the drawing, by number on a picked layer, or by name of block using a wildcard). And how do I code for the userform?

Still

Kyle C.

Look at this post within th thread (Find a block attribute by Tag and replace Value), which Ed referred to above.

[zoomharis]

The blocks that I need counted do not have attributes in them, I need them counted by all in the drawing, by number on a picked layer, or by name of block using a wildcard).

Hi Kyle,
I have done some coding for you. Please give me a feedback on the functionality and errors.

Sub BlockCount_Test()
	dispBlockCount "COUNT_ALL"
	dispBlockCount "COUNT_BY_LAYER"
	dispBlockCount "COUNT_BY_FILTER"
End Sub

Sub dispBlockCount(ByVal strAction As String)
On Error Resume Next
Dim objBlkSet As AcadSelectionSet
Dim objBlkRef As AcadBlockReference
Dim iGpCode(0) As Integer
Dim vDataVal(0) As Variant
Dim iSelMode As Integer
Dim iBlkCnt As Integer
iGpCode(0) = 0
vDataVal(0) = "INSERT"
iBlkCnt = 0
iSelMode = 0  '|-- Selection Modes (0 = Select All, 1 = Select On Screen) --|
Set objBlkSet = getSelSet(iGpCode, vDataVal, iSelMode)
Select Case strAction
Case "COUNT_ALL"
	MsgBox objBlkSet.Count, , "Total Block Count"
Case "COUNT_BY_LAYER"
	Dim objCadEnt As AcadEntity
	Dim vBasePnt As Variant
	ThisDrawing.Utility.GetEntity objCadEnt, vBasePnt, "Pick a block reference:"
	If Err.Number <> 0 Then
		MsgBox "No block references selected."
		objBlkSet.Delete
		Exit Sub
	Else
		If objCadEnt.ObjectName = "AcDbBlockReference" Then
			Dim objCurBlkRef As AcadBlockReference
			Dim strLyrName As String
			Set objCurBlkRef = objCadEnt
			strLyrName = objCurBlkRef.Layer
			For Each objBlkRef In objBlkSet
				If StrComp(objBlkRef.Layer, strLyrName, vbTextCompare) = 0 Then
					iBlkCnt = iBlkCnt + 1
				End If
			Next
			MsgBox "There are " & iBlkCnt & " block(s) in the layer " & strLyrName, , "Count by Layer"
		Else
			ThisDrawing.Utility.prompt "The selected object is not a block reference."
		End If
	End If
Case "COUNT_BY_FILTER"
	Dim strFilter As String
	strFilter = ThisDrawing.Utility.GetString(False, "Enter a filter option <*>")
	If strFilter <> "" Then
		For Each objBlkRef In objBlkSet
			If UCase(objBlkRef.Name) Like UCase(strFilter) Then
				iBlkCnt = iBlkCnt + 1
			End If
		Next
	Else
		iBlkCnt = objBlkSet.Count
	End If
	MsgBox "Search found " & iBlkCnt & " block(s) in the drawing.", , "Count by Filter"
Case Else
	ThisDrawing.Utility.prompt "Invalid action mode...."
End Select
objBlkSet.Delete
If Err.Number <> 0 Then
	ThisDrawing.Utility.prompt Err.Description
End If
End Sub

Function getSelSet(ByRef iGpCode() As Integer, vDataVal As Variant, iSelMode As Integer) As AcadSelectionSet
Dim objSSet As AcadSelectionSet
Set objSSet = ThisDrawing.SelectionSets.Add("EntSet")
Select Case iSelMode
Case 0
	objSSet.Select acSelectionSetAll, , , iGpCode, vDataVal
Case 1
ReSelect:
	objSSet.SelectOnScreen iGpCode, vDataVal
	If objSSet.Count = 0 Then
		Dim iURep As Integer
		iURep = MsgBox("No entities selected, Do you want to select again?", _
		vbYesNo, "Select Entity")
		If iURep = 6 Then GoTo ReSelect
		objSSet.Delete
		Set getSelSet = Nothing
		Exit Function
	End If
Case Else
	ThisDrawing.Utility.prompt "Invalid selection mode...."
End Select
Set getSelSet = objSSet
End Function

And how do I code for the userform?
Kyle C.

Since i don't know anything about your userform design, I can not incorporate the code with the form. If you want to use a userform, it's better to convert the dispBlockCount precedure to a function. It's an easy task too.

Hope that helps.


har!s

[cadd4la]

zoomharis,

Thanks for the code, I will look at it later.

The start of the userform is in the code that I upload in my original post.

Thanks

Kyle C.

Hi Kyle,
I have done some coding for you. Please give me a feedback on the functionality and errors.

Sub BlockCount_Test()
	dispBlockCount "COUNT_ALL"
	dispBlockCount "COUNT_BY_LAYER"
	dispBlockCount "COUNT_BY_FILTER"
End Sub
 
Sub dispBlockCount(ByVal strAction As String)
On Error Resume Next
Dim objBlkSet As AcadSelectionSet
Dim objBlkRef As AcadBlockReference
Dim iGpCode(0) As Integer
Dim vDataVal(0) As Variant
Dim iSelMode As Integer
Dim iBlkCnt As Integer
iGpCode(0) = 0
vDataVal(0) = "INSERT"
iBlkCnt = 0
iSelMode = 0 '|-- Selection Modes (0 = Select All, 1 = Select On Screen) --|
Set objBlkSet = getSelSet(iGpCode, vDataVal, iSelMode)
Select Case strAction
Case "COUNT_ALL"
	MsgBox objBlkSet.Count, , "Total Block Count"
Case "COUNT_BY_LAYER"
	Dim objCadEnt As AcadEntity
	Dim vBasePnt As Variant
	ThisDrawing.Utility.GetEntity objCadEnt, vBasePnt, "Pick a block reference:"
	If Err.Number <> 0 Then
		MsgBox "No block references selected."
		objBlkSet.Delete
		Exit Sub
	Else
		If objCadEnt.ObjectName = "AcDbBlockReference" Then
			Dim objCurBlkRef As AcadBlockReference
			Dim strLyrName As String
			Set objCurBlkRef = objCadEnt
			strLyrName = objCurBlkRef.Layer
			For Each objBlkRef In objBlkSet
				If StrComp(objBlkRef.Layer, strLyrName, vbTextCompare) = 0 Then
					iBlkCnt = iBlkCnt + 1
				End If
			Next
			MsgBox "There are " & iBlkCnt & " block(s) in the layer " & strLyrName, , "Count by Layer"
		Else
			ThisDrawing.Utility.prompt "The selected object is not a block reference."
		End If
	End If
Case "COUNT_BY_FILTER"
	Dim strFilter As String
	strFilter = ThisDrawing.Utility.GetString(False, "Enter a filter option <*>")
	If strFilter <> "" Then
		For Each objBlkRef In objBlkSet
			If UCase(objBlkRef.Name) Like UCase(strFilter) Then
				iBlkCnt = iBlkCnt + 1
			End If
		Next
	Else
		iBlkCnt = objBlkSet.Count
	End If
	MsgBox "Search found " & iBlkCnt & " block(s) in the drawing.", , "Count by Filter"
Case Else
	ThisDrawing.Utility.prompt "Invalid action mode...."
End Select
objBlkSet.Delete
If Err.Number <> 0 Then
	ThisDrawing.Utility.prompt Err.Description
End If
End Sub
 
Function getSelSet(ByRef iGpCode() As Integer, vDataVal As Variant, iSelMode As Integer) As AcadSelectionSet
Dim objSSet As AcadSelectionSet
Set objSSet = ThisDrawing.SelectionSets.Add("EntSet")
Select Case iSelMode
Case 0
	objSSet.Select acSelectionSetAll, , , iGpCode, vDataVal
Case 1
ReSelect:
	objSSet.SelectOnScreen iGpCode, vDataVal
	If objSSet.Count = 0 Then
		Dim iURep As Integer
		iURep = MsgBox("No entities selected, Do you want to select again?", _
		vbYesNo, "Select Entity")
		If iURep = 6 Then GoTo ReSelect
		objSSet.Delete
		Set getSelSet = Nothing
		Exit Function
	End If
Case Else
	ThisDrawing.Utility.prompt "Invalid selection mode...."
End Select
Set getSelSet = objSSet
End Function

Since i don't know anything about your userform design, I can not incorporate the code with the form. If you want to use a userform, it's better to convert the dispBlockCount precedure to a function. It's an easy task too.

Hope that helps.


har!s