OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 21-11-2005, 14:00
xombie
Guest
 
Posts: n/a
Default draw 11 export collection to psd

Hi I wrote this for cd12 in vba. :
I wrote this in the hope to speed up the process of exporting a selection of shapes to individual psd files, however, upon testing i find that when exporting large shapes, it takes longer than if to do it by hand.
Exporting one shape @ 32.688 inches wide by 10.00 inches tall (black only)
to a PSD takes 3 or four times longer with the script than doing it by selecting the shape and exporting it in workspace using traditional method.
Any pointers as to where i went wrong, are welcomed.
btw i code by the skin of my teeth and am not entirley sure what i am doing.
thanx in advance.
sorry if its too long but i feel its all necessary,to troubleshoot.

Code:
Public Function BogusSelection() As Boolean
    If ActiveSelectionRange.Count < 1 Then
        MsgBox "Invalid selection!"
        BogusSelection = True
    Else
        BogusSelection = False
    End If
End Function
Function CheckSelection() As Boolean
Dim allpanels As Variant
Dim panel As Shape ' invokes a container for the panel to be exported
Set allpanels = ActiveSelectionRange ' makes all panels the selection
For Each panel In allpanels 'checks selectionrange for duplicates and no named items.
    panel.CreateSelection
    If panel.Name = "" Then
        CheckSelection = True
        Exit Function
        End If
    Next
End Function

Sub exportShapesToPSD()
If BogusSelection() Then Exit Sub
ActiveDocument.WorldScale = 1
ActiveDocument.Unit = cdrInch
Dim MSG As String, STYLE As Variant, TITLE As String
MSG = " Did you check for duplicate items?"
STYLE = vbYesNo + vbQuestion + vbDefaultButton2
TITLE = "Before we begin...."
Response = MsgBox(MSG, STYLE, TITLE)
If Response = vbNo Then Exit Sub
Dim panel As Shape
Dim originalSelection As ShapeRange
Dim allpanels As ShapeRange 'invokes a variable container fr the selection
'Dim ExptPanelName As String ' invokes a container for the panel's name from the object data manager
Dim exptpanelNameAndPath As String ' invokes a container for the panel's name from the object data manager and file path
'Dim panelbefore As String ' invokes a container for the name of a previously selected panel name
'Dim tf As Boolean 'invoke a true/false container
Dim CPW As Double ' invokes a container for the current panel  WIDTH
Dim CPH As Double ' invokes a container for the current panel HEIGHT
Dim ExpFlt As ExportFilter ' invokes a container for an export filter
Set allpanels = ActiveSelectionRange
Set originalSelection = ActiveSelectionRange
'Call CheckSelection    'checks to see if everything, selected, is valid
If CheckSelection() Then
    MsgBox "THIS ITEM HAS NO NAME!!!!" & vbCrLf & "Only the items that are named, in the Object Data Manager, can be exported" & vbCrLf & "Please check your selection & start again." & vbCrLf & "Alt W > Alt ALT D > ALT E", vbExclamation '& vbCrLf & "I will open the object data manager for you."
    Exit Sub
    End If
'Set allpanels = originalSelection ' names the selected items
'           assuming all the panels are valid......

For Each panel In originalSelection 'begins the loop for export
    With panel
    .CreateSelection
    CPW = ActiveShape.SizeWidth ' gets current panel's horizontal size
    CPH = ActiveShape.SizeHeight ' gets current panel's vertical size
    exptpanelNameAndPath = ActiveDocument.FilePath & panel.Name & ".psd" ' retreives the shapes name & filepath from the object data manager.
    MsgBox exptpanelNameAndPath & vbCrLf & CPH & " x " & CPW
        '                                            PSD
    Set ExpFlt = ActiveDocument.ExportBitmap(exptpanelNameAndPath, cdrPSD, cdrSelection, cdrRGBColorImage, (CPW * 300), (CPH * 300), 300, 300, cdrNormalAntiAliasing, False, False, True, False, cdrCompressionRLE_LW)
    ExpFlt.Finish
    End With
    Next
    MsgBox " F I N I S H E D "
End Sub
Reply With Quote
  #2  
Old 22-11-2005, 10:42
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

I will look at the code a bit later but in meantime, are you sure you export at the same size/resolution through VBA and UI? Because that's the main thing which can influence the speed considerably.

Another thing, in Draw 12, you don't have to specify the bitmap size in pixels if you specify DPI resolution, so you don't have to use Shape.SizeWidth/SizeHeight and multiply it by DPI. Just omit these values in ExportBitmap and specify the DPI values in DpiX and DpiY parameters. The correct width/height of bitmap will be calculated for you automatically.

