OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 14-12-2016, 16:00
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default code request

If selected shape has a contour then select both or add both to selection
__________________
Myron Tracy
Accent Signs
Reply With Quote
  #2  
Old 15-12-2016, 11:23
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default

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....
__________________
Myron Tracy
Accent Signs
Reply With Quote
  #3  
Old 15-12-2016, 14:03
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Select Effects

Here you go, select your shape or shapes and run the SelectEffects
Code:
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
Reply With Quote
  #4  
Old 15-12-2016, 14:36
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default

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
__________________
Myron Tracy
Accent Signs
Reply With Quote
  #5  
Old 16-12-2016, 10:54
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default

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
__________________
Myron Tracy
Accent Signs
Reply With Quote
  #6  
Old 19-12-2016, 12:57
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default

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
__________________
Myron Tracy
Accent Signs
Reply With Quote
  #7  
Old 20-12-2016, 09:23
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 30
Default Macro updated to include drop shadow effects

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
__________________
Myron Tracy
Accent Signs
Reply With Quote
Reply

Tags
contour, if shape


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Feature Request joan New product ideas 1 05-05-2011 20:26
Re-registration Request Gary Allred Jigsaw Puzzle Creator 0 10-06-2009 10:54
Odd Request... Timers in .cdr files? bprice CorelDRAW/Corel DESIGNER VBA 6 23-07-2008 06:48
DRAW 13 Request... ddonnahoe CorelDRAW/Corel DESIGNER VBA 5 11-04-2005 08:25
CW 4.1 features request Denis Korotkov Calendar Wizard 3 13-09-2004 08:44


All times are GMT -5. The time now is 02:41.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com