I'm wanting to write a script that will change the height of a group of images to 500px. The problem is the images have different aspect ratios and I want the aspect ratios to be the same. When I start the recorder and resize an image to height of 500px and save the script I will get a script that changes the height to 500px and the width to whatever the width was in my first image.
So in the end all the images would have a height of 500px and a width that varies.
Hopefully that makes sense.
Hi,
Hope this helps.
Sub SetAllSelectionsToFiveHundredPx() Dim s As Shape Dim sr As ShapeRange Set sr = ActiveSelectionRange Dim w#, h# Dim calcW# ActiveDocument.Unit = cdrPixel If ActiveSelection.Shapes.Count > 0 Then For Each s In sr s.GetSize w, h calcW = (500 * w) / h s.SizeHeight = 500 s.SizeWidth = calcW Next s Else MsgBox "Well.. select something already." End IfEnd Sub
-John
"The best thing about learning is that it never stops, and the rabbit hole will go as deep as you let it."~Johnwww.gdgmacros.com
Thanks, I'm assuming this is a visual basic script (never worked with VBA). Is it possible to do this using a batch process recorded through Window->Dockers->Recorder? I ask because I also need to crop out a white border from each image before resizing.
Here's what I have so far but it isn't setting the resolution.
WITHOBJECT "CorelPHOTOPAINT.Automation.13" .ImageColorCrop 5, 255, 255, 255, 0, 0, 4, 0, 0, 0 oldh& = .GetDocumentHeight() oldw& = .GetDocumentWidth() newh& = 500 neww& = oldw& * newh& / oldh& .ImageResample neww&,newh&,72,72,TRUEEND WITHOBJECT
I'm great with draw but lost when it comes to photopaint....
Mine works well in draw to set all items to 500 px h
taco_pants: Here's what I have so far but it isn't setting the resolution. WITHOBJECT "CorelPHOTOPAINT.Automation.13" .ImageColorCrop 5, 255, 255, 255, 0, 0, 4, 0, 0, 0 oldh& = .GetDocumentHeight() oldw& = .GetDocumentWidth() newh& = 500 neww& = oldw& * newh& / oldh& .ImageResample neww&,newh&,72,72,TRUEEND WITHOBJECT
That looks about right, perhaps you just need to add the spaces. Here's one that I got from Shelby back in August. Not sure if it was on the Oberon forums or here. You'll need to change the references to version 13.
REM Created in Corel PHOTO-PAINT Version 14.0.0.701REM Created On Saturday, August, 08, 2009 by ShelbyWITHOBJECT "CorelPHOTOPAINT.Automation.14"h& = .GetDocumentHeight()w& = .GetDocumentWidth()p# = 500 / wh = h * p.ImageResample 500, h, 72, 72, TRUEEND WITHOBJECT
Patti
~~~~~~~~~ pranderson
Thanks Patti. Oddly enough everything seems to be working with cropping the image and changing the height and width but the resolution isn't changing to 72dpi. I'll keep playing with it and post if I figure out why. Otherwise, if anyone can come up with a Visual Basic script that crops out a white background and changes the height to 500px at 72dpi I would be grateful.
Not sure what you mean by crop out a white background. Are they vector shapes?
If so a macro could create a rectangle with a specified margin before converting to bitmap then process...
This works great in draw with all bitmaps on screen. It will convert all bitmaps to 500px and res 72.
Sub SetAllSelectionsToFiveHundredPx() Dim s As Shape Dim sr As ShapeRange Set sr = ActiveSelectionRange Dim w#, h# Dim calcW# ActiveDocument.Unit = cdrPixel If ActiveSelection.Shapes.Count > 0 Then For Each s In sr If s.Type = cdrBitmapShape Then s.GetSize w, h calcW = (500 * w) / h 's.SizeHeight = 500 's.SizeWidth = calcW s.Bitmap.Resample calcW, 500, True, 72, 72 End If Next s Else MsgBox "Well.. select something already." End IfEnd Sub
By cropping out a white background I mean going to Image->Crop->Crop Border Color (Normal mode with setting of 4)