Hello, all! Another question has popped up.
I have received a file with a lot of shapes placed onto an area using a nesting program. Good part is they are placed efficiently, bad part is they do not have any data on them (rotation, names, IDs, etc). All the placed shapes are not rotated, only mirrored (well, rotated 180 degrees). The task is to place different content into the mirrored and non-mirrored shapes. And this is not a one-off thing so I decided to make a macro for it.
I made a sort-of select-same macro which would use Shape size, node counts and, in my mind, first node positions relative to their centers as parameters to find same shapes. And it works really well, apart from mirrored (rotated 180 degrees) shapes in the original. It selects both regular and mirrored shapes no matter what I try.
Here is the code:
Private Sub SelectSame()
If ActiveDocument Is Nothing Then
MsgBox "Please have a document open!", vbOKOnly Or vbExclamation, ""
If ActiveSelectionRange.Shapes.Count = 0 Then
MsgBox "Please have at least one selected shape!", vbOKOnly Or vbExclamation, ""
Dim S As Shape, T As Shape
Dim SR As New ShapeRange
Dim A As Double, B As Double
Set S = ActiveSelection.Shapes.First
If S.Type <> cdrCurveShape Then
MsgBox "Shapes need to be curved!", vbOKOnly Or vbExclamation, ""
ActiveDocument.Unit = cdrMillimeter
For Each T In ActivePage.FindShapes(, cdrCurveShape)
If T.SizeHeight > (S.SizeHeight * 0.9999) And T.SizeHeight < (S.SizeHeight * 1.0001) Then
If T.SizeWidth > (S.SizeWidth * 0.9999) And T.SizeWidth < (S.SizeWidth * 1.0001) Then
If T.Curve.Nodes.Count = S.Curve.Nodes.Count Then
If Abs(T.Curve.Nodes.First.PositionX - T.CenterX) > Abs(S.Curve.Nodes.First.PositionX - S.CenterX) * 0.999 And _
Abs(T.Curve.Nodes.First.PositionX - T.CenterX) < Abs(S.Curve.Nodes.First.PositionX - S.CenterX) * 1.001 Then
If SR.Shapes.Count <> 0 Then
SR.Shapes.All.ApplyUniformFill CreateRGBColor(255, 0, 0)
Those 0.9999 numbers are to overcome CorelDRAW's (or general) floating point comparison limitations, I guess.
And to make testing easier here's an initial file I am using for testing (for some reason I could not directly place it here): https://files.fm/u/yfxzw5hg6
If any of you have some idea on how to efficiently select only the truly similar shapes, such as ((( and not ((( and ))), I would greatly appreciate it. One, seemingly inefficient option, would be to place (a copy of) the shape that needs to be compared on top of the sample shape and compare all the node coordinates. And if nothing else comes up I will probably use that. But perhaps the true pros here know of a better approach.
Thanks in advance!
It would not be a comprehensive, do-it-all solution for comparing shapes, but have you considered looking at Shape.TransformationMatrix, and some of the properties associated with it?
For the specific example you show, comparing Shape.TransformationMatrix.IsMirrored might be enough to exclude the mirrored (or not) versions of the shapes.
Thanks for the hint!
From what I have been reading so far understanding TransformationMatrix feels a little beyond my skills, but I'll try to experiment with it, see if something can be managed.
Although, would it work if the shapes have been mirrored outside of CorelDRAW?
If Sgn(T.Curve.Nodes.First.PositionX - T.CenterX) = Sgn(S.Curve.Nodes.First.PositionX - S.CenterX) Then SR.Add T
make some additions for situations wheh x1=x2, like sign(yi-y2) comparison
Wow, what a smart and efficient way to solve this - works as needed! I tested it on many objects and basically all of them work perfectly. Awesome!
Thanks a lot. For this and your many helpful replies in general.
Yeah that's a nice solution!
I was going to say if all the other properties match then check the curve direction:
Dim s1 As Shape, s2 As Shape If s2.Curve.SubPaths.First.isClockWise <> s1.Curve.SubPaths.First.isClockWise Then 'shape is flipped End If
Flipping shapes in most programs will reverse the node order that could potentially be thrown off by the origin program. Testing would be needed!