Draw - snap-to-grid macro

[John_Hall]

Having been bothered by my objects failing to snap-to-grid sometimes,
I wrote a macro to do that. It does not handle everything, but works for me.
In case someone else finds it useful, here it is.
(Indents probably disappear).

REM ***** BASIC *****
OPTION EXPLICIT

Sub Main
Dim oDoc As Variant, oSelections, pPosition As Variant
'Help says only Variants can be Dimmed as multiple variables.
Dim LeftMargin As Long
Dim TopMargin As Long
Dim GridX As Long
Dim GridY As Long
Dim sShapeType as String

'Get the active document, check we are in a Draw document
oDoc = ThisComponent
If Not oDoc.SupportsService("com.sun.star.drawing.DrawingDocument") Then
Msgbox "Not a Draw document"
Exit Sub
End If

'NB if more than one object is selected, those after the first are ignored!
oSelections = oDoc.getCurrentSelection() 'Check we have something (or things) selected
If IsNull(oSelections) Then
Msgbox "No object is selected"
Exit Sub
End If

'Get size of Left & Top Margins
LeftMargin = oDoc.DrawPages(0).BorderLeft
TopMargin = oDoc.DrawPages(0).BorderTop

' Get size of Grid divisions. Ouch! We can't. Use preset value for 2mm grid.
GridX = 200
GridY = 200

'What type of Object are we dealing with?
sShapeType = oSelections(0).ShapeType
Select Case sShapeType
Case "com.sun.star.drawing.GroupShape", "com.sun.star.drawing.RectangleShape", "com.sun.star.drawing.EllipseShape"
pPosition = oSelections(0).getPosition()
pPosition.X = toNearestGrid(pPosition.X, GridX, LeftMargin)
pPosition.Y = toNearestGrid(pPosition.Y, GridY, TopMargin)
oSelections(0).setPosition(pPosition)
Case "com.sun.star.drawing.LineShape"
MsgBox "Lines not yet handled." 'We need to handle two points here???
Case Else
MsgBox "Unexpected object type: " & Chr(13) & sShapeType
End Select

End Sub 'Main

Function toNearestGrid(origXorY, gridSize, marginSize) as Long
' origXorY is in 1/100 of a mm, & includes the appropriate (Left or Top) margin
Dim adj As Long
adj = (origXorY - marginSize) Mod gridSize
toNearestGrid = origXorY 'in case no adjustment required, return original value
If adj > 0 Then
If adj < (gridSize / 2) Then
toNearestGrid = origXorY - adj
Else
toNearestGrid = (origXorY - adj) + gridSize
EndIf
EndIf
End Function