MACRO help! How to find widest distance ACROSS various objects?

Since I'm not proficient in writing VBA code, I may use the wrong terminology to describe what I need to accomplish. However, I put together graphic to help with a visual representation. After searching like mad for days on every Corel-related macro site, youtube videos and forums to find a solution to this, I'm at a dead-end.

Here's the basic summary:

I have a ton of vector objects (one object per page) of varying shapes and sizes that all need to have an exact uniform maximum width. That is to say that the maximum size of each object must match other, even with wildly different shapes. A very basic example is a 1" square compared to a 1" circle. Both are initially 1" wide and tall, however when rotated 45 degrees, the maximum width of the square is now 1.4142", while the circle remains the same regardless of rotation. So now that the square has been rotated to its widest point, it can be scaled to 1" wide to match that of the circle. When the square is then rotated back 45 degrees to it's original starting point, it is now only 0.7071" tall and wide. But that is exactly perfect, because there is no part of that square that is greater than 1" across no matter how it is positioned. That's an oversimplified example, but the shapes and sizes that need to be worked through on this project are not that simple. Each object is totally different from each other in size and shape.

(This may be where the graphic below will be helpful to illustrate.)

To be clear, there is no need for the length of the total path of an object (I've seen a few macros for that), but instead the longest distance across it. Once that is achieved, each object can then be set to a uniform size horizontally (maintaining proportions), which will result in the same maximum width for all. I feel like there's a very well known mathematical equation that should be slapping my face, but nothing is jarring my memory.

Hope that all made sense. I will gladly be made to feel a fool if the solution is super easy, but I'm burned out! Thanks for considering this puzzle!

GFXCA

Top Replies

0 Eskimo over 7 years ago

There may be a much more sophisticated (or more simple) way to approach this than what I am about to describe. If there is, then I would be happy to learn about it. My first thoughts:

Make a copy of the object. Do the following steps with that copy.
Check the height and width.
Rotate the object, in increments, through 90 degrees of rotation (e.g., rotate it 1°, then another 1°, then another 1°, etc.).
After each increment of rotation, check the height and width.
Keep track of the maximum height and width measured, and the angles at which those maximum dimensions were measured.
Delete the copy.

If I were doing this, I would see if I could get it working properly using a regular shape as the copy. Then, I might try doing it with a virtual shape to see if that produced the same results.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 GFXCA over 7 years ago in reply to Eskimo

Thanks Eskimo. That's basically what I did to get the shapes done for the example I put together. (Actually rotated a 0.5 degrees at a time.) The issue is the number of shapes and size and the number of hours in a day. A macro can kick it out in a few minutes, but manually will take a week or more

I thought about this more since posting and thought maybe the real question is how to fit each shape into a specific sized circle, with only the two furthest edges touching the edge of the circle, regardless of position. That's really the crux of the matter. (See new jpg below. Although the square and triangle have more than two edge touching, in the real scenario, it would be highly unlikely that more than two edges touched. Think of them as all being amoeba-like. No two are the same at all. ) My initial description was probably the long way around the problem. There has to be an equation that does the trick.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 Eskimo over 7 years ago in reply to GFXCA

OK, I haven't understood clearly.

Did you try the procedure I suggested using a macro? Or just manually?

I had a macro in mind.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 GFXCA over 7 years ago in reply to Eskimo

I did it manually. The problem is that I don't have a macro to know when to stop when it finds the "widest point" of any of the shapes, and then leave in that position. (When the widest point is parallel to horizontal.)
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 Eskimo over 7 years ago in reply to GFXCA

GFXCA said:
I did it manually. The problem is that I don't have a macro to know when to stop when it finds the "widest point" of any of the shapes, and then leave in that position. (When the widest point is parallel to horizontal.)

Here's what I had in mind.

Sub rotate_widest_horizontal(ByRef TargetShape As Shape)
Dim ang As Double
Dim max_width As Double
Dim ang_max_width As Double

Application.Optimization = True
For ang = 0 To 180 Step 0.1
    TargetShape.RotationAngle = ang
    If TargetShape.SizeWidth > max_width Then
        max_width = TargetShape.SizeWidth
        ang_max_width = ang
    End If
Next ang

TargetShape.RotationAngle = ang_max_width
Application.Optimization = False
Application.Refresh
End Sub

To test that subroutine:

Sub test_rotate_widest_horizontal()
Dim s As Shape
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
For Each s In sr
    rotate_widest_horizontal s
Next s
End Sub

That works, but it runs much faster if the incremental rotating / measuring is done on a virtual object:

Sub rotate_widest_horizontal_faster(ByRef TargetShape As Shape)
Dim sVirtual As Shape
Dim ang As Double
Dim max_width As Double
Dim ang_max_width As Double

Set sVirtual = TargetShape.TreeNode.GetCopy().VirtualShape
For ang = 0 To 180 Step 0.1
    sVirtual.RotationAngle = ang
    If sVirtual.SizeWidth > max_width Then
        max_width = sVirtual.SizeWidth
        ang_max_width = ang
    End If
Next ang

sVirtual.Delete
TargetShape.RotationAngle = ang_max_width
End Sub

with this to test it:

Sub test_rotate_widest_horizontal_faster()
Dim s As Shape
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
For Each s In sr
    rotate_widest_horizontal_faster s
Next s
End Sub

Both versions of this appear to work correctly for me in CorelDraw X7.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel