Hi. I found a macro on the web ..The macro works well with rotated objects....But not with mirrored objects.How to make the macro work with mirrored objects?
Macro Code:
Sub scatter() Dim sh As Shape, sr As ShapeRange, x#, y#, w#, h#, i& Dim AgentSmith As Shape, VSR As ShapeRange If ActiveDocument Is Nothing Then Exit Sub Set sr = ActiveSelection.Shapes.FindShapes() If sr.Count = 0 Then MsgBox "Select target objects, invoke the macro, click Agent Smith shape" Exit Sub End If If ActiveDocument.GetUserClick(x, y, i, -1, Snap:=False, CursorShape:=313) Then _ Exit Sub With ActivePage.SelectShapesAtPoint(x, y, SelectUnfilled:=True) If .Shapes.Count = 0 Then Beep: Exit Sub Set AgentSmith = .Shapes(.Shapes.Count) End With Set VSR = New ShapeRange ActiveDocument.ReferencePoint = cdrCenter For Each sh In sr sh.GetBoundingBox x, y, w, h With AgentSmith.TreeNode.GetCopy .VirtualShape.RotationAngle = sh.RotationAngle .VirtualShape.SetBoundingBox x, y, w, h, KeepAspect:=True .LinkAsChildOf sh.Layer.TreeNode VSR.Add .VirtualShape End With Next ActiveDocument.LogCreateShapeRange VSR sr.Delete ' evaporate originally selected shapesEnd Sub
Replace shape....cdr
you can try macro below (modified macro shown in this thread https://community.coreldraw.com/sdk/f/42/p/48141/231047#231047
Sub replace()Dim i#, design As Shape, ph1 As Shape, eff As Effect, sw#, sh#, mx#, my#, z&Dim placeholder As Shape, x2 As Double, y2 As Double, sr As ShapeRange, myan#
ActiveDocument.BeginCommandGroup "replace"Set sr = ActiveSelectionRangeIf ActiveDocument.GetUserClick(mx, my, z, -1, Snap:=False, CursorShape:=313) Then Exit SubWith ActivePage.SelectShapesAtPoint(mx, my, SelectUnfilled:=True)If .Shapes.Count = 0 Then Beep: Exit SubSet placeholder = .Shapes(.Shapes.Count)End Withsr.CreateSelectionFor i = 1 To sr.CountSet design = ActiveSelection.Shapes.Item(i)design.GetPositionEx cdrCenter, x2, y2sw = design.SizeWidthsh = design.SizeHeightSet ph1 = placeholder.Duplicateph1.SetSize sw, shph1.SetPositionEx cdrCenter, x2, y2rem Set eff = ph1.CreateEnvelopeFromShape(design)ph1.Rotate design.RotationAngleNext isr.DeleteActiveDocument.EndCommandGroupEnd Sub
??