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
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.
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 DoubleDim max_width As DoubleDim ang_max_width As DoubleApplication.Optimization = TrueFor 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 IfNext angTargetShape.RotationAngle = ang_max_widthApplication.Optimization = FalseApplication.RefreshEnd Sub
To test that subroutine:
Sub test_rotate_widest_horizontal()Dim s As ShapeDim sr As ShapeRangeSet sr = ActiveSelectionRangeFor Each s In sr rotate_widest_horizontal sNext sEnd 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 ShapeDim ang As DoubleDim max_width As DoubleDim ang_max_width As DoubleSet sVirtual = TargetShape.TreeNode.GetCopy().VirtualShapeFor 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 IfNext angsVirtual.DeleteTargetShape.RotationAngle = ang_max_widthEnd Sub
with this to test it:
Sub test_rotate_widest_horizontal_faster()Dim s As ShapeDim sr As ShapeRangeSet sr = ActiveSelectionRangeFor Each s In sr rotate_widest_horizontal_faster sNext sEnd Sub
Both versions of this appear to work correctly for me in CorelDraw X7.
Rereading the original post, I found that I didn't fully understand the desired final result - keeping the original rotation angle for the shape, but scaling it so that its largest possible dimension (when rotated) is a particular size.
I think that this does the job. I'm showing only a version that uses a virtual shape to figure out the scaling, but it could all be done (more slowly) using only the real shape.
Sub scale_for_max_dimension(ByRef TargetShape As Shape, ByVal MaxDimension As Double) Dim s As Shape Dim sVirtual As Shape Dim ang As Double Dim max_width As Double Dim x_center As Double Dim y_center As Double Dim scale_factor As Double 'create virtual shape Set sVirtual = TargetShape.TreeNode.GetCopy().VirtualShape 'try angles from 0 to 180 degrees, in 0.1-degree increments For ang = 0 To 180 Step 0.1 'set rotation angle of virtual shape sVirtual.RotationAngle = ang 'Is this the largest width measured so far? If sVirtual.SizeWidth > max_width Then max_width = sVirtual.SizeWidth End If Next ang 'delete the virtual object sVirtual.Delete Set s = TargetShape 'record original center positions of real object x_center = s.CenterX y_center = s.CenterY 'scale the real object scale_factor = MaxDimension / max_width s.SizeWidth = s.SizeWidth * scale_factor s.SizeHeight = s.SizeHeight * scale_factor 'reposition to original center positions s.CenterX = x_center s.CenterY = y_centerEnd Sub
Again, to test it. Here, the maximum possible dimension (when rotated) is being specified as 1.5 inches.
Sub test_scale_for_max_dimension()Dim s As ShapeDim sr As ShapeRangeDim max_dimension As Doublemax_dimension = 1.5Set sr = ActiveSelectionRangeFor Each s In sr scale_for_max_dimension s, max_dimensionNext sEnd Sub
Not sure if there's an issue with these macros being attempted in CorelDraw X4 vs your test in X7, but all of these result in errors. (Or maybe I'm doing something wrong). Another note: the "sub" lines that end in () can be found when I try to run the macro, but the sub lines with text inside the () are not found at all. Examples: Sub scale_for_max_dimension(ByRef TargetShape As Shape, ByVal MaxDimension As Double) --> not found in the macro menu. vs Sub test_scale_for_max_dimension() --> found in macro menu. Will run, but with errors. Here's the error message "Compile error: Expected variable or procedure, not module"
OK, I don't have X4, but I do have X5.
I used the same code in the macro editor there, and the subroutines appear to work fine in X5.
Here's the .GMS file from X5:
scalemaxdimension.gms
That GMS file includes the subroutines that "do the work", and also the two subroutines that I used to call the other ones for testing.
You are not going to see the "do the work" subroutines in the CorelDraw Macro Manager because they are subroutines that use arguments (i.e., the stuff between the parentheses after the name of the subroutine).
The subroutines you do see in the Macro Manager are the ones that don't use arguments - the ones with just an empty () after the subroutine name.
Here's how they look in the X5 Macro Manager:
When I select one or more objects in CorelDraw, then double-click on "test_scale_for_max_dimension", then the subroutine "test_scale_for_max_dimension" runs.
That subroutine gets the shaperange from the active selection, then goes through all of the shapes in it.
Each time it gets to a new shape, it "calls" the subroutine "scale_for_max_dimension" and gives that subroutine the necessary arguments (the shape to be worked on, and the maximum dimension that is to be used).
After "scale_for_max_dimension" has finished, control comes back to "test_scale_for_max_dimension", picking up right after the line that called the other sub.
Save