OberonPlace.com Forums  

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

Reply
 
Thread Tools Search this Thread Display Modes
  #11  
Old 05-09-2011, 01:58
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Fountain to bitmap

Thanks Shelby.

Write me please if this can be rewrite code so that it acted under v. 12?
If it can be done, is attempting?
Maybe someone else has to struggle with this code?

Thank you very much in advance.

Yours.
~GrzJanik
Reply With Quote
  #12  
Old 05-09-2011, 10:34
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
I think this mod would do but I didn't test.

Code:
Sub GradientToPowerclip()
    Const dblEnlarge = 1
    Dim s As Shape, sDup As Shape
    Dim sr As ShapeRange
    
    ActiveDocument.ReferencePoint = cdrCenter 'Set reference point to the center
    ActiveDocument.Unit = cdrMillimeter 'Set our unit to millimeters
    
    Set sr = ActivePage.Shapes.FindShapes()
    
    For Each s In sr.Shapes 'Loop thtough all the shapes found
        If s.Fill.Type = cdrFountainFill Then
            Set sDup = s.Duplicate 'Make a duplicate
            sDup.SetSize s.SizeWidth + dblEnlarge, s.SizeHeight + dblEnlarge 'Increase the size by our Constant
            sDup.Fill.Fountain.Steps = 999 'Set fountain fill steps to 999
            sDup.Outline.SetNoOutline 'Remove outline from duplice
            Set sDup = sDup.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True) 'Convert to Bitmap
            s.Fill.ApplyNoFill 'Remove fill from original shape
            sDup.AddToPowerClip s 'Place the bitmap in the orginal shape
        End If
    Next s
End Sub
~John
Reply With Quote
  #13  
Old 07-09-2011, 02:06
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Error

Thanks John.

Unfortunately does not work.
Errors shown below:





What to do about it now?
Reply With Quote
  #14  
Old 07-09-2011, 07:40
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
That's what I get for not testing.
Sorry, I'm unable to spend more time on this at the moment.
Try this new mod of Shelby's code:

~John

Code:
Sub GradientToPowerclip()
    Const dblEnlarge = 1
    Dim s As Shape, sDup As Shape
    Dim sr As ShapeRange
    
    ActiveDocument.ReferencePoint = cdrCenter 'Set reference point to the center
    ActiveDocument.Unit = cdrMillimeter 'Set our unit to millimeters
    
    Set sr = ActivePage.Shapes.FindShapes()
    
    For Each s In sr 'Loop thtough all the shapes found
        If s.Fill.Type = cdrFountainFill Then
            Set sDup = s.Duplicate 'Make a duplicate
            sDup.SetSize s.SizeWidth + dblEnlarge, s.SizeHeight + dblEnlarge 'Increase the size by our Constant
            sDup.Fill.Fountain.Steps = 999 'Set fountain fill steps to 999
            'sDup.Outline.SetNoOutline 'Remove outline from duplice
            Set sDup = sDup.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True) 'Convert to Bitmap
            s.Fill.ApplyNoFill 'Remove fill from original shape
            sDup.AddToPowerClip s 'Place the bitmap in the orginal shape
        End If
    Next s
End Sub
Reply With Quote
  #15  
Old 08-09-2011, 01:30
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Yes! Yes! Yes! :)

Hello!
Boys You are great.
The code works in Corel 12 after a small change.
Big thank you for your time and willingness.
The following valid code:

Quote:
Sub GradientToPowerclipAll()
Const dblEnlarge = 1
Dim s As Shape, sDup As Shape
Dim sr As ShapeRange

ActiveDocument.ReferencePoint = cdrCenter 'Set reference point to the center
ActiveDocument.Unit = cdrMillimeter 'Set our unit to millimeters

Set sr = ActivePage.Shapes.FindShapes()

For Each s In sr 'Loop thtough all the shapes found
If s.Fill.Type = cdrFountainFill Then
Set sDup = s.Duplicate 'Make a duplicate
sDup.SetSize s.SizeWidth + dblEnlarge, s.SizeHeight + dblEnlarge 'Increase the size by our Constant
sDup.Fill.Fountain.Steps = 999 'Set fountain fill steps to 999
sDup.Outline.SetProperties 0# 'Remove outline from duplice
Set sDup = sDup.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True) 'Convert to Bitmap
s.Fill.ApplyNoFill 'Remove fill from original shape
sDup.AddToPowerClip s 'Place the bitmap in the orginal shape
End If
Next s
End Sub
Best regards.
~GrzJanik
Reply With Quote
  #16  
Old 08-09-2011, 13:37
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Entire document

Hi.
I noticed that the code works only on the current page.
If you can help convert him to work on the entire document (the groups, powerclips, all pages).
Thank you and best regards.
~GrzJanik

Last edited by grzjanik; 05-10-2011 at 12:44.
Reply With Quote
Reply

Tags
adobe, bitmap, corel, fountain, powerclip


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
CQL does not find shapes in PowerClip aakkaarr CorelDRAW/Corel DESIGNER VBA 3 11-05-2011 17:44
Rotation and PowerClip Craig Tucker CorelDRAW/Corel DESIGNER VBA 3 23-08-2007 16:31
How to convert transparencies to bitmap in nested powerclip designhouse CorelDRAW/Corel DESIGNER VBA 2 29-04-2007 03:07
powerclip extract zaum CorelDRAW/Corel DESIGNER VBA 2 26-10-2005 07:26
[BUG] - Fountain fill is'nt rotate in powerclip Kursad General 3 01-07-2005 21:01


All times are GMT -5. The time now is 17:36.


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