---

Hallo zusammen,

ich bin dabei mir eine Maske mit einer ComboBox zu erstellen, in der alle in der Zeichnung vorkommenden Layouts aufgelistet werden. Befindet man sich bereits im Layoutbereich soll das aktive Layout den ListIndex=0 sein, also ganz oben stehen. Dies funktioniert soweit.
Nun zum Problem: Ich will die ComboBox so sortieren, dass das erste Layout (Taborder=0) vorne steht und das letzte in der Liste ganz unten auftaucht, nicht wie vorgegeben alphabetisch. Hier mal der Code:

'Papierlayouts in Combobox zusammenfassen

Dim ACTLayout As AcadLayout
Dim Taborder As String

Set ACTLayout = ThisDrawing.ActiveLayout
ComboBoxLAY.Clear
If ThisDrawing.ActiveSpace = acPaperSpace Then
    Taborder = ThisDrawing.ActiveLayout.Taborder - 1
Else: Taborder = 0
End If
For Each ACTLayout In ThisDrawing.Layouts
  If ACTLayout.ModelType = False Then
        ComboBoxLAY.AddItem ACTLayout.Name
  End If
Next

ComboBoxLAY.ListIndex = Taborder

Über eure Hilfe würde ich mich sehr freuen!!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hallo Schwede...

wie wärs mit sortieren nach TabOrder? sind ja Zahlen des Typs "Long"...

Naja, hab sowas in die Richtung auch gebaut, desshalb hier mein Code.

Code:

---

Public Sub main()

    Dim ACTLayout As AcadLayout
   
    Dim toSort_TabNr() As Variant
    Dim toSort_TabName() As Variant
   
    Dim i As Integer: i = 0
   
    '-------------------------------------------
    For Each ACTLayout In ThisDrawing.Layouts
        If ACTLayout.ModelType = False _
            Then
                ReDim Preserve toSort_TabNr(0 To i) As Variant
                ReDim Preserve toSort_TabName(0 To i) As Variant
           
                toSort_TabNr(i) = ACTLayout.TabOrder
                toSort_TabName(i) = ACTLayout.Name
           
                i = i + 1
        End If
    Next
    '-------------------------------------------
   
    Call Sort_Numbers(toSort_TabNr, toSort_TabName)
   
    i = 0
    For i = 0 To UBound(toSort_TabName)
        MsgBox toSort_TabName(i) 'in COmboDINGDING schreiben
    Next i
   
End Sub
'################################################################################
Private Sub Sort_Numbers(ByRef toSort As Variant, ByRef SyncSort As Variant)
   
    Dim OutSort() As Variant
    ReDim OutSort(LBound(toSort) To UBound(toSort)) As Variant
   
    Dim OutSyncSort() As Variant
    ReDim OutSyncSort(LBound(toSort) To UBound(toSort)) As Variant
   
    Dim local_toSort As Variant
        local_toSort = toSort
       
    Dim local_toSyncSort As Variant
        local_toSyncSort = SyncSort
   
    Dim minOut As Variant
    Dim minINDEX As Integer
   
    For i = LBound(toSort) To UBound(toSort)
   
        minOut = min(local_toSort)
        minINDEX = minOut(1)
       
        OutSort(i) = local_toSort(minINDEX)
        OutSyncSort(i) = local_toSyncSort(minINDEX)
       
        local_toSort = removeItem(local_toSort, minINDEX)
        local_toSyncSort = removeItem(local_toSyncSort, minINDEX)
    Next i
   
    toSort = OutSort
    SyncSort = OutSyncSort

End Sub
'-----------------------------------------------------------------------------
Private Function removeItem(Arr As Variant, Index2Remove As Integer) As Variant

    If _
        UBound(Arr) - LBound(Arr) = 0 _
        And _
        UBound(Arr) = Index2Remove _
        Then
            removeItem = Empty
        Else
            If _
                Index2Remove > UBound(Arr) _
                Or _
                Index2Remove < LBound(Arr) _
                Then
                    Exit Function
                Else
                    Dim OutArr() As Variant
               
                    Dim i As Integer
                    Dim k As Integer: k = LBound(Arr)
                   
                    For i = LBound(Arr) To UBound(Arr)
                        If Not (i = Index2Remove) _
                            Then
                                ReDim Preserve OutArr(LBound(Arr) To k) As Variant
                                OutArr(k) = Arr(i)
                                k = k + 1
                        End If
                    Next i
                   
                    removeItem = OutArr
            End If
    End If
   
End Function
'-----------------------------------------------------------------------------
Private Function min(Arr As Variant) As Variant

    Dim Index As Integer
   
    If IsArray(Arr) _
        Then
            For i = LBound(Arr) To UBound(Arr)
                If IsEmpty(min) _
                    Then
                        min = Arr(i)
                        Index = i
                End If
               
                If min > Arr(i) _
                    Then
                        min = Arr(i)
                        Index = i
                End If
            Next i
        Else
            min = Arr
    End If
   
    '--------------------------------------
    Dim Out(1) As Variant
        Out(0) = min
        Out(1) = Index
   
    min = Out
    '--------------------------------------
   
End Function

---

Naja, der SortierAlgo ist mit Sicherheit einer von der schlechteren/rechenintensivieren Sorte, jedoch finde ich ihn relativ leicht verständlich...

Lg reltro

[Diese Nachricht wurde von reltro am 25. Apr. 2012 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Reltro, genau soetwas in der Art habe ich gesucht, Danke!
Leider bin ich kein gelernter Programmierer und versuche jetzt hinter die Bedeutung des Codes zu kommen. Den Teil der Public Sub Main() verstehe ich noch, aber dann hört es auch auf     
Könntest du mir das einmal kurz erklären?

Besten Dank

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP