Macro to Export Layer to SVG

markeyd
over 3 years ago

I have prevously created a macro that selects a layer then exports it to a SVG file. How do I include in this macro the option to embed the font? The code is included below.

Const FileSystemObject = "Scripting.FileSystemObject"

Const CorelDraw = "CorelDraw.Application"
Const ExportPath = "\\rozwgismdpr0001\SURVEY-SPATIAL\Spatial\ArcGIS\Stylesheets\SVGfiles\"
Const SourcePath = "\\rozwgismdpr0001\SURVEY-SPATIAL\Spatial\Dave\SIGNAGE\SIGNAGE MANAGEMENT\Signage_2009\Script_Work_Area\"
Const CorelFileType = "CorelDRAW 2020 Graphic"
Const TechnicalLayer = "Technical"
Const IDLayer = "ID"
Dim Software
Dim fso
Dim SourceFolder
Dim FileName
Dim FName
Dim ActivePage
Dim Log
Dim Opt
Dim AspectRatio
Dim Height
Dim Width
Dim Page
Set fso = CreateObject(FileSystemObject)
Set Software = CreateObject(CorelDraw)
Set Opt = Software.CreateStructExportOptions
With fso
 Set Log = .OpenTextFile(TechnicalPath & "SVG_Export.txt", 2, True)
 Set SourceFolder = .GetFolder(SourcePath)
 With SourceFolder
  For Each File in .Files
   With File
    If .Type = CorelFileType Then
     Count = Count + 1
     FileName = .Path
    
      With fso
       FName = fso.GetBaseName(FileName)
      End With
     With Software.OpenDocument(FileName)
      .Activate
      .Unit = cdrMillimeter
      Set ActivePage = .Pages.First
       With ActivePage.Layers
        .Item(IDLayer).Printable = False
        .Item(IDLayer).Visible = False
        .Item(TechnicalLayer).Printable = False
        .Item(TechnicalLayer).Visible = False
        .Item("Details").Visible = True
        .Item("Details").Printable = True
       End With
      Set Shape = ActivePage.ActiveLayer.FindShape("Minimise Wash")
       If Not Shape Is Nothing Then
        Shape.CreateSelection
        Width = Shape.SizeWidth
        Height = Shape.SizeHeight
        AspectRatio = Width / Height
        Height = 600
        Width = AspectRatio * Height
       End If
      opt.SizeX = Width
      opt.SizeY = Height
      .Export ExportPath & "MinimiseWash.svg", 1345, 2, opt, Nothing
      Log.WriteLine Count & vbTab & ExportPath & "MinimiseWash.svg"

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.