Problem withgrouping code

[knowbodynow]

I have the following code that should look for objects on rectangles and group them to the rectangle if found:

sub groupobjects()

Dim sel As Shape
Dim Gr As Shape
Dim rx As Double, ry As Double, rw As Double, rh As Double
Dim gx As Double, gy As Double, gw As Double, gh As Double


For Each sel In ActivePage.Shapes

    If sel.Type = cdrRectangleShape Then
    sel.CreateSelection
    sel.GetBoundingBox rx, ry, rw, rh
    
        For Each Gr In ActivePage.Shapes
        If Gr.Type <> cdrRectangleShape Then
        Gr.GetBoundingBox gx, gy, gw, gh
        
            If (gx >= rx) And gx + gw <= rx + rw And _
            (gy >= ry) And gh + gh <= rh + rh Then
            Gr.AddToSelection
            End If
        End If
        
        Next Gr
    
    End If

ActiveSelection.Group

Next sel

End sub()

This seems to work but I can't find a way to centre the object on the rectangle before grouping. As an experiment I tried substituting activeselection. group with activeselection.delete but this gave me an error.

I suspect there is something flawed with my approach but can someone please offer some corrections to the code or suggestions for a more robust approach.

Thanks,

Chris (Hunt)

[wOxxOm]

Sub groupobjects()
   
   Dim rect As Shape, sh As Shape
   Dim SR As ShapeRange
   Dim x#, y#, w#, h#
   
   Set SR = New ShapeRange
   ActiveDocument.BeginCommandGroup "Rectanglify"
   EventsEnabled = False: Optimization = True: ActiveDocument.PreserveSelection = False
   
   ActiveDocument.ReferencePoint = cdrBottomLeft
   
   For Each rect In ActivePage.FindShapes(, cdrRectangleShape, recursive:=False)
      rect.GetBoundingBox x, y, w, h
      With ActivePage.SelectShapesFromRectangle(x, y, x + w, y + h, True)
         If .Shapes.Count > 1 Then
            SR.AddRange .Shapes.All
            For Each sh In SR
               If Not sh Is rect Then
                  sh.AlignToShape cdrAlignHCenter Or cdrAlignVCenter, rect
               End If
            Next
            SR.Group
            SR.RemoveAll
         End If
      End With
   Next rect
   
   ActiveDocument.PreserveSelection = True: Optimization = False: EventsEnabled = True
   ActiveDocument.EndCommandGroup
   
   ActiveWindow.Refresh
   Refresh
End Sub

[knowbodynow]

Thanks Os,

I tried using SelectShapesFromRectangle before using the code I posted. Unfortunately I got an error message and I'm also getting one with the code you posted. The line:

With ActivePage.SelectShapesFromRectangle(rect.LeftX, rect.TopY, rect.RightX, rect.BottomY, True)

Gives a 438 error: object doesn't support this property or method. Is this because I'm using CorelDraw 12?

Chris

[wOxxOm]

no. it's because of .LeftX etc properties.
I've changed the code, see message above.

[knowbodynow]

Thanks, Os, it works perfectly now. This will save quite a bit of time aligning objects in grids.

Best wishes,

Chris

[wOxxOm]

I'll use it too from now on :-)