Alex
Reply With Quote
  #3  
Old 22-11-2005, 10:49
xombie
Guest
 
Posts: n/a
Default Cool

i will try that one. thanx
btw.. yes i made sure that the resolution was the same

Last edited by xombie; 22-11-2005 at 10:53. Reason: omission
Reply With Quote
  #4  
Old 22-11-2005, 21:54
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Well, I tried to export to PSD manually and through a macro it the time it took to export a page size image at 600 dpi was pretty much the same (around 7 seconds on my machine). Here is the macro I used to time it:

Code:
Sub Macro1()
    Dim tm As Double
    Dim expflt As ExportFilter
    tm = Timer
    Set expflt = ActiveDocument.ExportBitmap("D:\Temp\Graphic1.psd", cdrPSD, cdrAllPages, _
                     cdrRGBColorImage, 5100, 6600, 300, 300, cdrNormalAntiAliasing, False, False, True, _
                     False, cdrCompressionNone)
    expflt.Finish
    MsgBox Timer - tm
End Sub
One thing that struck me in your code is the compression you specified for export. It appears that PSD filter has the compression types all confused. The value "0" (cdrCompressionNone) means RLE compression, while "1" (cdrCompressionLZW) is "no compression". Go figure. Since PSD can have either no compression or RLE, the type cdrCompressionRLE_LW (7) you specified really is not supported by the PSD filter. Probably that's what confuses it and causes all sorts of mess.

I use VBA Recorder to output proper parameters to make sure everything is Ok and that's the most reliable way of determining what each export filter expects.

Maybe this will help.

Last edited by Alex; 22-11-2005 at 21:56.
Reply With Quote
  #5  
Old 23-11-2005, 10:27
xombie
Guest
 
Posts: n/a
Default Odd.

Alex. Thankyou. cdrNoCompression which IS actually compression Is MUCH MUCH faster. The other odd thing I notice:
When exporting a bmp over 33 inches at 300 dpi With GUI method will require that the image is opened in some photo editor & resampled to its correct measurements. However, When Using the vba route, the bmp doesnt get "
squased." Fantastic! that in itself saves a ton of time.
I am not sure though, how to implement what you were saying about resolution dpix dpi y. How is that formatted into code.???
Please advise.
Thanx again
Andy
Reply With Quote
  #6  
Old 23-11-2005, 11:02
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Quote:
Originally Posted by xombie
I am not sure though, how to implement what you were saying about resolution dpix dpi y. How is that formatted into code.???
Please advise.
Take my code for example:

Code:
Sub Macro1()
    Dim tm As Double
    Dim expflt As ExportFilter
    tm = Timer
    Set expflt = ActiveDocument.ExportBitmap("D:\Temp\Graphic1.psd", cdrPSD, cdrAllPages, _
                     cdrRGBColorImage, 5100, 6600, 300, 300, cdrNormalAntiAliasing, False, False, True, _
                     False, cdrCompressionNone)
    expflt.Finish
    MsgBox Timer - tm
End Sub
You can see that the image is exported to be 5100 x 6600 pixels at 300 dpi. However if you remove 5100 and 6600 it will still export at 300 dpi but the final image dimension will be determined based on the size of the objects being exported:

Code:
Sub Macro1()
    Dim tm As Double
    Dim expflt As ExportFilter
    tm = Timer
    Set expflt = ActiveDocument.ExportBitmap("D:\Temp\Graphic1.psd", cdrPSD, cdrAllPages, _
                     cdrRGBColorImage, , , 300, 300, cdrNormalAntiAliasing, False, False, True, _
                     False, cdrCompressionNone)
    expflt.Finish
    MsgBox Timer - tm
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
CorelDraw 10 DXF export relative coordinates - VBA solution? asb617 CorelDRAW/Corel DESIGNER VBA 2 01-04-2010 02:34
Attributes in Corel Draw dueless CorelDRAW/Corel DESIGNER VBA 8 09-01-2008 06:56
Vector data from Paint to Draw 12? jimmr General 4 26-05-2005 06:24
Draw 12 VBA: Preliminary changes Alex CorelDRAW/Corel DESIGNER VBA 2 18-10-2003 06:16
Draw hogs access to ExportBitmap created files pbarton CorelDRAW/Corel DESIGNER VBA 1 10-07-2003 15:28


All times are GMT -5. The time now is 01:53.


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