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 21-10-2004, 14:58
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default Relace all colors but black...

I am trying to create a quicker way to process all shapes on a page or selection and if a color is not black, then it gets changed to white. That way, all I'm left with is the black showing.

BTW I am using CD11.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 22-10-2004, 09:02
Seelenquell
Guest
 
Posts: n/a
Default

should work in 12 and 11, too, i think

Code:
Sub testcolor()
    Application.ActiveDocument.BeginCommandGroup "Blackonly"
    Dim s As Shape
    Dim clr As New Color
    clr.CMYKAssign 100, 0, 0, 0 ' Initial color
    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
            s.Fill.UniformColor.ConvertToCMYK
            c = s.Fill.UniformColor.CMYKCyan
            m = s.Fill.UniformColor.CMYKMagenta
            y = s.Fill.UniformColor.CMYKYellow
            k = s.Fill.UniformColor.CMYKBlack
            v = c & m & y & k
            If Not v = "000100" Then
                s.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
            End If
        End If
        'outline
        If s.outline.Type = cdrOutline Then
            s.outline.Color.ConvertToCMYK
            c = s.outline.Color.CMYKCyan
            m = s.outline.Color.CMYKMagenta
            y = s.outline.Color.CMYKYellow
            k = s.outline.Color.CMYKBlack
            v = c & m & y & k
            If Not v = "000100" Then
                s.outline.Color.CMYKAssign 0, 0, 0, 0
            End If
        End If
    Next s
    Application.ActiveDocument.EndCommandGroup
End Sub
Reply With Quote
  #3  
Old 22-10-2004, 10:42
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Thanks, I appreciate that. I made a few tweaks to get it perfected for my use, but you gave me an excellent starting block.
Code:
Option Explicit

Sub testcolor()
    ActiveDocument.Selection.Shapes.All.UngroupAll
    Application.ActiveDocument.BeginCommandGroup "Blackonly"
    Dim s As Shape
    Dim c As Long
    Dim m As Long
    Dim y As Long
    Dim k As Long
    Dim v As Long
    Dim clr As New Color
    clr.CMYKAssign 100, 0, 0, 0 ' Initial color
    For Each s In ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then
            s.Fill.UniformColor.ConvertToCMYK
            c = s.Fill.UniformColor.CMYKCyan
            m = s.Fill.UniformColor.CMYKMagenta
            y = s.Fill.UniformColor.CMYKYellow
            k = s.Fill.UniformColor.CMYKBlack
            v = c & m & y & k
            If Not v = "000100" Then
                s.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
            End If
        End If
        'outline
        If s.Outline.Type = cdrOutline Then
            s.Outline.Color.ConvertToCMYK
            c = s.Outline.Color.CMYKCyan
            m = s.Outline.Color.CMYKMagenta
            y = s.Outline.Color.CMYKYellow
            k = s.Outline.Color.CMYKBlack
            v = c & m & y & k
            If Not v = "000100" Then
                s.Outline.Color.CMYKAssign 0, 0, 0, 0
            End If
        End If
    Next s
    Application.ActiveDocument.EndCommandGroup
End Sub
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 22-10-2004, 11:49
Seelenquell
Guest
 
Posts: n/a
Default

no prob..

was made in 10 minutes without optimizing it
Reply With Quote
  #5  
Old 22-10-2004, 17:43
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Quote:
Originally Posted by Seelenquell
If Not v = "000100" Then...
That's an interesting way of comparing color

You could also try using Color.Name properties with its optional parameter set to True. By default, the Name property returns the name of the color, such as "Black" or "Red". However if the parameter is True, it returns a string containing color components instead, such as "C:0 M:0 Y:0 K:100". You can use that to compare:

Code:
If clr.Name(True) <>  "C:0 M:0 Y:0 K:100" Then ...
Also you haven't used the "clr" valuable you defined. I guess you meant to have it store the working color you are getting from fill/outline so it can be converted to CMYK?
Reply With Quote
  #6  
Old 23-10-2004, 11:24
Seelenquell
Guest
 
Posts: n/a
Default

yeah, the "clr" is the rest of the first tries..

should ignore it.
Reply With Quote
  #7  
Old 05-11-2004, 14:38
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Another tweak i'd like to do to this macro, is make it look for colors with 90% or better of black and convert it to 0:0:0:100
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #8  
Old 22-11-2004, 18:09
Mark
Guest
 
Posts: n/a
Default Convert vector shapes to black and white

I recently had a post going trying to shift colors towards black or white. The topic never really got anywhere...however by mooching off Alex's genious I came up with a quick fix by creating some black & white rectangles and then passing the template through Alex's DoPosterize script in his LimitColors project. My templates are only a couple inches big. I don't know enough about Alex's code to know whether the amount of rectangles is necessary or how to make the code work any better, but the below code works pretty well for me. Any suggestions would be great. My idea was to shift colors such as blue to black and yellow to white; but the cmyk values are all over the board throughout most of our clipart.

Code:
Sub ConvertToBlackAndWhite()
    If ActiveLayer.Shapes.Count < 1 Then End
    ActiveDocument.BeginCommandGroup "Convert to Black & White"
    ActiveDocument.Unit = cdrInch
    Dim n As Long
    ActivePage.CreateLayer ("Temp")
    ActivePage.Layers("Temp").Activate
    For n = 1 To 50
        ActiveLayer.CreateRectangle2 Rnd() * 8, Rnd() * 11, Rnd() * 5, Rnd() * 5
        If n Mod 2 = 0 Then
            ActiveShape.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
        Else
            ActiveShape.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
        End If
    Next n
    
    ActiveDocument.ClearSelection
    DoPosterize 2, 0, 0, 0
    ActivePage.Layers("Temp").Delete
    ActiveDocument.ClearSelection
    ActiveDocument.EndCommandGroup
End Sub
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
Getting a list of all colors in a Document CORNMEN CorelDRAW/Corel DESIGNER VBA 5 15-11-2008 05:14
Palette (or Colors array) property in VBA class in CDR12 zlatev CorelDRAW/Corel DESIGNER VBA 7 22-02-2005 11:28
Wish to Convert Named Colors to Shape Color D_Green CorelDRAW/Corel DESIGNER VBA 1 12-09-2004 11:08
Color to Black & White Mark CorelDRAW/Corel DESIGNER VBA 3 20-07-2004 14:57
Corel V9- print only printer-safe colors using gamut alarm? Kitemaker CorelDRAW/Corel DESIGNER VBA 5 30-06-2004 16:03


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


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