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
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.
It looks like this.
Thank you for your response. I'm sorry. I expressed myself badly. The size of the center mark must have a fixed size. For example, 20x20mm. And object for example 10x10mm or 50x50mm
You can try following code
Sub CenterMark()Dim s As Shape, srLine As New ShapeRange, sr As ShapeRangeActiveDocument.Unit = cdrMillimeterSet sr = ActiveSelectionRangeFor Each s In srsrLine.Add ActiveLayer.CreateLineSegment(s.CenterX - 10, s.CenterY, s.CenterX + 10, s.CenterY)srLine.Add ActiveLayer.CreateLineSegment(s.CenterX, s.CenterY - 10, s.CenterX, s.CenterY + 10)Next sSet mark = srLine.GroupEnd Sub
Best regards,
Mek