Visual Basic Customization

Visual Basic Customization

Reply
New Member
whozi
Posts: 2
Registered: ‎11-14-2012
Message 1 of 3 (168 Views)
Accepted Solution

Problem to populate a Listbox with information from Entities

168 Views, 2 Replies
11-14-2012 03:03 AM

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.

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

 

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 3 (154 Views)

Re: Problem to populate a Listbox with information from Entities

11-14-2012 12:17 PM in reply to: whozi

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

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
New Member
whozi
Posts: 2
Registered: ‎11-14-2012
Message 3 of 3 (145 Views)

Re: Problem to populate a Listbox with information from Entities

11-14-2012 10:21 PM in reply to: Hallex

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.

 

 

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.