Sorting ShapeRange with multiple parameters

Hi, all!

So the ShapeRange.Sort function is really powerful, saving tons of code. You can compare position...

ActiveSelectionRange.Sort "@shape1.left < @shape2.left"

even area in a way...

ActiveSelectionRange.Sort "@shape1.width*@shape1.height > @shape2.width*@shape2.height"

which is great, but my question is - can you stack these? I'd like to sort my ShapeRange in such a way that we have bottom-left shapes first, then the next leftmost one, etc. Basically a Bottom Left sort. I did try some things, like separate sorts, combining the queries with &, but no luck.

Can any of the pros chime in if this is possible? Thanks!

  • Hi Joe,

    Did you have any luck resolving this issue?

    Tomorrow I am about to start working something similar. Essentially I want to number letters/elements of signs in sequence that reads logically; Starting from top left working from right and down. It gets a bit tricker given how varied sign designs can be.

    I'm currently thinking along the lines of putting items into 'groups' based on proximity on the X axis, closeness of height and Y position (as text is generally written). If the share similar properties and sit within a range of each other then put them into a 'group' for processing later.

    Then arrange the groups by their height relative to one another and just processing the contents within each group from left to right.

    Still so much I haven't figured out yet. When I say groups I'm not sure whether I'll be using an array or collections or I might just hack it to start with and put them into layers. Everything I think of is complicated and has potential issues cons... surprisingly a very difficult thing to do!

    Though I saw something similar on http://www.coreldrawtools.com/ so it can be done!
  • Below is my hacky first attempt at making a top left to bottom right sorter. It's rough but does the job. It's designed to create and order that reads correctly for signage and letter sets.

    The sequence test sub is just to illustrate the final order and has no real application. Moreover this doesn't contain my break function so you'll have to break up the shapes yourself before running this.

    It's actually a really interesting problem and I had a few more ideas of solving it but ultimately the first method (of sort by height, group by position and size then sort groups by left to right) works well enough.

      1
      2
      3
      4
      5
      6
      7
      8
      9
     10
     11
     12
     13
     14
     15
     16
     17
     18
     19
     20
     21
     22
     23
     24
     25
     26
     27
     28
     29
     30
     31
     32
     33
     34
     35
     36
     37
     38
     39
     40
     41
     42
     43
     44
     45
     46
     47
     48
     49
     50
     51
     52
     53
     54
     55
     56
     57
     58
     59
     60
     61
     62
     63
     64
     65
     66
     67
     68
     69
     70
     71
     72
     73
     74
     75
     76
     77
     78
     79
     80
     81
     82
     83
     84
     85
     86
     87
     88
     89
     90
     91
     92
     93
     94
     95
     96
     97
     98
     99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    Option Explicit
    
          Private LetterSR As ShapeRange 'All letters
          Private LetterCount As Integer  'Overall Number of Letters
          Private Larray() As Variant
          Private LetsLeft As Boolean
          
          Private Ai As Integer, Bi As Integer
          
          Private AX As Double, AY As Double, AH As Double, AW As Double 'Letter A sizes
          Private BX As Double, BY As Double, BH As Double, BW As Double 'Letter B sizes
          Private GX As Double, GY As Double, GH As Double, GW As Double 'Sizes for group box
          
          Private AvHeight As Double, Padding As Double
          
          Private GrBoxSR As ShapeRange, FinalSR As ShapeRange
          Private GS As Shape
          Private GroupCount As Integer 'Number of groups
          
          
    Sub Ordertest() 'Test for ordering the above groups
    
        ActiveDocument.Unit = cdrMillimeter
        ActiveDocument.ReferencePoint = cdrBottomLeft
          Dim I As Integer
          Dim TempSR As ShapeRange
                Set TempSR = ActiveSelectionRange
    
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
                TopSort TempSR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    
          Set LetterSR = TempSR
          LetterCount = LetterSR.Shapes.Count
    
          For I = 1 To LetterCount
                AvHeight = AvHeight + LetterSR(I).SizeHeight
          Next
          AvHeight = AvHeight / LetterCount
          Padding = AvHeight * 0.15
          
          ReDim Larray(LetterCount - 1, 1) 'Group letter blongs to
                For I = 0 To LetterCount - 1
                      Larray(I, 0) = 0
                      Larray(I, 1) = "V"
                Next I
                
          Ai = 1
          Bi = 1
          GroupCount = 1
          LetsLeft = True
          
    Do While LetsLeft = True
    
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
         GroupTest
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
          NextAi
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
          GroupCount = GroupCount + 1
          
    Loop
          GrBoxSR.Delete
    
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
          SequenceTest
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
          Set GrBoxSR = Nothing
          Set FinalSR = Nothing
          Set GS = Nothing
          Set TempSR = Nothing
          Set LetterSR = Nothing
          Erase Larray
          
        ActiveWindow.Refresh
        Application.Refresh
        
    End Sub
    Private Function NextAi()
          LetsLeft = False
          Dim Nc As Integer
          For Nc = 0 To LetterCount - 1
                If Larray(Nc, 0) = 0 Then
                Ai = Nc + 1
                LetsLeft = True
                Exit For
                End If
          Next Nc
          
    End Function
    
    Private Function LeftSort(ByRef SRToSort As ShapeRange) 'secondary sort by left centre positions
                SRToSort.Sort "@shape1.left < @shape2.Left"
                'SRToSort.Sort "@shape1.left + (@shape1.width/2) - (@shape1.top*0.75)  < @shape2.Left+(@shape2.width/2) - (@shape2.top*0.75) "
    
    End Function
    
    Private Function TopSort(ByRef SRToSort As ShapeRange) 'Initial sort and find First (heightest) Object
                SRToSort.Sort "@shape1.top > @shape2.top"
                      
    End Function
    
    
    'Test Letter A against B to see if they should be grouped
    Private Function GroupTest()
          Dim N As NODE
          Dim Nc As Integer
          Dim BLS As Shape, ALS As Shape
          Dim TempSR2 As New ShapeRange
          Dim GroupedSR As ShapeRange 'Assign Letters to this shaperange for removing from ungrouped range
          Dim InsideB As Boolean, HorizSet As Integer
          
                Set ALS = LetterSR(Ai)
                ALS.GetBoundingBox AX, AY, AW, AH, False
                TempSR2.Add ALS
                HorizSet = 1
                
                                        For Nc = 0 To LetterCount - 1
                                              Bi = Nc + 1
                                              Set BLS = LetterSR(Bi)
    
                                              If Bi = Ai Then GoTo LetterGrouped 'Don't check letter against itself
                                              BLS.GetBoundingBox BX, BY, BW, BH, False
                                              
                                                    'Primary Test for horizontally aligned letters
                                               If HorizSet = 2 Or HorizSet = 1 Then
                                                    If Not BY + BH > AY + (AH * 1.5) And Not BY < AY - (AH * 0.5) Then 'Y position check
                                                                           If Not BH > AH * 1.5 Then 'HEIGHT check
                                                                                 If Not BH < AH * 0.5 Then 'HEIGHT check
                                                                                        TempSR2.Add BLS
                                                                                        Larray(Nc, 0) = GroupCount
                                                                                        HorizSet = 2
                                                                                        Larray(Bi - 1, 1) = "H"
                                                                                        Larray(Ai - 1, 1) = "H"
                                                                                 End If
                                                                           End If
                                                                      End If
                                              End If
                                              
                                                    'Secondary test to find Vertically aligned letters
                                              If HorizSet = 3 Or HorizSet = 1 Then 'Horiztonal sets should not be overrided by Vertical matches
                                                     If Larray(Bi - 1, 1) = "V" And Larray(Ai - 1, 1) = "V" Then
                                                          If Not BY < AY - (AH * 2) Then   'Yposition check
                                                                If Not BY + BH > AY + (AH * 3) Then  'Yposition check 2
                                                                      If BX + BW < AX + (AW * 1.5) Then 'x range check
                                                                            If BX > AX - (AW * 1) Then
                                                                                  If Not BW > AW * 1.25 Then 'Width check
                                                                                              If Not BW < AW * 0.75 Then 'width check
                                                                                              TempSR2.Add BLS
                                                                                              Larray(Nc, 0) = GroupCount
                                                                                              HorizSet = 3
                                                                                              BLS.GetBoundingBox AX, AY, AW, AH, False
                                                                                        End If
                                                                                  End If
                                                                            End If
                                                                      End If
                                                                End If
                                                          End If
                                                    End If
                                              End If
    LetterGrouped:
                                              
                            Next Nc
                      
                      'Test if a shape fits within the group; this is to capture small details like the dots on top of a "i"
                      Set GroupedSR = TempSR2
                      GroupedSR.GetBoundingBox GX, GY, GW, GH, False
                      Set GS = ActiveLayer.CreateRectangle(GX - (Padding * 0.25), GY + GH + (Padding * 0.5), GX + GW + (Padding * 0.25), GY - (Padding * 0.25))
                      
                                              For Nc = 0 To LetterCount - 1
                                                    Bi = Nc + 1
                                                    Set BLS = LetterSR(Bi)
                                                    'If Larray(Nc, 0) > 0 Then GoTo LetterGrouped2
                                                    If Larray(Nc, 0) > Ai Then GoTo LetterGrouped2
                                                    InsideB = True
                                                          For Each N In BLS.DisplayCurve.nodes
                                                                If Not GS.DisplayCurve.IsPointInside(N.PositionX, N.PositionY) = True Then
                                                                InsideB = False
                                                                End If
                                                          Next N
                                                          
                                                          If InsideB = True Then
                                                                TempSR2.Add BLS
                                                                Larray(Nc, 0) = GroupCount
                                                          End If
    LetterGrouped2:     Next Nc
    
                      If HorizSet = 2 Or HorizSet = 1 Then
                            LeftSort GroupedSR
                      Else
                            TopSort GroupedSR
                      End If
                      
                      GS.CreateSelection
                      If Not GrBoxSR Is Nothing Then GrBoxSR.AddToSelection
                      
                      Set GrBoxSR = ActiveSelectionRange
                      If Not FinalSR Is Nothing Then
                            FinalSR.RemoveRange GroupedSR
                            FinalSR.AddRange GroupedSR
                      Else
                            Set FinalSR = GroupedSR
                      End If
                      
                            Set N = Nothing
                            Set BLS = Nothing
                            Set ALS = Nothing
                            Set TempSR2 = Nothing
                            Set GroupedSR = Nothing
          
    End Function
    
     'Link up Letters with lines to show the order of ShapeRange
    Private Function SequenceTest()
    
          Dim C As Long, M As Long, Step As Long 'Lines to change colour from start to finish
                C = 100: M = 0: Step = 100 / LetterCount
                
          Dim I As Integer, AL As Integer, NL As Integer
          
          Dim ALet As Shape 'ActiveLetter
          Dim NLet As Shape 'NextLetter
          
          Dim AXC As Double, AYC As Double
          Dim NXC As Double, NYC As Double
          
          Dim NumberS As Shape, NumberSR As New ShapeRange
          Dim DotS As Shape, DotSR As New ShapeRange
          Dim LineS As Shape, LineSR As New ShapeRange
          
                For I = 1 To LetterCount - 1
                            AL = I: NL = AL + 1
                                  
                            Set ALet = FinalSR(AL)
                                  ALet.GetPositionEx cdrCenter, AXC, AYC
                                  ALet.Outline.Color.CMYKAssign C, M, 0, 0
                            
                            Set NLet = FinalSR(NL)
                                  NLet.GetPositionEx cdrCenter, NXC, NYC
                            
                            Set LineS = ActiveLayer.CreateLineSegment(AXC, AYC, NXC, NYC)
                                  LineS.Outline.Color.CMYKAssign C, M, 0, 0
                                  LineSR.Add LineS
                                  
                            Set DotS = ActiveLayer.CreateEllipse2(AXC, AYC, 50, 50)
                                  DotS.Outline.SetNoOutline
                                  DotS.Fill.UniformColor.CMYKAssign C, M, 0, 0
                                  DotSR.Add DotS
    
                            Set NumberS = ActiveLayer.CreateArtisticText(AXC, AYC, AL, , , , 200, cdrTrue, cdrFalse, cdrNoFontLine, cdrCenterAlignment)
                                  NumberS.ConvertToCurves
                                  NumberS.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
                                  NumberS.SetPositionEx cdrCenter, AXC, AYC
                                  NumberSR.Add NumberS
                                  
                            C = C - Step: If C < 0 Then C = 0
                            M = M + Step:  If M > 100 Then M = 100
                            
                            If NL = LetterCount Then 'Add dot and number for last entry
                                        NLet.Outline.Color.CMYKAssign 0, 100, 0, 0
                                        
                                  Set DotS = ActiveLayer.CreateEllipse2(NXC, NYC, 50, 50)
                                        DotS.Outline.SetNoOutline
                                        DotS.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
                                        DotSR.Add DotS
                                        
                                  Set NumberS = ActiveLayer.CreateArtisticText(NXC, NYC, LetterCount, , , , 200, cdrTrue, cdrFalse, cdrNoFontLine, cdrCenterAlignment)
                                        NumberS.ConvertToCurves
                                        NumberS.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
                                        NumberS.SetPositionEx cdrCenter, NXC, NYC
                                        NumberSR.Add NumberS
                            End If
                            
                Next I
                
          Set LineS = LineSR.Group
          Set DotS = DotSR.Group
          Set NumberS = NumberSR.Group
          
           DotSR.Add LineS
           DotSR.Add DotS
           DotSR.Add NumberS
           
           Set LineS = DotSR.Group
           LineS.OrderToFront
           
          Set ALet = Nothing
          Set NLet = Nothing
          
          Set LineS = Nothing
          Set LineSR = Nothing
          Set NumberS = Nothing
          Set NumberSR = Nothing
          Set DotS = Nothing
          Set DotSR = Nothing
          
    End Function
    
  • Hello,

    FWIW, we have ecut 6 as a commercial solution for this. It offers various sorting parameters in its routing module. It's ready to go, for those who want to cut jobs faster and with less movement on the machine.

  • any chance of giving us a brief description of how you went about it coding it? I'd be really interested in hearing how you approached doing it as I couldn't find much info on the internet for this sort of problem.