Center mark for each of the selected shapes

Hello. Please help. I created a macro that in the middle of the selected shape creates a center mark. But I need to make this center mark created for each of the selected shapes. Could someone help me please?


Sub CenterMark()


Dim s As Shape, srLine As New ShapeRange

Dim x As Double, y As Double, w As Double, h As Double

For Each s In ActiveSelectionRange.Shapes.FindShapes()

s.GetBoundingBox x, y, w, h
srLine.Add ActiveLayer.CreateLineSegment(0, 0, 20, 0)
srLine.PositionX = x + (w / 2)
srLine.PositionY = y + (h / 2)
srLine.Copy
ActiveLayer.Paste.Rotate 90#

Next s

End Sub

Parents
No Data
Reply
  • I think you can probably adapt that if you look up GetObjectsBoundingBox

    For example, ActivePage.GetObjectsBoundingBox(True, False).Left and ActivePage.GetObjectsBoundingBox(True, False).Right give you the two sides and the true parameter restricts it to the seleted objects. Subtract left from right and divide by 2 for the horizontal position. Do the same with .Top and .Bottom for the vertical position.

Children