Convertir graficos OpenOffice/LibrOffice a EPS

Después de hacer directamente los gráficos con gnuplot o herramientas similares, este macro se acaba de transformar en mi favorito.
Mis kudos vas para Jose Fonseca, por contribuir con este macro que exporta automáticamente todos los gráficos… Snifff…

PS: Cuando copie y pegue el script, una coma no se pego bien. Puede que les pase a Uds. tambien.


'**************************************************************************
'
' Copyright 2007 Jose Fonseca
' All Rights Reserved.
'
' Permission is hereby granted, free of charge, to any person obtaining a
' copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sub license, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL
' THE COPYRIGHT HOLDERS, AUTHORS AND/OR ITS SUPPLIERS BE LIABLE FOR ANY CLAIM,
' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
' USE OR OTHER DEALINGS IN THE SOFTWARE.
'
' The above copyright notice and this permission notice (including the
' next paragraph) shall be included in all copies or substantial portions
' of the Software.
'************************************************************************

' Export all charts from a Calc spreadsheet -- Jose Fonseca
Sub Main
Dim oDoc, oDocCtrl, oDocFrame, oDispatchHelper
oDoc = ThisComponent
oDocCtrl = oDoc.getCurrentController()
oDocFrame = oDocCtrl.getFrame()
oDispatchHelper = createUnoService( "com.sun.star.frame.DispatchHelper" )

Dim storeUrl
storeUrl = oDoc.getURL()
storeUrl = Left( storeUrl, Len( storeUrl ) - 4 )

nCharts = 0

' Search the draw page for the chart.
Dim oSheets, oSheet, oDrawPage, oShape
oSheets = oDoc.getSheets()
For i = 0 to oSheets.getCount() - 1
oSheet = oSheets.getByIndex( i )
oDrawPage = oSheet.getDrawPage()
For j = 0 to oDrawPage.getCount() - 1
oShape = oDrawPage.getByIndex( j )
' Can't call supportsService unless the com.sun.star.lang.XServiceInfo is present.
If HasUnoInterfaces( oShape, "com.sun.star.lang.XServiceInfo" ) Then
If oShape.supportsService( "com.sun.star.drawing.OLE2Shape" ) Then
' Is it a Chart?
If oShape.CLSID = "12DCAE26-281F-416F-a234-c3086127382e" Then
' Select the chart shape.
oDocCtrl.select( oShape )
oDispatchHelper.executeDispatch( oDocFrame, ".uno:Copy", "", 0, Array() )
' export the chart
nCharts = nCharts + 1
ExportSelection( storeUrl + "_chart" + nCharts + ".eps", "image/x-eps" )
EndIf
EndIf
EndIf
Next
Next
End Sub

Sub ExportSelection(url As String, mediaType As String)
' Create a new Draw document
Dim aArgs(1) As New com.sun.star.beans.PropertyValue
aArgs(0).Name = "Hidden"
aArgs(0).Value = True
oDrawDoc = StarDesktop.loadComponentFromURL( "private:factory/sdraw", "_blank", 0, aArgs() )

' Past current selection
Dim oDrawDocCtrl, oDrawDocFrame, oDispatchHelper
oDrawDocCtrl = oDrawDoc.getCurrentController()
oDrawDocFrame = oDrawDocCtrl.getFrame()
oDispatchHelper = createUnoService( "com.sun.star.frame.DispatchHelper" )
oDispatchHelper.executeDispatch( oDrawDocFrame, ".uno:Paste", "", 0, Array() )

' Get an export filter object
Dim exportFilter
exportFilter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )

' get first draw page
Dim oDrawPages, oDrawPage, oShape
oDrawPages = oDrawDoc.getDrawPages()
oDrawPage = oDrawPages.getByIndex( 0 )
oShape = oDrawPage.getByIndex( 0 )
exportFilter.setSourceDocument( oShape )

' Set the filter data
Dim aFilterData(5) As New com.sun.star.beans.PropertyValue
aFilterData(0).Name = "Level" '1=PS level 1, 2=PS level 2
aFilterData(0).Value = 2
aFilterData(1).Name = "ColorFormat" '1=color, 2=grayscale
aFilterData(1).Value = 1
aFilterData(2).Name = "TextMode" '0=glyph outlines, 1=no glyph outlines, see ooo bug 7918
aFilterData(2).Value = 1
aFilterData(3).Name = "Preview" '0=none, 1=TIFF, 2=EPSI, 3=TIFF+EPSI
aFilterData(3).Value = 0
aFilterData(4).Name = "CompressionMode" '1=LZW, 2=none
aFilterData(4).Value = 2

Dim aProps(2) As New com.sun.star.beans.PropertyValue
aProps(0).Name = "MediaType"
aProps(0).Value = mediaType
aProps(1).Name = "URL"
aProps(1).Value = url
aProps(2).Name = "FilterData"
aProps(2).Value = aFilterData()

exportFilter.filter( aProps() )
End Sub

Fuente: http://www.oooforum.org/forum/viewtopic.phtml?t=60155

 

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.