corelvba/base/PStoCurve.bas

Option Explicit

Sub PStoCurve()
If ActiveShape Is Nothing Then MsgBox "Nothing selected", vbExclamation, "PStoCurve": Exit Sub
    Dim OrigSelection As ShapeRange
     Dim impflt As ImportFilter
    Dim impopt As StructImportOptions
    Set OrigSelection = ActiveSelectionRange
    Dim expflt As ExportFilter
    Dim expopt As StructExportOptions
    Set expopt = New StructExportOptions
    Dim ptt As String
    expopt.UseColorProfile = False
    ptt = Environ$("TEMP") & "\PStoCurve.ai"
 '''''''''''''''''''''' Corel X4
'    If CorelDRAW.VersionMajor = 14 Then
       
       Set expflt = ActiveDocument.ExportEx(ptt, cdrAI, cdrSelection, expopt)
        With expflt
                .Version = 6 ' FilterAILib.aiVersion6
                .TextAsCurves = True
'                .Platform = 0 ' FilterAILib.aiPC
                .ConvertSpotColors = False
                .UseColorProfile = False
                .SimulateOutlines = False
                .SimulateFills = False
                .IncludePlacedImages = False
                .IncludePreview = False
                .Finish
         End With
   
    Set impopt = New StructImportOptions
    impopt.MaintainLayers = False
    Set impflt = ActiveLayer.ImportEx(ptt, cdrAI, impopt)
    impflt.Finish
         
'    End If
 '''''''''''''''''''''''''''''''''Corel X5
'    If CorelDRAW.VersionMajor = 15 Then
''       ptt = Environ$("appdata") & "\Corel\CorelDRAW Graphics Suite X5\Draw\GMS\PStoCurve.ai"
'       Set expflt = ActiveDocument.ExportEx(ptt, cdrAI, cdrSelection, expopt)
'    With expflt
'        .Version = 2 ' FilterAILib.aiVersionCS2
'        .TextAsCurves = True
'        .PreserveTransparency = True
'        .ConvertSpotColors = False
'        .SimulateOutlines = False
'        .SimulateFills = False
'        .IncludePlacedImages = False
'        .IncludePreview = False
'        .EmbedColorProfile = False
'        .Finish
'    End With
'
'    Set impopt = CreateStructImportOptions
'
'    With impopt
'        .MaintainLayers = False
'        With .ColorConversionOptions
'            .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
'            .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
'        End With
'    End With
'    Set impflt = ActiveLayer.ImportEx(ptt, 1283, impopt)
'    impflt.Finish
'
'    End If
  '''''''''''''''''''''''''''''''''''''''''''
    
    OrigSelection.Delete
    CorelScriptTools.Kill ptt
    
End Sub