we have multiple powerclips in a document and those powerclip have content outside of powerclip box. now we want to extract entire powerclips in the document and extract without X symbol and crop the objects outside of powerclip boundary. so that we get exactly what we can see before entering in any of powerclip box.
You must find all PowerClip shapes on the sheet inside a Shape range. Then I would treat each PowerClip in the next way:
1. I would firstly edit the PowerClip, then I would group the PowerClip content;
2. I would create a rectangular trim shape having the outside dimensions the grouped shape dimensions plus 5 mm on each side and the interior to trim having the dimensions of the PowerClip.
2 bis. Firstly create a rectangle having dimensions equal withe the group ones plus 5 mm on each side. It must be centered on the group;
2 bis bis. Secondly create a rectangle equal with the PowerClip (centered on it) and trim the rectangle described above. In this way you would obtain the trim shape;
3. You should trim now the group using the trim shape created above (with false for both Trim parameters in order to delete the intermediary tools);
4. Ungroup the remained PowerClip Content (if necessary);
5. Extract PowerClip content and delete the PowerClip shape itself.
Now I am busy but when I will have some time, if you did not find o solution and you confirm that you still need one, I will try to make the code...
Here is the code doing what I understood you need:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
Sub ExtractTrimedShape() Dim sPCl As ShapeRange, shS As ShapeRange, s As Shape, sExt As Shape Dim finalSh As Shape, pClSh As Shape, sCut As Shape, sInt As Shape ActiveDocument.BeginCommandGroup "CutShapes" For Each pClSh In ActiveLayer.Shapes.All.Shapes.FindShapes(Query:="!@com.powerclip.IsNull") Set shS = pClSh.PowerClip.Shapes.FindShapes() pClSh.PowerClip.EnterEditMode Set s = shS.Group 'Create the bigger rectangle: Set sExt = ActiveLayer.CreateRectangleRect(s.BoundingBox) sExt.SizeWidth = sExt.SizeWidth + 10: sExt.SizeHeight = sExt.SizeHeight + 10 sExt.CenterX = s.CenterX: sExt.CenterY = s.CenterY 'Create the cutting rectangle: Set sInt = ActiveLayer.CreateRectangleRect(pClSh.BoundingBox) 'Create cutting shape: Set sCut = sInt.Trim(sExt, False, False) 'Cutting the group: Set finalSh = sCut.Trim(s, False, False) pClSh.PowerClip.LeaveEditMode pClSh.PowerClip.ExtractShapes pClSh.PowerClip.Parent.Delete Next ActiveDocument.EndCommandGroup End Sub
The shapes of each PowerClip remained grouped. To ungroup them it's easy... It works in document unit = millimeter. It will work also (I think) for other measuring units but 10 inch to extend the size it's too much...
Tested in Corel X8 64 bit.
It's that what you needed? If yes, can you explain why such a need...?
yes this is what i am looking for but i have 2 questions why we have added 10 in bigger rectangle and if i want to use this code in entire document then how can i do that too?
My colleague is working on a project and she is not well from few days back and deadline is approaching and i have to refurbished last year college prospectus pictures which are power clipped and more then half of the pictures in prospectus need to be replaced and that's why i am looking for some faster ways.
In my previous reply I explained what the code should do...
(2.) issue - you need to create the exterior rectangle for so named 'cut shape'. This must be a little bigger than all PowerClip shapes. In order to be sure that everything will be cut. That 5 mm on each side ( 10 mm for both sizes) was my choice. It could be 1 mm or even nothing...
In order to do all that on all Pages you should add a For Each loop to iterate through all that pages...
Sub ExtractTrimedShape() Dim sPCl As ShapeRange, shS As ShapeRange, s As Shape, sExt As Shape Dim finalSh As Shape, pClSh As Shape, sCut As Shape, sInt As Shape Dim Pg As Page ActiveDocument.BeginCommandGroup "CutShapes" For Each Pg In ActiveDocument.Pages For Each pClSh In Pg.Shapes.All.Shapes.FindShapes(Query:="!@com.powerclip.IsNull") Set shS = pClSh.PowerClip.Shapes.FindShapes() pClSh.PowerClip.EnterEditMode Set s = shS.Group 'Create the bigger rectangle: Set sExt = ActiveLayer.CreateRectangleRect(s.BoundingBox) sExt.SizeWidth = sExt.SizeWidth + 10: sExt.SizeHeight = sExt.SizeHeight + 10 sExt.CenterX = s.CenterX: sExt.CenterY = s.CenterY 'Create the cutting rectangle: Set sInt = ActiveLayer.CreateRectangleRect(pClSh.BoundingBox) 'Create cutting shape: Set sCut = sInt.Trim(sExt, False, False) 'Cutting the group: Set finalSh = sCut.Trim(s, False, False) pClSh.PowerClip.LeaveEditMode pClSh.PowerClip.ExtractShapes pClSh.PowerClip.Parent.Delete Next Next ActiveDocument.EndCommandGroup End Sub
In order to speed up the process in case of big files you could add at the beginning and at the end the next rows:
1 2 3 4 5 6 7
EventsEnabled = False Optimization = True 'existing code... Optimization = False EventsEnabled = True
I usually optimize the code speed only after checking it. Now I do not have such a document in order to check it...
When you receive an error you could see where the code stopped and what it did until that time.
I must confess that I still not understand that need. Why you cannot use the powerClip like it is, just making the outline = none...? And you obtain the same visual effect with less effort. Why is necessary to do all that just in order to 'replace pictures in prospectus'...?
enter and exit in all powerclip 1 by 1 take alot of time
Before this code i am entering in edit mode then change picture then comes out in all powerclip 1 by 1
after this code i just have to change the pictures thats it. i have skipped enter and exit powerclip part as simple as that i am just saving my time. there is so much pressure of work. due to deadlines i asked for help. thanks you soo much Mr. FaneDuru.