Is there a way to group all touching objects in CorelDraw 2018?

I have a bunch of clipart sets, and all the objects in them are separate. I'm wondering if there is a macro or method I could use to combine all the objects that are touching together to make them easier to work with.

I tried some code from here, but I'm not sure if it just doesn't work in 2018 or if it only works for overlapping shapes, rather than merely touching shapes that share a line. https://community.coreldraw.com/talk/coreldraw_x3_and_older/f/coreldraw-x3/21693/group-touching-objects

Parents
  • Just wanted to update, I hired a freelancer to write a script to do it for me, and I'm dropping the code here just in case anyone else can use it!

    Sub grouptouchingall()
    Dim sElemChecking As Shape, sElemLoop As Shape, sGrouped As Shape, s As Shape
    Dim srTotal As ShapeRange, srGroup As ShapeRange
    Dim groupCount As Integer, i As Integer, j As Integer, k As Integer

    Set srTotal = ActivePage.Shapes.FindShapes
    If srTotal.Count < 1 Then Exit Sub

    While srTotal.Count > 0
    Set sElemChecking = srTotal(1)
    Set srGroup = New ShapeRange
    srGroup.Add sElemChecking
    srTotal.Remove (1)
    sElemChecking.CreateSelection
    groupCount = 0
    i = 1
    While groupCount <> srGroup.Count
    groupCount = srGroup.Count
    For i = i To srGroup.Count
    Set sElemChecking = srGroup(i)
    k = 0
    For j = 1 To srTotal.Count
    Set sElemLoop = srTotal(j - k)
    If sElemLoop.IsSimpleShape Then
    If sElemChecking.DisplayCurve.IntersectsWith(sElemLoop.DisplayCurve) Then
    srGroup.Add sElemLoop
    srTotal.Remove (j - k)
    k = k + 1
    ElseIf (sElemChecking.IsOnShape(sElemLoop.CenterX, sElemLoop.CenterY) <> cdrOutsideShape) Or (sElemLoop.IsOnShape(sElemChecking.CenterX, sElemChecking.CenterY) <> cdrOutsideShape) Then
    srGroup.Add sElemLoop
    srTotal.Remove (j - k)
    k = k + 1
    End If
    Else
    srTotal.Remove (j - k)
    k = k + 1
    End If
    Next
    Next
    Wend
    If srGroup.Count > 1 Then
    Set sGrouped = srGroup.Group
    sGrouped.CreateSelection
    End If
    Wend
    End Sub

Reply Children
No Data