Problem to populate a Listbox with information from Entities

[whozi]

Hi,

i have a little Problem here.

What i want to do is popluate a Listbox with with the area of previously selected Objects.

This is what i have at the moment:

i = 0
ListBox1.ColumnCount = 2

For Each ssetOBJ In sset
 objarea = ssetOBJ.Area
 i = i + 1
 With ListBox1
   .AddItem
   .List(.ListCount - i, 0) = "Fläche"
   .List(.ListCount - i, 1) = objarea
 End With
 Next

 But the code only writes the area of the last Object in the first Row of the Listbox.

I think in the FOR EACH Expression the variable "i" pass always "1" for the Row Number.

Anyone knows why?

Thx for Help.

[Hallex · Accepted solution]

You need to use 2 column listbox,

so you may want to use this code

just very basic though, change to suit

Private Sub CommandButton1_Click()
Me.Hide
     Dim oSset As AcadSelectionSet
     Dim oEnt As AcadEntity
     Dim fcode(0 To 1) As Integer
     Dim fData(0 To 1) As Variant
     Dim dxfcode, dxfdata
     Dim i As Integer, j As Integer, n As Integer, m As Integer, k As Integer
     Dim setName As String

     fcode(0) = 0
     fData(0) = "LWPOLYLINE"
    fcode(1) = 70
     fData(1) = 1
     dxfcode = fcode
     dxfdata = fData
     setName = "$PolyLines$"

     '// make sure the selection set does not exist
     For i = 0 To ThisDrawing.SelectionSets.Count - 1
          If ThisDrawing.SelectionSets.Item(i).Name = setName Then
               ThisDrawing.SelectionSets.Item(i).Delete
               Exit For
          End If
     Next i
     
     Set oSset = ThisDrawing.SelectionSets.Add(setName)
    ' oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
    oSset.SelectOnScreen dxfcode, dxfdata
 

     ' loop all polylines
     ReDim dataArr(oSset.Count - 1, 0 To 1)

     For n = 0 To oSset.Count - 1
          Dim cEnt As AcadEntity
          Set cEnt = oSset.Item(n)
          Dim intPoints() As Variant

               Dim oPline As AcadLWPolyline
               Set oPline = cEnt
               Dim ar As Double
               ar = oPline.Area
               Dim lyr As String
               lyr = oPline.Layer
    dataArr(n, 0) = ar
    dataArr(n, 1) = lyr
     Next n
     
     oSset.Erase
     
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "3cm;4cm"
ListBox1.ColumnHeads = True

ReDim layArr(0 To UBound(dataArr, 1), 0 To 1) As Variant
For i = 1 To UBound(dataArr, 1)
layArr(i - 1, 0) = dataArr(i - 1, 0)
layArr(i - 1, 1) = dataArr(i - 1, 1)
Next i

ListBox1.List() = layArr
Me.Show
End Sub

[whozi]

Very nice and clean code. Thx for Helping me out.

So i dont posted all my code.

I have found a Solution by myself.

I will post the code and the Solution that i found here as soon as possible.