1
1

PStoCurve.bas 2.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374
  1. Option Explicit
  2. Sub PStoCurve()
  3. If ActiveShape Is Nothing Then MsgBox "Nothing selected", vbExclamation, "PStoCurve": Exit Sub
  4. Dim OrigSelection As ShapeRange
  5. Dim impflt As ImportFilter
  6. Dim impopt As StructImportOptions
  7. Set OrigSelection = ActiveSelectionRange
  8. Dim expflt As ExportFilter
  9. Dim expopt As StructExportOptions
  10. Set expopt = New StructExportOptions
  11. Dim ptt As String
  12. expopt.UseColorProfile = False
  13. ptt = Environ$("TEMP") & "\PStoCurve.ai"
  14. '''''''''''''''''''''' Corel X4
  15. ' If CorelDRAW.VersionMajor = 14 Then
  16. Set expflt = ActiveDocument.ExportEx(ptt, cdrAI, cdrSelection, expopt)
  17. With expflt
  18. .Version = 6 ' FilterAILib.aiVersion6
  19. .TextAsCurves = True
  20. ' .Platform = 0 ' FilterAILib.aiPC
  21. .ConvertSpotColors = False
  22. .UseColorProfile = False
  23. .SimulateOutlines = False
  24. .SimulateFills = False
  25. .IncludePlacedImages = False
  26. .IncludePreview = False
  27. .Finish
  28. End With
  29. Set impopt = New StructImportOptions
  30. impopt.MaintainLayers = False
  31. Set impflt = ActiveLayer.ImportEx(ptt, cdrAI, impopt)
  32. impflt.Finish
  33. ' End If
  34. '''''''''''''''''''''''''''''''''Corel X5
  35. ' If CorelDRAW.VersionMajor = 15 Then
  36. '' ptt = Environ$("appdata") & "\Corel\CorelDRAW Graphics Suite X5\Draw\GMS\PStoCurve.ai"
  37. ' Set expflt = ActiveDocument.ExportEx(ptt, cdrAI, cdrSelection, expopt)
  38. ' With expflt
  39. ' .Version = 2 ' FilterAILib.aiVersionCS2
  40. ' .TextAsCurves = True
  41. ' .PreserveTransparency = True
  42. ' .ConvertSpotColors = False
  43. ' .SimulateOutlines = False
  44. ' .SimulateFills = False
  45. ' .IncludePlacedImages = False
  46. ' .IncludePreview = False
  47. ' .EmbedColorProfile = False
  48. ' .Finish
  49. ' End With
  50. '
  51. ' Set impopt = CreateStructImportOptions
  52. '
  53. ' With impopt
  54. ' .MaintainLayers = False
  55. ' With .ColorConversionOptions
  56. ' .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
  57. ' .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%"
  58. ' End With
  59. ' End With
  60. ' Set impflt = ActiveLayer.ImportEx(ptt, 1283, impopt)
  61. ' impflt.Finish
  62. '
  63. ' End If
  64. '''''''''''''''''''''''''''''''''''''''''''
  65. OrigSelection.Delete
  66. CorelScriptTools.Kill ptt
  67. End Sub