Sub NestObjects()
    Dim s As Shape, sr As ShapeRange
    Dim areaWidth As Double, areaHeight As Double
    Dim xOffset As Double, yOffset As Double
    Dim currentX As Double, currentY As Double
    Dim maxHeightInRow As Double
    
    ActiveDocument.Unit = cdrMillimeter
    
    ' Define the area where you want to nest the objects
    areaWidth = 750 ' Width of the area
    areaHeight = 750 ' Height of the area
    
    Set sr = ActiveSelectionRange
    If sr.Count = 0 Then
        MsgBox "Please select objects to nest."
        Exit Sub
    End If
    
    ' Initialize the starting position and offsets
    currentX = 0
    currentY = 0
    maxHeightInRow = 0
    xOffset = 1 ' Fixed distance between objects horizontally
    yOffset = 1 ' Fixed distance between objects vertically
    
    For Each s In sr
        ' Check if the object fits in the current row, otherwise try rotating
        If (currentX + s.SizeWidth) > areaWidth Then
            s.Rotate 90
            If (currentX + s.SizeWidth) > areaWidth Then
                ' If it still doesn't fit, move to the next row
                s.Rotate -90 ' Rotate back to the original orientation
                currentX = 0
                currentY = currentY + maxHeightInRow + yOffset
                maxHeightInRow = 0
            End If
        End If
        
        ' Check if the object fits in the area, otherwise stop the macro
        If (currentY + s.SizeHeight) > areaHeight Then
            MsgBox "Not all objects could be nested within the specified area."
            Exit Sub
        End If
        
        ' Move the object to the current position
        s.SetPosition currentX, currentY
        
        ' Update the current position and the max height in the current row
        currentX = currentX + s.SizeWidth + xOffset
        If s.SizeHeight > maxHeightInRow Then
            maxHeightInRow = s.SizeHeight
        End If
    Next s
End Sub

Private Declare  Function GetAsyncKeyState Lib "user32" (ByVal vKey&) As Long 

PtrSafe