zoukankan      html  css  js  c++  java
  • 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

  • 相关阅读:
    通过Navicat导入SQLServer的MDF文件和LDF文件
    ubantu系统出现登录界面死循环处理办法
    ubantu系统修改权限失败,导致只能客人会话登录解决办法
    redis基础
    ubantu安装MySQL,并未出现设置root密码的提示--》少年,请不要乱改密码!
    ngx_http_access_module模块说明
    一些常用的ngx_http_core_module介绍
    八、location匹配规则
    七、nginx的虚拟主机配置
    六、nginx的配置文件说明
  • 原文地址:https://www.cnblogs.com/kentyshang/p/510932.html
Copyright © 2011-2022 走看看