This example shows how to set alternate drawing support files.
'------------------------------------------------------------- ' Preconditions: ' 1. Create a VBA macro in a software product in which VBA is ' embedded. ' 2. Copy and paste this example into the Visual Basic IDE. ' 3. Add a reference to the DraftSight type library, ' install_dir\bin\dsAutomation.dll. ' 4. Start DraftSight. ' 5. Press F5 ' ' Postconditions: ' 1. Connects to DraftSight. ' 2. Gets active document. ' 3. Gets instance of drawing support files. ' 4. Displays message boxes informing you that these alternate ' font files were set: ' a. Big font file. Click OK. ' b. Shape font file. Click OK. ' c. SHX font file. Click OK. ' d. Drawing template file. Click OK. ' 5. Click Tools > Options > File Locations and expand Drawing Support. ' a. Expand and examine Alternate Font File > SHX font, Big font, ' and Shape file. ' b. Expand and examine Drawing Template File Location. ' 6. Exit DraftSight. '---------------------------------------------------------------- Option Explicit
Sub main()
Dim dsApp As DraftSight.Application Dim dsDoc As DraftSight.Document
'Connect to DraftSight Set dsApp = GetObject(, "DraftSight.Application")
'Abort any command currently running in DraftSight 'to avoid nested commands dsApp.AbortRunningCommand
'Get active document Set dsDoc = dsApp.GetActiveDocument()
'Get drawing support files Dim dsDrawingSupportFiles As DraftSight.DrawingSupportFiles Set dsDrawingSupportFiles = dsApp.GetDrawingSupportFiles
Dim dsSysFile As DraftSight.SystemFiles Set dsSysFile = dsApp.GetSystemFiles Dim FontsPathObj As Variant FontsPathObj = dsSysFile.FontsPaths Dim fontPath As String If Not IsArray(FontsPathObj) Then MsgBox "No system files." Exit Sub Else fontPath = CStr(FontsPathObj(0)) End If
'Set alternate big font file Dim fontFileName As String fontFileName = fontPath & "ARGothE.ttf" dsDrawingSupportFiles.AlternateBigFontFile = fontFileName MsgBox "Alternate big font file: " & dsDrawingSupportFiles.AlternateBigFontFile
'Set alternate shape font file Dim shapeFileName As String shapeFileName = fontPath & "FC-Iso.shx" dsDrawingSupportFiles.AlternateShapeFile = shapeFileName MsgBox "Alternate shape font file: " & dsDrawingSupportFiles.AlternateShapeFile
'Set alternate SHX font file Dim shxFontFileName As String shxFontFileName = fontPath & "FC-Iso.shx" dsDrawingSupportFiles.AlternateShxFontFile = shxFontFileName MsgBox "Alternate SHX font file: " & dsDrawingSupportFiles.AlternateShxFontFile
'Set alternate drawing template file Dim templateFilePath As String templateFilePath = dsApp.GetSystemFiles.GetUserDataPath Dim drawingTemplateFilePath As String drawingTemplateFilePath = templateFilePath + "Template\standarddin.dwt" dsDrawingSupportFiles.DrawingTemplateFilesPath = drawingTemplateFilePath MsgBox "Alternate drawing template file: " & dsDrawingSupportFiles.DrawingTemplateFilesPath
End Sub