Visual Basic Customization

Visual Basic Customization

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

Problem to populate a Listbox with information from Entities

173 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 (159 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 (150 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.

 

 

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Are You Going To Be @ AU 2014? Feel free to drop by our AU topic post and share your plans, plug a class that you're teaching, or simply check out who else from the community might be in attendance. Ohh and don't forgot to stop by the Autodesk Help | Learn | Collaborate booths in the Exhibit Hall and meet our community team if you get a chance!