Microstation生成PDF文件

将Microstation的draw 转化为PDF文件(kentyshang@gmail.com)
Public Function cbfGeneratePDF(ByVal strIn As String, ByVal strOut As String, ByVal strPDFDriver As String) As Boolean
On Error GoTo cbfGeneratePDF_Err
Dim msApp As MicroStationDGN.Application
Dim oDgn As MicroStationDGN.DesignFile
Dim oCadInputQueue As MicroStationDGN.CadInputQueue
Dim boolOpen As Boolean

Dim pfile As New clsFileOperate
Dim pSrvFile As Object
Dim var() As String, strPDFName As String

Set msApp = New Application

If Dir$(msApp.ActiveWorkspace.ConfigurationVariableValue("_USTN_SYSTEMROOT") & Trim(strPDFDriver)) = "" Then

     var = Split(strPDFDriver, "\")
     strPDFName = var(UBound(var))
    
     Set pSrvFile = New clsFileOperate
     If Not pfile.CopyFile(pOGlobalConst.prpcolGC.item("CMSConfigFilePath") & "\" & strPDFName, pOGlobalConst.item("CMSServerWorkLn") & "\" & pstrUsr_ID & "\" & strPDFName, True) Or _
                Not pSrvFile.CopyFile(pOGlobalConst.item("CMSServerWorkLn") & "\" & pstrUsr_ID & "\" & strPDFName, msApp.ActiveWorkspace.ConfigurationVariableValue("_USTN_SYSTEMROOT") & Trim(strPDFDriver), True) Then
            Err.Description = "Copy PDF Driver fail : '" & pOGlobalConst.prpcolGC.item("CMSConfigFilePath") & "\" & strPDFName & "' to '" & msApp.ActiveWorkspace.ConfigurationVariableValue("_USTN_SYSTEMROOT") & Trim(strPDFDriver) & "'"
            GoTo cbfGeneratePDF_Err
     End If
    
End If
   
   
    If msApp Is Nothing Then Set msApp = New Application
     With msApp
'        .LeftPosition = 1000
'        .Width = 1000
'        .Height = 1000
'        .Visible = False
    End With
   
    Set oDgn = msApp.OpenDesignFile(Trim(strIn))
    boolOpen = True
    Set oCadInputQueue = msApp.CadInputQueue
   
    With oCadInputQueue
        'Open print dialog  打开print对话框
        .SendCommand "DIALOG PLOT"
        'Set Area="Fit All" and select View 1 让Current Draw在当前窗口最大化
        .SendCommand "PRINT BOUNDARY FIT ALL 1"
        'select pdf file print driver           '设定print driver
        .SendCommand "PRINT DRIVER " & msApp.ActiveWorkspace.ConfigurationVariableValue("_USTN_SYSTEMROOT") & Trim(strPDFDriver)
        'export pdf file           '将current Draw中的图转化为pdf
        .SendCommand "PRINT EXECUTE " & Trim(strOut)
        'close the print dialog   '关闭print对话框
        .SendCommand "PRINT EXIT PLOTDLG"
        .SendCommand "MDL UNLOAD PLOTDLG"
    End With
    cbfGeneratePDF = True
       
cbfGeneratePDF_Cleanup:
'    msApp.Quit
    If Not pSrvFile Is Nothing Then Set pSrvFile = Nothing
    If Not pfile Is Nothing Then Set pfile = Nothing
    If Not msApp Is Nothing Then Set msApp = Nothing
    If boolOpen Then oDgn.Close
    Set msApp = New Application
    If msApp Is Nothing Then Set msApp = New Application
    Set oDgn = msApp.OpenDesignFile(Trim(pstrDGNPath))
    Exit Function

cbfGeneratePDF_Err:
    cbfGeneratePDF = False
    App.LogEvent "Err GeneratePDF : " & CStr(Err.Number) & Err.Source & " : clsUtility-cbfGeneratePDF : " & Err.Description
    Resume cbfGeneratePDF_Cleanup
End Function

原文地址:https://www.cnblogs.com/kentyshang/p/510932.html