I decided to put a batch process/vba combo together to simulate Microstation's original batch printing method, since I found "Print Organizer" to be sluggish when used with ProjectWise. Preliminary tests (using batch process lists) printed the sheets in half the time it took print organizer.Additionally, the batch process lists load much faster than the Print Organizer pset files.
Temporarily removing write access in PW allows printing without checking out the files.
Once placed in the proper directory, you can call it with the key-in “vba load ModuleName; vba run ModuleName.searchandprint”
Note: This version has been set up for a specific level, print driver and pen table.
If you want to modify it to use a different ProjectWise print driver and/or pen table, modify the following line with the correct local folder paths and names. (I'm not sure if "pw_workdir" is a standard variable or if it was created here.)
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
Hacked together, but wanted to share..
