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
Perhaps this macro might work for you:
Brian Davies PictureFrame
http://macromonster.com/product/brian-davies-pictureframe/
This macro allows you to create border around bitmaps or the bounding boxes of other shapes.Note: it’s possible to apply borders to numerous bitmaps/bounding boxes at once.You can choose the outline color and can also use various offsets relative to the original shape.
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.
try attached macro (ziiped as site doesn´t allow to upload gms files)
8078.Add_Rectangle.zip
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.