模拟原始批量打印
我决定将批处理/vba组合放在一起以模拟Microstation#039；的原始批量打印方法，因为我发现；“打印管理器”；与ProjectWise一起使用时动作迟缓。初步测试（使用批处理列表）只需打印组织者花费一半的时间即可打印出纸张。此外，批处理列表的加载速度比打印管理器pset文件快得多临时删除PW中的写访问权限可以在不签出文件的情况下进行打印
一旦放置在正确的目录中，您可以使用“vba load ModuleName；vba运行模块名。searchandprint注意：此版本是为特定级别、打印驱动程序和笔表设置的
如果要将其修改为使用不同的ProjectWise打印驱动程序和/或笔表，请使用正确的本地文件夹路径和名称修改以下行。（我不确定“pw\u workdir”是标准变量还是在此处创建的。）CadInputQueue.SendKeyin "$ print driver $(pw_workdir)\dms08053\pdf - gs.pltcfg; print pentable attach $(pw_workdir)\dms08052\pen_txdot.tbl"
Sub SearchAndPrint()
Dim Counter As Integer
Dim oEle As Element
Dim oLevel As Level
Dim LevelName As String
Dim oAtt As Attachment
Dim ee As ElementEnumerator
Dim esc As ElementScanCriteria
Dim oShape As ShapeElement
Dim oAttach As Attachment
Dim LNoAttach As Attachment 'Live Nested
Dim oView As View
Dim oFence As Fence
Dim fso As Object
Dim DatedFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists("C:\Temp\") Then
fso.CreateFolder ("C:\Temp\") 'Create Parent Directory if it doesn't exist
End If
DatedFolder = "C:\Temp\" & Format(Now, "yyyy") & Format(Now, "mm") & Format(Now, "dd")
If Not fso.FolderExists(DatedFolder) Then
fso.CreateFolder (DatedFolder) 'Create dated Folder if it doesn't exist
End If
Set oView = ActiveDesignFile.Views(1) 'Works ONLY with View 1
Counter = 0 'Counter used to avoid overwriting files if multiple sheets are found
Set esc = New ElementScanCriteria
esc.ExcludeAllTypes
esc.IncludeType msdElementTypeShape 'Only scans shapes
If ActiveModelReference.Attachments.Count = 0 Then 'Scans active drawing levels if no reference file is detected
Set ee = ActiveModelReference.Scan(esc)
Do While ee.MoveNext
Set oEle = ee.Current
If Not oEle.Level Is Nothing Then
LevelName = oEle.Level.Name
If LevelName = "D_BATCH_PLOT" Then
Set oShape = oEle 'Pick Shape for fence if it resides on correct level
Set oFence = ActiveDesignFile.Fence
If oFence.IsDefined Then oFence.Undefine
oFence.DefineFromElement oView, oShape
Counter = Counter + 1
PrintPDF'Print to pdf using predetermined settings in public function
End If
End If
Loop
End If
For Each oAttach In ActiveModelReference.Attachments 'Scans Each Attachment in the active file
If oAttach.Attachments.Count > 0 And oShape Is Nothing Then 'Checks for live nesting and proceeds if no shape is found
For Each LNoAttach In oAttach.Attachments 'If nested attachments are found, they are also scanned
Set ee = LNoAttach.Scan(esc)
Do While ee.MoveNext And oShape Is Nothing 'Scanning Continues until shape is found
Set oEle = ee.Current
If Not oEle.Level Is Nothing Then
LevelName = oEle.Level.Name
If LevelName = "D_BATCH_PLOT" Then
Set oShape = oEle 'Pick Shape for fence if it resides on correct level
Set oFence = ActiveDesignFile.Fence
If oFence.IsDefined Then oFence.Undefine
oFence.DefineFromElement oView, oShape
Counter = Counter + 1
PrintPDF 'Print to pdf using predetermined settings in public function
End If
End If
Loop
Next
Else
Set ee = oAttach.Scan(esc) 'If no live nesting is detected, scan direct reference levels
Do While ee.MoveNext And oShape Is Nothing 'Until shape is found
Set oEle = ee.Current
If Not oEle.Level Is Nothing Then
LevelName = oEle.Level.Name
If LevelName = "D_BATCH_PLOT" Then
Set oShape = oEle 'Pick Shape for fence if it resides on correct level
Set oFence = ActiveDesignFile.Fence
If oFence.IsDefined Then oFence.Undefine
oFence.DefineFromElement oView, oShape
Counter = Counter + 1
PrintPDF 'Print to pdf using predetermined settings in public function
End If
End If
Loop
End If
Set oShape = Nothing 'Sets Shape to nothing in case addtional border reference files are attached
Next
Call OpenFolder(DatedFolder) 'Opens or brings focus to dated folder
End Sub
' ---------------------------------------------------------------------
' PrintPDF
' Print using the pdf-gs.pltcfg
' Print using defined fence, view 1, pen_txdot.tbl
' Create a PDF document in a dated folder in c:\temp\
' ---------------------------------------------------------------------
Public Sub PrintPDF()
' Load the PLOTDLG application
CadInputQueue.SendKeyin "mdl load plotdlg"
Dim Path As String
Path = GetDgnFileName(ActiveModelReference)
Path = Replace(Path, ".dgn", "")
' Set the PDF print driver and pen table
CadInputQueue.SendKeyin "$ print driver $(pw_workdir)\dms08053\pdf - gs.pltcfg; print pentable attach $(pw_workdir)\dms08052\pen_txdot.tbl"
' Print with Active Fence
Dim oFence As Fence
Set oFence = ActiveDesignFile.Fence
If oFence.IsDefined Then
CadInputQueue.SendKeyin "print boundary fence"
Else
Const ViewNum As Integer = 1
CadInputQueue.SendKeyin "print boundary view " & CStr(ViewNum)
End If
'Const PaperSize As String = "11x17" '<--This is currently the only page size, so it has been commented out
'CadInputQueue.SendKeyin "print papername " & PaperSize
CadInputQueue.SendKeyin "print colormode color"
CadInputQueue.SendKeyin "print maximize"
' Execute the print.The PDF is sent to the dated folder in c:\temp
Path = "C:\Temp\" & Format(Now, "yyyy") & Format(Now, "mm") & Format(Now, "dd") & "\" & Path & "(" & Counter & ").pdf"
CadInputQueue.SendKeyin "print execute " & Path
End Sub
Public Function GetDgnFileName(ByVal modelRef As ModelReference) As String
GetDgnFileName = vbNullString
On Error GoTo err_GetDgnFileName
GetDgnFileName = modelRef.DesignFile.Name
Exit Function
err_GetDgnFileName:
MsgBox "Error no. " & CStr(Err.Number) & ": " & Err.Description & vbNewLine & _
"Caused by " & Err.Source, vbOKOnly Or vbExclamation, "Get DGN File Name Error"
End Function
Private Sub OpenFolder(strDirectory As String)
'DESCRIPTION: Open folder if not already open. Otherwise, activate the already opened window
'DEVELOPER: Ryan Wells (wellsr.com)
'INPUT: Pass the procedure a string representing the directory you want to open
Dim pID As Variant
Dim sh As Variant
On Error GoTo 102:
Set sh = CreateObject("shell.application")
For Each w In sh.Windows
If w.Name = "Windows Explorer" Or w.Name = "File Explorer" Then
If w.document.folder.self.Path = strDirectory Then
'if already open, bring it front
w.Visible = False
w.Visible = True
Exit Sub
End If
End If
Next
'if you get here, the folder isn't open so open it
pID = Shell("explorer.exe " & strDirectory, vbNormalFocus)
102:
End Sub
一起被黑客攻击，但想分享。。
页:
[1]