OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 10-05-2011, 16:18
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default CQL does not find shapes in PowerClip

hi
I found out that CQL does not find shapes in PowerClip
How to add shapes in PowerClip to say shaperange of textshape type
Reply With Quote
  #2  
Old 10-05-2011, 20:39
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

HI.
Well hopefully there actually is a way to do it entirely with CQL.
But here's something you can use for now...maybe.


Code:
Sub addPCShapesToSR()

    Dim s As Shape, s1 As Shape, sr As ShapeRange, sr2 As New ShapeRange
    Dim pc As PowerClip
    
    Set sr = ActivePage.Shapes.FindShapes
    For Each s In sr
        Set pc = s.PowerClip
        If Not pc Is Nothing Then
            For Each s1 In pc.Shapes
                pc.EnterEditMode
                sr2.Add s1
                pc.LeaveEditMode
            Next s1
        End If
    Next s
    sr2.CreateSelection
End Sub
~John
Reply With Quote
  #3  
Old 11-05-2011, 13:42
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 Powerclip SQL Function

Here is a Function that I wrote that will do this. (And for fun I used CQL to find the powerclips) If nothing is selected it searches the page, if you do have a selection only the selection is searched.
Code:
Function FindAllShapes() As ShapeRange
    Dim s As Shape
    Dim srPowerClipped As New ShapeRange
    Dim sr As ShapeRange, srAll As New ShapeRange
    
    If ActiveSelection.Shapes.Count > 0 Then
        Set sr = ActiveSelection.Shapes.FindShapes()
    Else
        Set sr = ActivePage.Shapes.FindShapes()
    End If
    
    Do
        For Each s In sr.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
            srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
        Next s
        
        srAll.AddRange sr
        sr.RemoveAll
        sr.AddRange srPowerClipped
        srPowerClipped.RemoveAll
    Loop Until sr.Count = 0
    
    Set FindAllShapes = srAll
End Function
You then can use the Function and CQL and you should get the results you wanted.
Code:
Sub Testing()
    FindAllShapes.Shapes.FindShapes(Query:="@fill.color = 'green'").ApplyUniformFill CreateRGBColor(255, 255, 0)
End Sub
Hope that helps,

-Shelby
Reply With Quote
  #4  
Old 11-05-2011, 18:44
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
I love it Shelby. I like how you dig into the Powerclips.
Here's a little modification of it that allows you to specify a level of Powerclipped shapes.

Set lngLevel to:
-1 to get all Powerclipped shapes only regardless of how many levels deep they go..
0 or leave blank to get all shapes, as you have it.
1 Plus to get shapes based on what level deep they are powerclipped. Example: Set to 2 to get shapes that are 2 levels deep Powerclipped.

~John

Code:
Sub Testing2()
    FindAllPCShapes(2).Shapes.FindShapes.ApplyUniformFill CreateRGBColor(255, 255, 0)
End Sub

Function FindAllPCShapes(Optional LngLevel As Long) As ShapeRange ' Shelby's function
    Dim s As Shape
    Dim srPowerClipped As New ShapeRange, srJustClipped As New ShapeRange
    Dim sr As ShapeRange, srAll As New ShapeRange
    Dim bFound As Boolean, i&
    
    bFound = False
    If ActiveSelection.Shapes.count > 0 Then
        Set sr = ActiveSelection.Shapes.FindShapes()
    Else
        Set sr = ActivePage.Shapes.FindShapes()
    End If
    i = 0
    Do
        For Each s In sr.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
            srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
        Next s
        If srPowerClipped.count > 0 Then bFound = True: i = i + 1
        If i = LngLevel And bFound Then Set FindAllPCShapes = srPowerClipped: Exit Function
        bFound = False
        srAll.AddRange sr
        sr.RemoveAll
        sr.AddRange srPowerClipped
        If LngLevel = -1 Then srJustClipped.AddRange srPowerClipped
        srPowerClipped.RemoveAll
    Loop Until sr.count = 0
    
    If LngLevel = -1 Then
        Set FindAllPCShapes = srJustClipped
    Else
        Set FindAllPCShapes = srAll
    End If
End Function
Reply With Quote
Reply


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
find touching shapes runflacruiser Code Critique 7 17-04-2012 09:28
FInd index of shapes grouped with text rubidoux CorelDRAW/Corel DESIGNER VBA 3 07-10-2007 23:00
powerclip extract zaum CorelDRAW/Corel DESIGNER VBA 2 26-10-2005 08:26
Find only shapes with compound path zlatev CorelDRAW/Corel DESIGNER VBA 1 15-02-2005 08:05
How can I find shortest distance between two curves, shapes? Jab CorelDRAW/Corel DESIGNER VBA 3 22-12-2004 14:16


All times are GMT -5. The time now is 08:18.


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