Private Sub GlobalMacroStorage_DocumentAfterExport(ByVal Doc As Document, _
ByVal FileName As String, ByVal Filter As cdrFilter, ByVal SaveBitmap As Boolean)
If Filter = cdrEPS Then Doc.unDo 1
End Sub
Private Sub GlobalMacroStorage_DocumentBeforeExport(ByVal Doc As Document, _
ByVal FileName As String, ByVal Filter As cdrFilter, ByVal SaveBitmap As Boolean)
Dim sr As New ShapeRange
If Filter = cdrEPS Then
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
boostStart "Convert Text to Curves"
SelectTxt2Curve2 sr
boostFinish endUndoGroup:=True
sr.CreateSelection
End If
Set sr = Nothing
End Sub
Private Sub SelectTxt2Curve2(r As ShapeRange)
Dim s As Shape
On Error Resume Next
For Each s In r
If s.Type = cdrGroupShape Then SelectTxt2Curve2 s.Shapes.All Else _
If s.Type = cdrTextShape Then s.ConvertToCurves
If Not s.PowerClip Is Nothing Then SelectTxt2Curve2 s.PowerClip.Shapes.All
Next s
End Sub
Private Sub boostStart(Optional ByVal unDo$ = "")
On Error Resume Next
If unDo <> "" Then ActiveDocument.BeginCommandGroup unDo
Optimization = True
EventsEnabled = False
ActiveDocument.SaveSettings
ActiveDocument.PreserveSelection = False
End Sub
Private Sub boostFinish(Optional ByVal endUndoGroup% = False)
On Error Resume Next
ActiveDocument.PreserveSelection = True
ActiveDocument.RestoreSettings
EventsEnabled = True
Optimization = False
Application.CorelScript.RedrawScreen
If endUndoGroup Then ActiveDocument.EndCommandGroup
End Sub