code request

[mtracy]

If selected shape has a contour then select both or add both to selection

[mtracy]

This is what I'm trying to accomplish. It has always been annoying to me that when a shape has a contour attached i.e. a "Control Curve, Control Rectangle, etc." and you select it to duplicate it you only get the orig shape and not the contour with it. Yes, I know you can click on the actual contour then duplicate it but I'd like to be able to automatically grab both. So my idea was to create a SelectionChange event that would check a shape as you select it and if it's a "Control shape" the contour is then added to the shape selection and if it did not have a contour or Control then leave as is or exit the sub. Same goes with drop shadows too. if you want to duplicate a shape AND it's shadow you have to click on the shadow not JUST the shape itself.
Maybe If s.Properties.Description = "Control" then....

[shelbym]

Here you go, select your shape or shapes and run the SelectEffects

Sub SelectEffects()
    Dim sr As ShapeRange, srNewSelection As New ShapeRange
    Dim s As Shape
    Dim eff As Effect
    
    Set sr = ActiveSelectionRange
    
    For Each s In sr.Shapes
        If s.Effects.Count > 0 Then
            AddShape srNewSelection, s
        Else
            srNewSelection.Add s
        End If
    Next s
    
    srNewSelection.CreateSelection
End Sub

Private Sub AddShape(ByVal sr As ShapeRange, ByVal s As Shape)
    Dim eff As Effect
    Dim eff2 As Effect
    
    If s Is Nothing Then Exit Sub
    If sr.IndexOf(s) <> 0 Then Exit Sub
    sr.Add s
    
    For Each eff In s.Effects
        AddEffect sr, eff
    Next eff
End Sub

Private Sub AddEffect(ByVal sr As ShapeRange, ByVal eff As Effect)
    Dim eff2 As Effect
    
    Select Case eff.Type
        Case cdrTextOnPath
            AddShape sr, eff.TextOnPath.Path
        Case cdrExtrude
            AddShape sr, eff.Extrude.BevelGroup
            AddShape sr, eff.Extrude.ExtrudeGroup
        Case cdrDropShadow
            AddShape sr, eff.DropShadow.ShadowGroup
        Case cdrControlPath
            For Each eff2 In eff.ControlPath.Effects
                AddEffect sr, eff2
            Next eff2
        Case cdrContour
            AddShape sr, eff.Contour.ContourGroup
        Case cdrBlend
            AddShape sr, eff.Blend.BlendGroup
            AddShape sr, eff.Blend.StartShape
            AddShape sr, eff.Blend.EndShape
            AddShape sr, eff.Blend.Path
    End Select
End Sub

[mtracy]

Thanks Shelby but unfortunately I won't be able to make it automatically run whenever I select a control shape. Tried the SelectionChange method but it just continues to loop thru

[mtracy]

Thanks to FanDuru over in the Corel forums and with a couple of added lines of my own, I now have it. Add the following to any "ThisMacroStorage" section and give it a try.

Private Sub GlobalMacroStorage_SelectionChange()
Dim s As Shape, eff As EffectContour, contR As ShapeRange
Set s = ActiveShape
If ActiveSelectionRange.Count = 0 Then Exit Sub
If ActiveSelectionRange.Count > 0 Then
If s.Effects.Count > 0 Then
For i = 1 To s.Effects.Count
If s.Effects(i).Type = cdrContour Then
Set eff = s.Effects(i).Contour
Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s)
contR.AddToSelection
End If
Exit For
Next i

End If
End If
End Sub

[mtracy]

macro updated

Private Sub GlobalMacroStorage_SelectionChange()
Dim s As Shape, eff As EffectContour, contR As ShapeRange
Set s = ActiveShape
If Documents.count < 1 Then Exit Sub
If ActiveSelectionRange.count = 0 Then Exit Sub
If ActiveSelectionRange.count > 0 Then
If s.Effects.count > 0 Then
For i = 1 To s.Effects.count
If s.Effects(i).Type = cdrContour Then
Set eff = s.Effects(i).Contour
Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s)
contR.AddToSelection
End If
Exit For
Next i
End If
End If
End Sub

[mtracy]

Private Sub GlobalMacroStorage_SelectionChange()
Dim s As Shape, effC As EffectContour, effDS As EffectDropShadow, effSh As ShapeRange, i As Long
Set s = ActiveShape
If Not s Is Nothing Then
If s.Effects.count > 0 Then
For i = 1 To s.Effects.count
If s.Effects(i).Type = cdrContour Then
Set effC = s.Effects(i).Contour
Set effSh = ActiveDocument.CreateShapeRangeFromArray(effC.ContourGroup, s)
effSh.AddToSelection
ElseIf s.Effects(i).Type = cdrDropShadow Then
Set effDS = s.Effects(i).DropShadow
Set effSh = ActiveDocument.CreateShapeRangeFromArray(effDS.ShadowGroup, s)
effSh.AddToSelection
End If
Next i
End If
End If
End Sub