Macro to delete all outside page

Hi folks,

I am currently working on a macro to delete all content outside the page. This is benificial especially after import of data. This maco could delete eveything outside the page without any further inverstigations if "out there" is something at all (and if so, get rid of it).

My current approach (for now it is assumed every item is accessible, not locked, hidden etc.):

Select all in page
Lock this selection
Select all
Delete
Select all in Page
unlock

I have the feeling that this approach is not very elegant. Any ideas or experience to do this with a different approach?

Thanks!
Christian

0 Eskimo over 2 years ago

You could identify objects to delete based on their position relative to the extents of the page:

Sub delete_objects_outside_page_border()
Dim sr As ShapeRange

    Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.rightx < " & ActivePage.LeftX & " or @com.LeftX > " & ActivePage.RightX & " or @com.BottomY > " & ActivePage.TopY & " or @com.TopY < " & ActivePage.BottomY)
    sr.Delete

End Sub

This is similar, but excludes objects on master layers:

Sub delete_objects_outside_page_border_ignore_master()
Dim sr As ShapeRange

    Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.layer.master = 'false' and (@com.rightx < " & ActivePage.LeftX & " or @com.LeftX > " & ActivePage.RightX & " or @com.BottomY > " & ActivePage.TopY & " or @com.TopY < " & ActivePage.BottomY & ")")
    sr.Delete

End Sub

I don't have Technical Suite, but these seem to work for me - at least for a few simple tests I have tried - in CorelDRAW.

0 Christian Schmaehl over 2 years ago in reply to Eskimo
Hi Eskimo,

this approach is way more elegant, thanks!

Parts of the code work perfectly fine, however some don't, currently I am looking for the root cause.
These parts work:

Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.rightx < " & ActivePage.LeftX) Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.TopY < " & ActivePage.BottomY)

These don't:

Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.Leftx > " & ActivePage.RightX) Set sr = ActivePage.Shapes.FindShapes(, , False, "@com.BottomY > " & ActivePage.TopY)

I tested this with DRAW and DESIGNER 2020, both give this error on the latter:

Currently I do not see any differences of the structure of these two.

Cheers,
Christian
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 Eskimo over 2 years ago in reply to Christian Schmaehl

Sorry, I don't know why those are not working for you on your system.

When I copy and paste your code, all four of those work as expected when I test them on my installation of CorelDRAW 2020.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel
0 Christian Schmaehl over 2 years ago in reply to Eskimo

I appreciate you tested it, then I can proceed finding the cause on my installation.
Cancel
Up 0 Down

Reply

Verify Answer

Cancel

0 Christian Schmaehl over 2 years ago in reply to Christian Schmaehl

After some more testing I suspect that there seem some OS language releant parts to be cleaned up, in my case the decimal point. This test code did the trick (on a German OS):

Private Sub CleanUp_OutsideDoc()
Dim BL As ShapeRange
Dim Page_Right_X, Page_Left_X, Page_Top_Y, Page_Bottom_Y
'------------------------
With ActivePage
    Page_Left_X = Replace(.LeftX, ",", ".")
    Page_Right_X = Replace(.RightX, ",", ".")
    Page_Top_Y = Replace(.TopY, ",", ".")
    Page_Bottom_Y = Replace(.BottomY, ",", ".")
End With
'------------------------
Set BL = ActivePage.Shapes.FindShapes(, , False, _
                                                "@com.rightx < " & Page_Left_X & _
                                            " or @com.LeftX > " & Page_Right_X & _
                                            " or @com.BottomY > " & Page_Top_Y & _
                                            " or @com.TopY < " & Page_Bottom_Y _
                                                )
    BL.Delete
End Sub