List blocks in a VBA ListBox

[Netparty]

Hello everyone I started a piece of code, my first listbox (LB_Onglet_Source) displays all the tabs of my drawing when I select a tab I must display in my second listbox (LB_Bloc_Source) the list of blocks for this tab, but my problem is that all the blocks of each tab end up from the second listbox. I would like if I click on presentation1 I only have presentation1 blocks and so on. My code is attached thanks in advance

Dim AcadApp As Object
Dim AcadDoc As Object

'   **********************************************************************************************************

Private Sub UserForm_Initialize()

    Dim AcadApp As Object
    Dim AcadDoc As Object
    Set AcadApp = GetObject(, "AutoCAD.Application")
    Set AcadDoc = AcadApp.ActiveDocument
    Dim onglet As AcadLayout
    
    On Error Resume Next
 
 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    Set AcadApp = GetObject(, "AutoCAD.Application")
    Set AcadDoc = AcadApp.ActiveDocument

    If AcadApp Is Nothing Then
    
    If MsgBox("AUTOCAD n'est pas ouvert" & vbLf & "Voulez-vous ouvrir AUTOCAD", 36, "Ouvrir AUTOCAD") = vbYes Then
   
      Set AcadApp = CreateObject("AutoCAD.Application")
       AcadApp.Visible = True
    End If
   End If



LB_Onglet_Source.Clear


For Each onglet In AcadDoc.Layouts
    'If onglet.Name <> "Model" Then
        LB_Onglet_Source.AddItem onglet.Name
    'End If
Next onglet


End Sub
'   **********************************************************************************************************

'   **********************************************************************************************************

Private Sub LB_Onglet_Source_Change()

Dim obj_onglets As AcadLayouts
Dim obj_onglet As AcadLayout
Dim index As Integer
Dim position As Integer
Dim totaux As Integer

For index = 0 To LB_Onglet_Source.ListCount - 1
If LB_Onglet_Source.Selected(index) = True Then
    position = index
    totaux = totaux + 1
End If


    
    Tb_Onglet_Source = LB_Onglet_Source.List(position)
   
    
    Dim nbrblocs As Integer 'nombre de calques dans le dessin courant
    Dim numbloc As Integer 'nième calque dans la liste
    nbrblocs = ThisDrawing.Blocks.Count
    For numbloc = 1 To nbrblocs
    Me.LB_Bloc_Source.AddItem ThisDrawing.Blocks(numbloc - 1).Name
    Next numbloc

    

Next index

Set obj_onglets = ThisDrawing.Layouts


End Sub

 

[Linh]

Hi, NetParty,

ThisDrawing.Blocks are all block definitions in the drawing.

If you are new, you should know there are 2 terms: AcadBlock object, which is the Block Definition, and AcadBlockReference object, which is the inserted block object.

To get all blocks in a layout tab, got to know:

+ Layout M has as property call Block, which point to the Block Definition part of the layout

+ In that block, you have all the entities in the layout, including all inserted block references.

+ loop through all the entties in the layout by run "For Each ent as Entity in yourlayout.Block ... Next" and check each ent if it is a block reference, then, get the block name and add it to your list. Remember 1 definition can have many inserted references, because you can insert 10 title blocks to your layout tab, which are 10 acadblockreferences of the same block name

There are some more issue in you code like:

 

Set AcadApp = GetObject(, "AutoCAD.Application")

Set AcadDoc = AcadApp.ActiveDocument

If AcadApp Is Nothing Then ...

 

If AcadApp is Nothing, your second line of the above code will crash to error already, no chance to go to the 3rd line.

Happy coding,

[BIGAL]

I dont play much with VBA and if I understand your code,  you can use a selection set should be able to add current layout name as a filter so only return the blocks in that layout. Sorry would have to google how to add layout, in lisp (cons 410  layoutname) so filter code would be 410.

 

Dim SS As AcadSelectionSet
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"

Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

 

Maybe this 
https://www.cadalyst.com/cad/autocad/using-selection-filters-4808#:~:text=In order to use the filter in VBA%2C,the drawing for the objects matching the filter.

 

Edited January 18, 2022 by BIGAL