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.
Solved! Go to 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
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.