将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
本文转自kenty博客园博客，原文链接http://www.cnblogs.com/kentyshang/archive/2006/09/21/510932.html如需转载请自行联系原作者
kenty
