how to extract a powerclip and crop the outside design while extracting ?
The following changes will keep the PowerClip shape but remove the X. This version does search for every PowerClip on the current Page. If you want to do another Page, change to that Page and run again.
Sub ExtractAndCropFromPowerClip() Dim s As Shape, sTrim As Shape, sInside As Shape, sDup As Shape Dim srInside As ShapeRange, srPowerClips As ShapeRange, srCombine As New ShapeRange Dim x As Double, y As Double, w As Double, h As Double Set srPowerClips = ActivePage.Shapes.FindShapes(Query:="!@com.powerclip.IsNull") 'Check that they selected object is a PowerClip If srPowerClips.Count = 0 Then MsgBox "No PowerClips found on current Page." Exit Sub End If For Each s In srPowerClips Set srInside = s.PowerClip.ExtractShapes Set sInside = srInside.Group srInside.GetBoundingBox x, y, w, h Set sRect = ActiveLayer.CreateRectangle(x - 1, y - 1, x + w + 1, y + h + 1) Set sDup = s.Duplicate srCombine.Add sRect srCombine.Add sDup Set sTrim = srCombine.Combine sTrim.Trim sInside, False, False If s.PowerClip.Shapes.Count = 0 Then s.CreateSelection Application.FrameWork.Automation.Invoke "7b022531-3cd7-487f-a797-9d80179dc821" End If Next s End Sub
Happy coding,
-Shelby
Hello, Shelby. Amazing to see you still active here after all these years.
I saw that hack of
Application.FrameWork.Automation.Invoke "7b022531-3cd7-487f-a797-9d80179dc821"
Remembered how it wrecks any undo optimizations (or some Joe is doing something wrong) and though that perhaps you have some suggestion on how to make it act nice if one needs to clear a large amount of shapes, but also undo in a clean way. Impossible?
Joe,
Its very good to see you also. Yes, it is a hack which is why I didn't wrap it in an undo or optimization. I wish I had a native way to do this, but I have not found it yet. Someday maybe I will. :-)