Rosems Posted February 7, 2020 Posted February 7, 2020 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 Quote
PeterPan9720 Posted February 7, 2020 Posted February 7, 2020 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. Quote
Rosems Posted February 7, 2020 Author Posted February 7, 2020 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 Quote
PeterPan9720 Posted February 7, 2020 Posted February 7, 2020 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. 1 Quote
Rosems Posted February 7, 2020 Author Posted February 7, 2020 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 Quote
PeterPan9720 Posted February 7, 2020 Posted February 7, 2020 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 Quote
PeterPan9720 Posted February 7, 2020 Posted February 7, 2020 (edited) 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 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.