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, "" Exit Sub End If If ActiveSelectionRange.Shapes.Count = 0 Then MsgBox "Please have at least one selected shape!", vbOKOnly Or vbExclamation, "" Exit Sub End If 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, "" Exit Sub End If 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 SR.Add T End If End If End If End If Next T If SR.Shapes.Count <> 0 Then SR.Shapes.All.ApplyUniformFill CreateRGBColor(255, 0, 0) End If End Sub
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!
Quick idea
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
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!
Thanks, I tried that, but in this case all the directions apparently were the same. lev's solution seems to be the best so far. Works for any shapes I throw at it.