Convert lenses to bitmaps - help

[grzjanik]

Hi, guys.

Sorry for my english.

I'm use Corel 12 and have problem with powerclips.
Alex's code (thanks Alex) converts all lenses to bitmaps on the Active.page.
Unfortunately bitmap in powerclips change size and position.
I don't know why.

Code:

Sub ConvertLensesWithTransTest()
Dim s As Shape, sr As ShapeRange
Set sr = ActivePage.Shapes.FindShapes()
For Each s In sr
If Not s.Effects.LensEffect Is Nothing Then
s.ConvertToBitmapEx cdrCMYKColorImage, True, True, 300, cdrNormalAntiAliasing, True
End If
Next s
End Sub

Screens before and after:



Please any help.

Regards.

~GrzJanik

[shelbym]

If I recall CorelDRAW 12 had issues with powerclips and lenses. The code you have should not see the lens in the powerclip at all, it should just ignore it.

-Shelby

[grzjanik]

Thanks Shelby/

How to skip the powerclips?

[grzjanik]

Maybe instead of skip powerclips, do this:

1. search for shapes (and convert lenses)
2. if found PowerClip - enter edit mode
3. search for shapes (and convert lenses)
4. if there are no lenses - leave edit mode
5. search for shapes (and convert) next
6. and so to the end of the page

Then the change will apply to all objects on the page.

Is this possible?

This is very important for me.

Thanks for help.
~GrzJanik

[grzjanik]

Maybe some other solution to get the desired effect?

~GrzJanik

[shelbym]

Alright, I had a little time to look at this, give this a try. The only issue with this code is that it will not dig into groups.

Sub ConvertLensesWithTransTest()
    Dim s As Shape, ss As Shape
    
    For Each s In ActivePage.Shapes
        If Not s.PowerClip Is Nothing Then
            s.PowerClip.EnterEditMode
                For Each ss In s.PowerClip.Shapes
                    If Not ss.Effects.LensEffect Is Nothing Then
                        ss.ConvertToBitmapEx cdrCMYKColorImage, True, True, 300, cdrNormalAntiAliasing, True
                    End If
                Next ss
            s.PowerClip.LeaveEditMode
        Else
            If Not s.Effects.LensEffect Is Nothing Then
                s.ConvertToBitmapEx cdrCMYKColorImage, True, True, 300, cdrNormalAntiAliasing, True
            End If
        End If
    Next s
End Sub

Best of luck,

-Shelby

[grzjanik]

Thanks Shelby.

Thats great work!

This is code works with groups:

Sub ConvertLensesWithTrans()
Dim s As Shape, ss As Shape, sr As ShapeRange
Set sr = ActivePage.Shapes.FindShapes()
For Each s In sr
On Error Resume Next
If Not s.PowerClip Is Nothing Then
s.PowerClip.EnterEditMode
For Each ss In s.PowerClip.Shapes
If Not ss.Effects.LensEffect Is Nothing Then
ss.ConvertToBitmapEx cdrCMYKColorImage, True, True, 300, cdrNormalAntiAliasing, True
End If
Next ss
s.PowerClip.LeaveEditMode
Else
If Not s.Effects.LensEffect Is Nothing Then
s.ConvertToBitmapEx cdrCMYKColorImage, True, True, 300, cdrNormalAntiAliasing, True
End If
End If
Next s
End Sub

Best of luck,

~GrzJanik

PS. When pasting text in the quote my tabs is disappear, why?

[shelbym]

Don't use Quote, use Code. :-) It will keep the formatting.

-Shelby

[grzjanik]

Sub Thanks_Shelby()

    Msgbox "I'll remember."
        
        ' :)  

End Sub

Regards.

~GrzJanik