CCM get profile

Code:

Sub Dotgain()
' Description: Dot Gain with Field Insert
'
'
Dim CMYKProfileUsed As String
Dim OrigSelection As ShapeRange
Set CMYKProfileUsed = ColorManager.CurrentProfile(2).ColorProfile.Name
'the above line is in error... I can't find an example got any clues?
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed
ActiveWindow.Refresh
End Sub

Yani

[shelbym]

Take out the colorprofile like this:

ColorManager.CurrentProfile(clrSeparationPrinter).Name

At least this works in CorelDRAW X3.

Thanks,

Shelby

That makes sense... Now I have a Compile error on
Set CMYKProfileUsed...

Thanks Shelby. I'm going to need a bit of a hand with this I'm less than flash at macros in draw...

...

Sub DotgainBW()
'
' Description:
' Dot Gain with Field Insert
'
'Gets the name of the current profile in use
'
Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name
'
'Inputs the Profile Name into the Ojbect Data Field "Profile"
'
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed
'
'Resample the bitmap and converts to the current profile
'
Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)
End Sub

The above is what the final macro will look like...

I sorted out that you don't use "set".

And I can make this code work in parts.

But when I put it together is breaks.

Stuffed if I can see why?

Yani

[shelbym]

I am really not sure what you are trying to do. Saving the profile to the objectData and then converting that object to a bitmap looses those settings. But this code here works and generate no errors. If I knew exactly what you were trying to do I might be able to help a little more.

I added the CheckDataItem sub so that is checks to see if the DataItem is there, if not it creates it. I do believe X3 has an easier way to do this, but this is code I all ready have and know works.

Sub DotgainBW()

Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name

Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
CheckDataItem ("Profile")
ActiveSelection.ObjectData("Profile").Value = CMYKProfileUsed

Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)

End Sub

Private Sub CheckDataItem(diName As String)

Dim bFound As Boolean
Dim df As DataField

bFound = False

For Each df In ActiveDocument.DataFields
    If df.Name = diName Then
        bFound = True
        Exit For
    End If
Next df

If bFound = False Then ActiveDocument.DataFields.Add diName, , True, True

End Sub

Hope it helps,
Shelby

Thanks that was one of the questions I hadn't even asked yet...

Code:

Sub Macro2()
'
' Recorded 30/01/2006
'
' Description:
'
'
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Profile").Value = "my silly name"
Dim s1 As Shape
Set s1 = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)
End Sub

The above works but once I introduce the var for current profile it fails...

"What am I trying to do?"

Take a number of processes that I do manually automate them so that a comment is made in the Object Data Field so I can track which objects have been processed.

applying a profile to B&W bitmaps
converting RGB bitmaps to CMYK

stuff like that.

Yani

OK I think I kinda see what is happening...

If I convert the bitmap first I loose the selection.

If I add the Data Field first then playing with the bitmap makes a new object and deletes the data.

Yet for some reason the recorded macro which did the same stuff works fine as long as the field is a "string" and not a variable.

Yani

Code...

Sub DotgainBW()

Dim CMYKProfileUsed As String
CMYKProfileUsed = ColorManager.CurrentProfile(clrSeparationPrinter).Name

Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim myBitmap As Shape
Set myBitmap = OrigSelection.ConvertToBitmapEx(cdrGrayscaleImage, False, True, 300, cdrNoAntiAliasing, True, False, 95)

CheckDataItem ("Profile")
myBitmap.ObjectData("Profile").Value = CMYKProfileUsed

myBitmap.Selected = True

Application.Refresh
Refresh

End Sub

Private Sub CheckDataItem(diName As String)

Dim bFound As Boolean
Dim df As DataField

bFound = False

For Each df In ActiveDocument.DataFields
If df.Name = diName Then
bFound = True
Exit For
End If
Next df

If bFound = False Then ActiveDocument.DataFields.Add diName, , True, True

End Sub


That works...

Thanks for the help much appreciated.

Yani