Corel Photopaint script available from Corel Draw?

Hi,

I recorded the script below in Photo-Paint. I would now like to run this directly from Corel Draw using the "Run Script" command.
Error comes up
"run-time error 1002
OLE automation error (you need an open document for this operation)"
Also then I think I would have problem with the Save function.

This all should save me from going "Edit Bitmap", running the script in PP, saving the document and closing PP. Does this make sense?

Any help would be appreciated.
I'm using X4.
Ta.
Fungel


REM Created in Corel PHOTO-PAINT Version 14.0.0.701
REM Created On Sunday, November, 21, 2010 by Administrator

WITHOBJECT "CorelPHOTOPAINT.Automation.14"
.ObjectSelectAll
.MaskCreate TRUE, 0, FALSE
.ObjectSelectNone
.ObjectSelect 1, TRUE
.EndMaskCreate
.MaskReduce 2
.MaskInvert
.EditClear 5, 245, 245, 245, 0
.FileSave CHR(7) + "C:+AFw-Documents and Settings+AFw-Administrator+AFw-Local Settings+AFw-Temp+AFw-Bitmap in Test.cdr.CPT", 1808, 0
END WITHOBJECT

I found this post and thought this might help: http://forum.oberonplace.com/showthr...ghlight=script

[shelbym]

I basically took the macro and ran it via VBA. It seems to work.

Sub Testing()
    With CorelScript
        .ObjectSelectAll
        .MaskCreate True, 0, False
        .ObjectSelectNone
        .ObjectSelect 1, True
        .EndMaskCreate
        .MaskReduce 2
        .MaskInvert
        .EditClear 5, 245, 245, 245, 0
        .FileSave "C:\temp\Test.CPT", 1808, 0
    End With
End Sub

Best of luck,

-Shelby

Hi,

I have now updated the code as below. The file gets exported and imported back in ok. The problem is that I cannot get Photopaint to actually remove a 2 pixel border around the edge of the graphic for some reason using the code I have... Can anyone help? I'm using X4.

Ta.
Fungel

Private Sub CommandButton69_Click()
Dim appDraw As New CorelDRAW.Application
Dim appPaint As New PHOTOPAINT.Application
Dim filter As CorelDRAW.ExportFilter
Dim docPP As PHOTOPAINT.Document
Dim docDRAW As CorelDRAW.Document
Dim sOrigBitmap As CorelDRAW.Shape, sNewBitmap As CorelDRAW.Shape
Dim x As Double, y As Double

ActiveDocument.BeginCommandGroup "ReducePixels"

If appDraw.ActiveShape.Type = cdrBitmapShape Then
Set sOrigBitmap = appDraw.ActiveShape
Set docDRAW = appDraw.ActiveDocument
sOrigBitmap.GetPosition x, y

Set filter = docDRAW.ExportBitmap("D:\temp\~temp.cpt", cdrCPT, cdrSelection, cdrRGBColorImage, 1835, 2252, 300, 300, cdrNormalAntiAliasing, False, True, False, False, cdrCompressionNone)
filter.Finish

Set docPP = appPaint.OpenDocument("D:\temp\~temp.cpt")
appPaint.CorelScript.ObjectSelectAll
appPaint.CorelScript.MaskCreate True, 0, False
appPaint.CorelScript.MaskReduce 5
appPaint.CorelScript.ObjectClip
appPaint.CorelScript.MaskRemove

docPP.SaveAs("D:\temp\~temp.cpt", cdrCPT).Finish

docPP.Close

docDRAW.ActiveLayer.Import "D:\temp\~temp.cpt"
Set sNewBitmap = appDraw.ActiveSelection
sNewBitmap.SetPosition x, y
sOrigBitmap.Delete
Kill "D:\temp\~temp.cpt"

ActiveDocument.EndCommandGroup
End If
End Sub

[shelbym]

If the goal is to remove a 2 pixel border why send it to Photopaint to do this? You can just crop it by 2 pixels in Draw. Or did I miss something?

-Shelby

Hi Shelby,

I am trying to shrink the mask by 2 pixels around the inside of the graphic also. This is an underbase that I am trying to shrink so a simple crop is not suitable.

Does this make sense?

I have not found a method of doing this in Draw..

Ta.

Fungel

[grzjanik]

Hi guys.

File ~temp.cpt is open in PP but nothing happens!?
Then the file is import corect in CD.

Selected section of code it does not work in PP, why?

Private Sub CommandButton69_Click()
 Dim appDraw As New CorelDRAW.Application
 Dim appPaint As New PHOTOPAINT.Application
 Dim filter As CorelDRAW.ExportFilter
 Dim docPP As PHOTOPAINT.Document
 Dim docDRAW As CorelDRAW.Document
 Dim sOrigBitmap As CorelDRAW.Shape, sNewBitmap As CorelDRAW.Shape
 Dim x As Double, y As Double

 ActiveDocument.BeginCommandGroup "ReducePixels"

 If appDraw.ActiveShape.Type = cdrBitmapShape Then
 Set sOrigBitmap = appDraw.ActiveShape
 Set docDRAW = appDraw.ActiveDocument
 sOrigBitmap.GetPosition x, y

 Set filter = docDRAW.ExportBitmap("D:\temp\~temp.cpt", cdrCPT, cdrSelection, cdrRGBColorImage, 1835, 2252, 300, 300, cdrNormalAntiAliasing, False, True, False, False, cdrCompressionNone)
 filter.Finish

 Set docPP = appPaint.OpenDocument("D:\temp\~temp.cpt")
 appPaint.CorelScript.ObjectSelectAll
 appPaint.CorelScript.MaskCreate True, 0, False
 appPaint.CorelScript.MaskReduce 5
 appPaint.CorelScript.ObjectClip
 appPaint.CorelScript.MaskRemove

 docPP.SaveAs("D:\temp\~temp.cpt", cdrCPT).Finish

 docPP.Close

 docDRAW.ActiveLayer.Import "D:\temp\~temp.cpt"
 Set sNewBitmap = appDraw.ActiveSelection
 sNewBitmap.SetPosition x, y
 sOrigBitmap.Delete
 Kill "D:\temp\~temp.cpt"

 ActiveDocument.EndCommandGroup
 End If
 End Sub

How to fix it?

[grzjanik]

Hi,
can someone tell me what to do?

This is important for me.
~GrzJanik

[shelbym]

Try this, and see if it does what you wish:

Set docPP = appPaint.OpenDocument("D:\temp\~temp.cpt")
appPaint.CorelScript.MaskSelectAll
appPaint.CorelScript.MaskReduce 25
appPaint.CorelScript.ImageCropToMask
appPaint.CorelScript.MaskRemove

Hopefully that helps,

-Shelby

[grzjanik]

Thanks Shelby for Your help.

Your code is work, but...

appPaint.CorelScript.MaskSelectAll - creating rectangle mask of all.

I have one object with transparent.

I must create mask from object but i don't know how.

I'm trying:

appPaint.CorelScript.MaskCreate ????

but no results.

Please help.

Great thanks.

~GrzJanik

[shelbym]

Alright, try this version:

 Set docPP = appPaint.OpenDocument("D:\temp\~temp.cpt")
 docPP.Mask.SelectAll
 docPP.Mask.Reduce 5
 docPP.CropToMask
 docPP.Mask.Delete

Maybe it will work. :-)

-Shelby