OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   Macros/Add-ons (http://forum.oberonplace.com/forumdisplay.php?f=21)
-   -   Distribute shapes to page (http://forum.oberonplace.com/showthread.php?t=24774)

mtracy 06-12-2016 10:09

Distribute shapes to page
 
I've come up with my own little macro to distribute shapes evenly across a rectangle either horiz or vertically. If you use the distribute docker you can already "distribute across the page" but it places the outer shapes on the edge of the page. My macro sets equal distances across the rectangle including edges.

Simply select your shapes that are inside the rectangle then shift select your rectangle and run the appropriate macro

Works great for aligning/distributing paragraph text
................
Sub DistributeHorizWithin()
Dim sr As ShapeRange, s As Shape
Dim x As Double, y As Double, w As Double, h As Double
ActiveDocument.BeginCommandGroup "DistributeHorizWithin"
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
sr.GetBoundingBox x, y, w, h
sr.Add ActiveLayer.CreateLineSegment(x, y, x, y + h / 5)

ActiveShape.Name = ("LS1")

sr.Add ActiveLayer.CreateLineSegment(x, y, x, y + h / 5)
ActiveShape.Move w / 1, 0

ActiveShape.Name = ("LS2")
sr.AddToSelection
sr(1).RemoveFromSelection
ActiveSelectionRange.Distribute cdrDistributeHSpacing
ActivePage.Shapes.FindShape("LS1").Delete
ActivePage.Shapes.FindShape("LS2").Delete
ActiveDocument.EndCommandGroup
End Sub

Sub DistributeVertWithin()
Dim sr As ShapeRange, s As Shape
Dim x As Double, y As Double, w As Double, h As Double
ActiveDocument.BeginCommandGroup "DistributeVertWithin"
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
sr.GetBoundingBox x, y, w, h

sr.Add ActiveLayer.CreateLineSegment(x, y, x + h / 5, y)

ActiveShape.Name = ("LS1")

sr.Add ActiveLayer.CreateLineSegment(x, y, x + h / 5, y)
ActiveShape.Move 0, h / 1

ActiveShape.Name = ("LS2")
sr.AddToSelection
sr(1).RemoveFromSelection
ActiveSelectionRange.Distribute cdrDistributeVSpacing
ActivePage.Shapes.FindShape("LS1").Delete
ActivePage.Shapes.FindShape("LS2").Delete
ActiveDocument.EndCommandGroup
End Sub


All times are GMT -5. The time now is 07:13.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com