I am trying to write a macro that will create a slightly oversized rectangle around any given object. It didn't take long for me to run into a wall. The CreateRectangle command requires 4 values. I need my created rectangle to reference the ActiveSelectionRange and add 10mm to the x & y values. I have no idea how to do this. It also needs to inherit the original selection coordinates, centered.
So in the end, if I were to apply the macro to a 10mm diameter circle, it would create a 20 x 20mm rectangle that is centered on the circle. I need a rectangle, so using contours is not viable.
It does not need to inherit fills, outline or colour properties, nothing fancy. Just that.
I'd be grateful for any assistance
ThreecubeMike said:I need my created rectangle to reference the ActiveSelectionRange and add 10mm to the x & y values.
You could use the .LeftX, .RightX, .BottomY, and .TopY of the ShapeRange when figuring out the corner locations to use for the Rectangle you want to create.
Here's one way to do it that draws the rectangle around the active selection range.
Note that I'm saving/restoring settings. That allows me to set the document units to millimeters for convenience, but to restore it to whatever it was before the macro is done.
Sub add_rectangle() Dim sr As ShapeRange Const dblMargin_mm = 5 On Error GoTo ErrHandler ActiveDocument.SaveSettings ActiveDocument.Unit = cdrMillimeter Set sr = ActiveSelectionRange ActiveLayer.CreateRectangle sr.LeftX - dblMargin_mm, sr.TopY + dblMargin_mm, sr.RightX + dblMargin_mm, sr.BottomY - dblMargin_mm ExitSub: ActiveDocument.RestoreSettings Exit Sub ErrHandler: MsgBox "Error occured: " & Err.Description Resume ExitSub End Sub
Nice.
Check requirement "add 10 mm x & y values" - then I think that dblMargind should be 5.
True, thank you.
I change the 10 to 5 now.
You're welcome.