Count Blocks

[Rosems]

Hello,
I need to count block in many levels, i can block with 5 levels.
Maybe someone can help, with any recommendation?
Best Regards

    <Autodesk.AutoCAD.Runtime.CommandMethod("Bcount")>
    Public Sub Blockcount()

        Dim myExcel As Object = CreateObject("Excel.Application")
        myExcel.Visible = True
        Dim myWB As Object = myExcel.Workbooks.Add
        Dim myDesktop As String = My.Computer.FileSystem.SpecialDirectories.Desktop
        Dim curRow As Integer = 1

        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Using trx As Transaction = db.TransactionManager.StartTransaction()
            Dim bt As BlockTable = trx.GetObject(db.BlockTableId, OpenMode.ForRead)
            For Each btrId As ObjectId In bt

                Dim btr As BlockTableRecord = trx.GetObject(btrId, OpenMode.ForRead)
                Dim refIds As ObjectIdCollection = btr.GetBlockReferenceIds(False, False)

                If btr.Name.Contains("Y") Then
                        If Not btr.IsLayout Then


                        myExcel.ActiveSheet.Cells(curRow, "F").value = refIds.Count.ToString
                        myExcel.ActiveSheet.Cells(curRow, "A").value = DateTime.Now.ToString
                        myExcel.ActiveSheet.Cells(curRow, "B").value = doc.Window.Text
                        myExcel.ActiveSheet.Cells(curRow, "C").value = "Price"
                        myExcel.ActiveSheet.Cells(curRow, "D").value = btr.Name
                        myExcel.ActiveSheet.Cells(curRow, "E").value = btr.Comments

                        curRow += 1

                        End If
                    End If
                Next


            db.Dispose()
        End Using


        myWB.SaveAs(IO.Path.Combine(myDesktop, "Furnitura.xlsx"))
        myWB = Nothing
        myExcel = Nothing


    End Sub

 

[PeterPan9720]

2 hours ago, Rosems said:

Hello,
I need to count block in many levels, i can block with 5 levels.
Maybe someone can help, with any recommendation?
Best Regards

    <Autodesk.AutoCAD.Runtime.CommandMethod("Bcount")>
    Public Sub Blockcount()

        Dim myExcel As Object = CreateObject("Excel.Application")
        myExcel.Visible = True
        Dim myWB As Object = myExcel.Workbooks.Add
        Dim myDesktop As String = My.Computer.FileSystem.SpecialDirectories.Desktop
        Dim curRow As Integer = 1

        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Using trx As Transaction = db.TransactionManager.StartTransaction()
            Dim bt As BlockTable = trx.GetObject(db.BlockTableId, OpenMode.ForRead)
            For Each btrId As ObjectId In bt

                Dim btr As BlockTableRecord = trx.GetObject(btrId, OpenMode.ForRead)
                Dim refIds As ObjectIdCollection = btr.GetBlockReferenceIds(False, False)

                If btr.Name.Contains("Y") Then
                        If Not btr.IsLayout Then


                        myExcel.ActiveSheet.Cells(curRow, "F").value = refIds.Count.ToString
                        myExcel.ActiveSheet.Cells(curRow, "A").value = DateTime.Now.ToString
                        myExcel.ActiveSheet.Cells(curRow, "B").value = doc.Window.Text
                        myExcel.ActiveSheet.Cells(curRow, "C").value = "Price"
                        myExcel.ActiveSheet.Cells(curRow, "D").value = btr.Name
                        myExcel.ActiveSheet.Cells(curRow, "E").value = btr.Comments

                        curRow += 1

                        End If
                    End If
                Next


            db.Dispose()
        End Using


        myWB.SaveAs(IO.Path.Combine(myDesktop, "Furnitura.xlsx"))
        myWB = Nothing
        myExcel = Nothing


    End Sub

 

Hello, I guess you mean with "levels" layer ? and concerning the above code it's not VBA ? seems some other language, it's a MUST? on the opposite I can suggest you a VBA procedure.

[Rosems]

5 minutes ago, PeterPan9720 said:

Hello, I guess you mean with "levels" layer ? and concerning the above code it's not VBA ? seems some other language, it's a MUST? on the opposite I can suggest you a VBA procedure.

Hello,
I have created block in the block in the block... and need to count all block with same name. I can count object in drawing or blockreference in drawing, but only in one level.
I add one dwg for example.
 

Feet.dwg

[PeterPan9720]

1 hour ago, Rosems said:

