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
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