see above
1 2 3
Dim s As Shape Set s = ActiveShape If s.Type = cdrContourGroupShape Then MsgBox "This shape has a contour...", , "Test Contour"
Myron said:Hmm...no good. At least not in X7. 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....
You did not define 'do something'... I tried that in X8 immediately after contour creation. Let's say in a kind of edit mode and it worked. Just to identify a shape having contour effect...
Is that what you need?
Dim s As Shape, eff As EffectContour Set s = ActiveShape 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 ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s).Copy ActiveLayer.Paste End If Exit For Next i End If
I must confess I did not understand exactly what SelectionChanged event should do but I just hope that CreateShapeRangeFromArray will be the right choice.. Is it?
Of course, if you do not want to copy and maybe do something else, you can use:
Dim contR As ShapeRange
Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s)
I really appreciate all the input. This has been my latest challenge. These, among other things, are what keep me up at night.
I'm ultimately trying to force the "pick tool" to automatically select both the shape and the contour whenever you click on the shape WITHOUT ANY OTHER USER INPUT. Note that you can select a shape that has a contour yet not on the actual contour itself and the description will show it as a Control curve/rectangle/ellipse etc you can move it and the contour stays with it. But if you move the shape and before letting go hit the right mouse button (method I use to duplicate) you only get a copy of the shape and not the contour. Same with hitting the plus sign or cntrl+d to create duplicates. When you have very small shapes that have contours you have to zoom really close in order to click on the actual contour line then duplicate or as I've recently found alt click to get both. Just wish the default would treat the whole as one complete shape as you clicked on it.
And, yes I want the contour to stay editable.
Simple concept -
Click on the shape, duplicate it by any of the various methods available and you get just that, a duplicate of the shape AND the contour with it.
This should do what (I understood) you need...
Private Sub GlobalMacroStorage_SelectionChange() Dim s As Shape, eff As EffectContour, contR As ShapeRange Set s = ActiveShape 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 Sub
It works for me (X8) for click, drop and right click. I did not test something else...
In the meantime checked also Ctrl + D and hitting the plus sign and also works. X8