Hello,
I have created block in the block in the block... and need to count all block with same name. I can count object in drawing or blockreference in drawing, but only in one level.
I add one dwg for example.
 

Feet.dwg 55.45 kB · 0 downloads

I I understand, you mean nested blocks. Here a lsp procedure which show you on command typing bar the different names of blocks, I'm not so expert with lsp but I tried and it works.

see https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/report-number-of-nested-blocks/m-p/6340079/highlight/true#M341484

I'll try more with VBA, but sincerly I never had a similar issue.

[Rosems]

8 minutes ago, PeterPan9720 said:

I I understand, you mean nested blocks. Here a lsp procedure which show you on command typing bar the different names of blocks, I'm not so expert with lsp but I tried and it works.

see https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/report-number-of-nested-blocks/m-p/6340079/highlight/true#M341484

I'll try more with VBA, but sincerly I never had a similar issue.

It's not working, count only total quantity with top level blocks. I add example .xlsx.. what can i need

Feet.xlsx

[PeterPan9720]

1 minute ago, Rosems said:

It's not working, count only total quantity with top level blocks. I add example .xlsx.. what can i need

Feet.xlsx 12.93 kB · 0 downloads

Sorry but this is my result, I know the lsp routine doesn't count but you can modify and adapt to your use.

(("YFHE-0079689" "YFSK3.5-35") ("Feet_50" "YFHE-0044747" "YFHE-0079689" "URB_15x13"))

and this is the screenshot of nested block Feet_50 for example, and are the same, not only first level, but also the nested

[PeterPan9720]

This code should work,

unfortunately for a correct count you have to check the name and count it, or as alternative count how many times the same name will be find.

the result on your drawing shall be:

 

YFHE-0044747 6              YFHE-0079689 6             YFSK3.5-35 18            URB_15x13 12              

 

exactly as reference picture for just 1 block shown (total multiplied by 6).

Sub Block_Nested()
    Dim oblk As AcadBlock
    Dim oBlk1 As AcadBlock
    Dim oBlkRef As AcadBlockReference
    Dim oBlkRef1 As AcadBlockReference
    Dim MYoEnt As AcadEntity
    Dim oEnt1 As AcadEntity
    Dim MySelection As AcadSelectionSet
On Error Resume Next
Set MySelection = ThisDrawing.SelectionSets("Myss")
If Err Then Set MySelection = ThisDrawing.SelectionSets.Add("Myss")
MySelection.Clear
On Error GoTo 0
        MySelection.Select acSelectionSetAll ', , , FilterType, FilterData
       ' MySelection.SelectOnScreen 'FilterType, FilterData
       
    For Each oBlkRef In MySelection
        Set oblk = ThisDrawing.Blocks(oBlkRef.Name)
        
            For Each MYoEnt In oblk
                If TypeOf MYoEnt Is AcadBlockReference Or TypeOf oEnt Is AcadBlock Then
                    Set oBlkRef1 = MYoEnt
                    Set oBlk1 = ThisDrawing.Blocks(oBlkRef1.Name)
                    
                    If TypeOf MYoEnt Is AcadBlockReference Then

                            If oBlk1.Name = "YFHE-0044747" Then
                                Type1 = Type1 + 1
                            End If
                            If oBlk1.Name = "YFHE-0079689" Then
                                Type2 = Type2 + 1
                            End If
                            If oBlk1.Name = "URB_15x13" Then
                                Type3 = Type3 + 1
                            End If
                            If oBlk1.Name = "YFSK3.5-35" Then
                                Type4 = Type4 + 1
                            End If
                    End If
                    
                    For Each oEnt1 In oBlk1
                        If TypeOf oEnt1 Is AcadBlockReference Or TypeOf oEnt1 Is AcadBlock Then
                            Set oBlkRef1 = oEnt1
                            Set oBlk2 = ThisDrawing.Blocks(oBlkRef1.Name)
                    
                           If oBlk2.Name = "YFSK3.5-35" Then
                                Type4 = Type4 + 1
                            End If
                    End If
                    Next oEnt1
                End If
                
            Next MYoEnt
    Next oBlkRef

    Debug.Print "YFHE-0044747 " & Type1, "YFHE-0079689 " & Type2, "URB_15x13 " & Type3, "YFSK3.5-35 " & Type4

    ThisDrawing.Regen acAllViewports
End Sub

Of course the excel part it's missing but you should know how to fix it.

Edited February 9, 2020 by PeterPan9720