Just to get it somewhere, here is the complete code I'm making.
It's quite big tho. Wall of text incoming:
Imports System.Text
Imports System.IO
Imports Autodesk.DataManagement.Client.Framework.Vault
Imports Autodesk.Connectivity.WebServices
Imports VDF = Autodesk.DataManagement.Client.Framework
Imports ACW = Autodesk.Connectivity.WebServices
Imports AWS = Autodesk.Connectivity.WebServices
Imports VB = Connectivity.Application.VaultBase
Imports Autodesk.DataManagement.Client.Framework.Vault.Currency'.Properties
AddReference "Autodesk.DataManagement.Client.Framework.Vault.dll"
AddReference "Autodesk.DataManagement.Client.Framework.dll"
AddReference "Connectivity.Application.VaultBase.dll"
AddReference "Autodesk.Connectivity.WebServices.dll"
'AddReference "Autodesk.DataManagement.Client.Framework.
'AddReference "Autodesk.DataManagement.Client.Framework.Forms.dll "
Sub Main()
'''This tool was made by Machiel Veldkamp in 2018 and devoloped throughout 2019
''' This tool works only on drawings that are in The Vault
''' This tool works only if you have a connection to the "R:\" network Disk
''' This tool only works when the BOM is enabled.
''' All code should be commented. Email mveldkamp@relco.net For questions you might have
''' The VersionChecker is not required for the tool. It's just a sort of updater.
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the ASSEMBLY file.", "iLogic")
Exit Sub
End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ VERSION CHECKER - - - START\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
VersionFolder = "R:\Drafting\09 iLOGIC VERSIONS" 'Make Folder Somewhere with Textfiles
iLogicName = "IAM Bulk Drawing Tool" 'Name of the Current
Dim ExpectedVersion As Integer = 22
oFile = VersionFolder & "\" & iLogicName & ".txt"
'read the file
oRead = System.IO.File.OpenText(oFile)
Dim FileVersion As Integer = oRead.ReadToEnd()
oRead.Close()
If FileVersion = ExpectedVersion Then
Trace.WriteLine(FileVersion & " Version is correct.")
Else
MessageBox.Show("Expected Version: " & FileVersion & vbNewLine & " Current Version on your PC: " & ExpectedVersion, "OLD VERSION. DO GET FROM VAULT")
Exit Sub
End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ VERSION CHECKER - - - END \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim vaultaddin As ApplicationAddIn
vaultaddin = ThisApplication.ApplicationAddIns.ItemById("{48B682BC-42E6-4953-84C5-3D253B52E77B}")
Dim oSizePrinted As String 'FALSE IS ORIGINALS | TRUE IS A3
Dim oStopPrinting As Boolean 'TRUE IS NO PRINTING | FALSE IS PRINTING
Dim oStopExport As Boolean 'TRUE IS NO EXPORT | FALSE IS EXPORT
Dim oPrintLibrary As Boolean 'TRUE IS PRINT LIBRARY FILES| FALSE IS IGNORE LIBRARY AT ALL
Dim ErrorMessage As String 'CREATE STRING WHERE ERROR MESSAGES CAN BE STORED
ErrorMessage = "" 'STARTS OUT EMPTY
Dim xProduce As Integer 'Production amount
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ CUSTOM GUI \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim ILOGIC_PRINT As Boolean 'true = print, false = ignore print
Dim ILOGIC_EXPORT As Boolean 'true = export, false = ignore export
Dim ILOGIC_PROD_AMOUNT As Integer 'Production amount. Can only be whole numbers
Dim ILOGIC_LIBRARY As Boolean 'true = also process LIBRARIES, false = ignore LIBRARIES
Dim ILOGIC_SORT As Boolean 'true = sort by A-Z, False = sort by BOM (per assembly)
Dim ILOGIC_PRINT_PREF As String 'Can contain: "A4" or "A3" or "ORIGINALS"
Dim ILOGIC_WATERMARK As Boolean 'true = place watermark
Dim ILOGIC_PROD_NO As String 'reserved for PROD#. Can be numbers and letters.
Dim oModel As PartDocument
Try
ThisApplication.SilentOperation = False
System.Threading.Thread.CurrentThread.Sleep(300)
vaultaddin.Deactivate
aFilePath = "C:\Relco\Vault\CAD Standards\Inventor\Design Data 2018\iLogic\BulkDrawingToolParam.ipt"
oModel = ThisApplication.Documents.Open(aFilePath, False)
auto = iLogicVb.Automation
auto.RunRule(oModel, "Show Form") 'in the model there is a rule called "Show Form" that changes some parameters
ILOGIC_PRINT = oModel.ComponentDefinition.Parameters("ILOGIC_PRINT").Value
ILOGIC_EXPORT = oModel.ComponentDefinition.Parameters("ILOGIC_EXPORT").Value
ILOGIC_PROD_AMOUNT = oModel.ComponentDefinition.Parameters("ILOGIC_PROD_AMOUNT").Value
ILOGIC_LIBRARY = oModel.ComponentDefinition.Parameters("ILOGIC_LIBRARY").Value
ILOGIC_SORT = oModel.ComponentDefinition.Parameters("ILOGIC_SORT").Value
ILOGIC_PRINT_PREF = oModel.ComponentDefinition.Parameters("ILOGIC_PRINT_PREF").Value
ILOGIC_WATERMARK = oModel.ComponentDefinition.Parameters("ILOGIC_WATERMARK").Value
ILOGIC_PROD_NO = oModel.ComponentDefinition.Parameters("ILOGIC_PROD_NO").Value
xProduce = ILOGIC_PROD_AMOUNT
oPrintLibrary = ILOGIC_LIBRARY
If ILOGIC_PRINT = True
oStopPrinting = False
Else
oStopPrinting = True
End If
If ILOGIC_EXPORT = True
oStopExport = False
Else
oStopExport = True
End If
oSizePrinted = ILOGIC_PRINT_PREF
SortQuestion = ILOGIC_SORT
GoTo GUI_Succes
ThisApplication.SilentOperation = False
oModel.Close 'CLOSE MODEL
vaultaddin.Activate
Trace.WriteLine("Close GUI model")
Catch
Try
oModel.Close 'CLOSE MODEL
Catch
End Try
Try
System.Threading.Thread.CurrentThread.Sleep(300)
vaultaddin.Activate
Catch
End Try
MessageBox.Show("ERROR IN BulkDrawingToolParam.ipt MAYBE YOU CLICKED THE X INSTEAD OF 'DONE' HOWEVER. IT KINDA CRASHED", "IAM Bulk Drawing Tool")
ThisApplication.SilentOperation = False
Trace.WriteLine("GUI FAILED")
GoTo GUI_Failed
End Try
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ CUSTOM GUI - END \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
GUI_Failed :
Trace.WriteLine("GUI FAILED - Continue")
Dim oOptionList As New ArrayList
oOptionList.Add("- PRINT ONLY")
oOptionList.Add("- EXPORT ONLY")
oOptionList.Add("- EXPORT + PRINT")
oPrintExport = InputListBox("Prompt", oOptionList, oOptionList, Title := "Bulk Drawing Tool", ListName := "IAM Bulk Drawing Tool")
Try
xProduce = InputBox("ENTER A NUMBER", "How many times do you want to make this thing?", "1")
Catch
MessageBox.Show("You have to use just numbers. Comma's aren't allowed. Integers only :)" & vbNewLine & "Amount set to 1", "BULK DWG TOOL")
xProduce = 1
End Try
If oPrintExport Is "- PRINT ONLY"
oStopPrinting = False
oStopExport = True
oSizePrinted = "A3" 'Due to conversion from the old to the new system for GUI, now the old method only handles A3
SortQuestion = InputRadioBox("Sort to A-Z for printing?", "YES, Sort A-Z", "No, Leave as packets", SortQuestion, Title := "BULK DWG TOOL")
Else If oPrintExport Is "- EXPORT ONLY"
oStopPrinting = True
oStopExport = False
Else
oStopExport = False
oStopPrinting = False
oSizePrinted = "A3" 'Due to conversion from the old to the new system for GUI, now the old method only handles A3
SortQuestion = InputRadioBox("Sort to A-Z for printing?", "YES, Sort A-Z", "No, Leave as packets", SortQuestion, Title := "BULK DWG TOOL")
End If
oPrintLibrary = InputRadioBox("Do you want to print Library and/ or Design Data Eu files? (manholes/ flanges/ etc)", "YES", "NO", oPrintLibrary, Title := "BULK DWG TOOL")
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Continue from above\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
GUI_Succes :
Trace.WriteLine("GUI SUCCES - CONTINUED")
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ GET PROJECT AND JOBNUMBER\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim oModelName As String = ThisDoc.Document.FullFileName
If ThisApplication.UserName = "MVE"
If oModelName.Contains("Libraries") Then
MessageBox.Show("This is a library part. Be sure to be logged in as Admin to export or print drawings. ", "BULK DWG TOOL")
End If
Else
If oModelName.Contains("Libraries") Then
MessageBox.Show("Document is a library part. This is a forbidden action. ", "BULK DWG TOOL")
System.Threading.Thread.CurrentThread.Sleep(300)
vaultaddin.Activate
ThisApplication.SilentOperation = False
Exit Sub
End If
End If
Dim oComp As String = IO.Path.GetDirectoryName(oModelName)
Dim oModelDir As String
Dim oProjectNumber As String
Dim oJobNumber As String
'Detect Job and project number. If the drawing is located in a project folder this will be auto generated.
If oComp.Contains("PROJECTS") Then
'Get folder name of folder in "PROJECTS"
Dim mysplit As Array = Split(oComp, "\")
Dim i As Integer = (mysplit.Length - 1)
Dim ii As Integer = i - 7 '7 = naam van map in PROJECTS folder
Dim Split1 As String() = oComp.Split("\")
oModelDir = Split1(Split1.Length - ii)
oProjectNumber = Left(oModelDir, 6) 'MAKE oProjectNumber
Dim mysplit2 As Array = Split(oComp, "\")
Dim i2 As Integer = (mysplit.Length - 1)
Dim ii2 As Integer = i2 - 8 '8 = naam van map in PROJECTS folder map
Dim Split2 As String() = oComp.Split("\")
oModelDir = Split2(Split2.Length - ii2)
oJobNumber = Right(Left(oModelDir, 11), 5) 'MAKE oJobNumber
If ILOGIC_PROD_NO = ""
QComment = "P-" & oProjectNumber & " J-" & oJobNumber & " PROD#______" 'QComment is the thing that is part of the Watermark on drawing.
Else
QComment = "P-" & oProjectNumber & " J-" & oJobNumber & " PROD#" & ILOGIC_PROD_NO 'QComment is the thing that is part of the Watermark on drawing.
End If
Else
'Main assembly not located in "PROJECTS" folder. Manual input needed.
QComment = InputBox("Non-project file detected. Please enter the WATERMARK COMMENT", "Bulk Drawing Tool", "P-19PXXX J-XXXXX PROD#000000 ")
If QComment = " "
QComment = ""
End If
End If
If ThisApplication.UserName = "MVE"
Tools = InputBox("ASSY/DEBUG?", "BULK DRAWING TOOL", "Type: " & ControlChars.Quote & "ASSY" & ControlChars.Quote & " to do just the top level drawing")
End If
'get user input
RUsure = MessageBox.Show("READ THIS MESSAGE!! EVERY TIME!!!" & vbNewLine _
& vbNewLine _
& "PRINT = " & Chr(9) & ILOGIC_PRINT & vbNewLine _
& "EXPORT = " & Chr(9) & ILOGIC_EXPORT & vbNewLine _
& "________________" & vbNewLine _
& vbNewLine _
& "PRINT ON " & Chr(9) & ILOGIC_PRINT_PREF & vbNewLine _
& "________________" & vbNewLine _
& vbNewLine _
& "PROJECT: " & Chr(9) & oProjectNumber & vbNewLine _
& "JOB: " & Chr(9) & oJobNumber & vbNewLine _
& "PROD #: " & Chr(9) & ILOGIC_PROD_NO & vbNewLine _
& vbNewLine _
, "BULK DRAWING TOOL", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If RUsure = vbNo Then
ThisApplication.SilentOperation = False
Try
System.Threading.Thread.CurrentThread.Sleep(300)
vaultaddin.Activate
Catch
'Vault is already enabled
End Try
Exit Sub 'User wants to quit the Rule.
End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ MAKE BOM\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ '
Trace.WriteLine("MAKE BOM")
Dim oTotalDict As New Dictionary(Of String, Integer)
Dim oLOD As LevelOfDetailRepresentation
Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
oAsmDoc.ComponentDefinition.RepresentationsManager.LevelOfDetailRepresentations("Master").Activate
Dim oAssyDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
Trace.WriteLine("MAKE BOM2")
'Dim oBOM As BOM = oAssyDef.BOM
Trace.WriteLine("MAKE BOM3")
oBOM = oAssyDef.BOM
Trace.WriteLine("MAKE BOM4")
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False
Dim oBOMView As BOMView = oBOM.BOMViews.Item("Structured")
Dim oBOMRow As BOMRow
Dim oCompDef As ComponentDefinition
Trace.WriteLine("**************MAKE BOM ****************")
For Each oBOMRow In oBOMView.BOMRows
oCompDef = oBOMRow.ComponentDefinitions.Item(1)
'oParentPartNumber = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Trace.WriteLine("PARRENT: " & oParentPartNumber)
Call SetRowProps(oCompDef, oBOMRow.TotalQuantity, oTotalDict, 1) ' Set the oTotalDict Key and Value for this object
If Not oBOMRow.ChildRows Is Nothing
Call RecurseBOMRow(oBOMRow, oTotalDict, oBOMRow.TotalQuantity)
End If
Next
Trace.WriteLine("****************SHOW BOM***********")
Dim oCount As Integer = 0
'Dim i As Integer
For i = 0 To oTotalDict.Count - 1
Key = oTotalDict.Keys(i)
oCount = oTotalDict.Values(i)
' Trace.WriteLine(Key & " : " & oCount) ' Before xProduce
Number = oTotalDict.Values(i)
oCount = Number * xProduce
oTotalDict(Key) = oCount
oCount = oTotalDict.Values(i)
Trace.WriteLine(Key & " : " & oCount) ' After xProduce
Next
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ SORT DICTIONARY \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'' If SortQuestion = True
Trace.WriteLine("******************************************NEW DICTIONARY*START*********************************************")
Dim OriginalKey As String
Dim OriginalQTY As String
Dim OriginalKeyLength As Integer
Dim SplitLocation As Integer
Dim SearchFor As String = "\"
Dim FirstKey As String
Dim SecondKey As String
Dim SortArray As New ArrayList
For i = 0 To oTotalDict.Count - 1
OriginalKey = oTotalDict.Keys(i)
OriginalQTY = oTotalDict.Values(i)
OriginalKeyLength = OriginalKey.Count
SplitLocation = InStrRev(OriginalKey, SearchFor)
FirstKey = Left(OriginalKey, SplitLocation)
SecondKey = Right(OriginalKey, OriginalKeyLength - SplitLocation)
SortArray.Add(SecondKey & "*" & FirstKey & "*" & OriginalQTY)
Trace.WriteLine("FirstKey: " & FirstKey)
Trace.WriteLine("SecondKey: " & SecondKey)
Next
SortArray.Sort 'This sorts the reversed, stickied, string A-Z.
oTotalDict.Clear 'delete all entries in oTotalDict and repopulate
Dim oTotalDictKey As String
Dim oTotalDictValue As Integer
Trace.WriteLine("SORTER 94")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 2)
If Firstdigit = "94"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
Trace.WriteLine("SORTER 92")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 2)
If Firstdigit = "92"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
Trace.WriteLine("SORTER 4")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 1)
If Firstdigit = "4"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
Trace.WriteLine("SORTER 2")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 1)
If Firstdigit = "2"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
Trace.WriteLine("SORTER 1")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 1)
If Firstdigit = "1"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
Trace.WriteLine("SORTER THE REST")
For i = 0 To SortArray.Count - 1
Firstdigit = Left(SortArray(i), 1)
'Trace.WriteLine(Firstdigit)
If Not Firstdigit = "1" And Not Firstdigit = "2" And Not Firstdigit = "4" And Not Firstdigit = "9"
'Trace.WriteLine(SortArray(i))
Dim mysplit As Array = Split(SortArray(i), "*")
oTotalDictKey = mysplit(1) & mysplit(0)
'Trace.WriteLine(oTotalDictKey)
oTotalDictValue = mysplit(2)
'Trace.WriteLine(oTotalDictValue)
oTotalDict.Add(oTotalDictKey, oTotalDictValue)
End If
Next
''End If
Trace.WriteLine("******************************************NEW DICTIONARY*END*********************************************")
' For i = 0 To oTotalDict.Count - 1
' Key = oTotalDict.Keys(i)
' oCount = oTotalDict.Values(i)
' Trace.WriteLine(Key & " : " & oCount)
' Next
Trace.WriteLine("******************************************VAULT STATUS ITERATE**********************************************")
Dim mVltCon As VDF.Vault.Currency.Connections.Connection
mVltCon = VB.ConnectionManager.Instance.Connection
If mVltCon Is Nothing Then
MessageBox.Show("Not Logged In to Vault! - Login first and repeat executing this rule. (POTENTIONAL ADD-IN FAULURE)")
Exit Sub
End If
Dim oStatusDict As New Dictionary(Of String, Integer)
'''Lifecycle States
'''Preliminary = LifecyclestateID: 24; = oStatusDict: 1
'''For Approval = LifecyclestateID: ; = oStatusDict: 2
'''Approved For Construction = LifecyclestateID: 31; = oStatusDict: 3
'''Obsolete = LifecyclestateID: ; = oStatusDict: 4
'''NotInVault = = oStatusDict:
'''NotOnC = = oStatusDict:
'''NoDrawingExists = = oStatusDict:
Dim CheckedOutFiles As Integer = 0
Dim MissingFiles As Integer = 0
For i = 0 To oTotalDict.Count - 1
'oCount = oTotalDict.Values(i)
Key = oTotalDict.Keys(i)
dwgPath = Left(key, Len(Key) - 3) & "dwg"
VaultPartPath = Key.Replace("C:\Relco\Vault\", "$/")
VaultPartPath = VaultPartPath.Replace("\", "/")
VaultDWGPath = dwgPath.Replace("C:\Relco\Vault\", "$/")
VaultDWGPath = VaultDWGPath.Replace("\", "/")
Dim VaultDWGPaths() As String = New String() {VaultDWGPath }
Dim VaultPartPaths() As String = New String() {VaultPartPath }
Dim wsFiels() As AWS.File = mVltCon.WebServiceManager.DocumentService.FindLatestFilesByPaths(VaultDWGPaths)
Dim wsFiels2() As AWS.File = mVltCon.WebServiceManager.DocumentService.FindLatestFilesByPaths(VaultPartPaths)
'Ts file exists in the Vault.
Dim DwgFileIt As VDF.Vault.Currency.Entities.FileIteration = New VDF.Vault.Currency.Entities.FileIteration(mVltCon, wsFiels(0)) 'DWG HERE
Dim PartFileIt As VDF.Vault.Currency.Entities.FileIteration = New VDF.Vault.Currency.Entities.FileIteration(mVltCon, wsFiels2(0)) 'PART HERE (IPT/IAM)
Dim lifeCycleInfo As VDF.Vault.Currency.Entities.FileLifecycleInfo = DwgFileIt.LifecycleInfo
Dim DWGIsCheckedOut As Boolean = DwgFileIt.IsCheckedOut
Dim PartIsCheckedOut As Boolean = PartFileIt.IsCheckedOut
If DWGIsCheckedOut = True
Trace.WriteLine("CHECKED OUT: " & dwgPath)
CheckedOutFiles = CheckedOutFiles + 1
Else If PartIsCheckedOut = True
Trace.WriteLine("CHECKED OUT: " & Key)
CheckedOutFiles = CheckedOutFiles + 1
End If
If Not lifeCycleInfo.StateId = - 1 'IN VAULT
'Trace.WriteLine("File not in C?: " & dwgPath)
If System.IO.File.Exists(dwgPath)
Trace.WriteLine("YES IN VAULT, YES ON C: " & dwgPath & " Status: " & lifeCycleInfo.StateName)' & " ID:" & lifeCycleInfo.StateId)
Dim fname As String = dwgPath
Dim file1 As Autodesk.Connectivity.WebServices.File()
file1 = mVltCon.WebServiceManager.DocumentService.FindLatestFilesByPaths({fname})
If file1.Length <> 0 Then
Trace.WriteLine("Start test")
Dim oFileIteration As VDF.Vault.Currency.Entities.FileIteration = Nothing
Trace.WriteLine("FilleIteration 1")
oFileIteration = New VDF.Vault.Currency.Entities.FileIteration(mVltCon, file1(0))
'oFileIteration = GetFileIteration(fname, mVltCon)
Trace.WriteLine("FilleIteration 1.5")
Trace.WriteLine("FilleIteration 2")
'DownloadFiles(oFileIteration)
GetSelectedFiles(file1(0),mVltCon,"C:\TEMP")
End If
End If
If Not System.IO.File.Exists(dwgPath)
Trace.WriteLine("YES IN VAULT, NOT ON C: " & dwgPath & " Status: " & lifeCycleInfo.StateName)' & " ID:" & lifeCycleInfo.StateId)
MissingFiles = MissingFiles + 1
End If
End If
If lifeCycleInfo.StateId = - 1 'FILE NOT IN VAULT.
'Trace.WriteLine("File not in Vault?: " & dwgPath)
If System.IO.File.Exists(dwgPath)
Trace.WriteLine("ON C, NOT IN VAULT: " & dwgPath & " Status: " & lifeCycleInfo.StateName)' & " ID:" & lifeCycleInfo.StateId)
End If
If Not System.IO.File.Exists(dwgPath)
'Trace.WriteLine("NOT ON C, NOT IN VAULT: " & dwgPath & " Status: " & lifeCycleInfo.StateName)' & " ID:" & lifeCycleInfo.StateId)
End If
End If
Next
If MissingFiles > 0
LastChance = MessageBox.Show("You are missing " & MissingFiles & " drawings from Vault. Do you want to CONTINUE?", "BULK DWG TOOL", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If LastChance = vbNo
vaultaddin.Activate
Exit Sub
End If
End If
If CheckedOutFiles > 0
LastChance = MessageBox.Show("You have " & CheckedOutFiles & " files checked out... Do you want to CONTINUE?", "BULK DWG TOOL", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If LastChance = vbNo
vaultaddin.Activate
Exit Sub
End If
End If
Try
Trace.WriteLine("VAULT DEACTIVATED")
vaultaddin.Deactivate 'Disable the VAULT ADD-IN so Vault status and things won't interfere.
Catch
Try
System.Threading.Thread.CurrentThread.Sleep(500)
Trace.WriteLine("VAULT DEACTIVATED")
vaultaddin.Deactivate
Catch
MessageBox.Show("Couldn't deactivate Vault Add-in Try again later.", "Title")
'Exit Sub
End Try
End Try
'////////////////////////////////// TOP LEVEL DRAWING ////////////////////////////////////
Trace.WriteLine("****************Doing top level Drawing (the main assembly)******************")
ThisApplication.SilentOperation = True 'Disable all Inventor Pup-Ups
iLogicVb.Automation.RulesOnEventsEnabled = False 'Disable all iLogic rules
Dim oFilePath As String
'MakeIndex(ThisDoc , oFilePath)
oAsmDrawing = ThisDoc.ChangeExtension(".dwg") 'Takes the Assembly.iam and turns it into Assembly.dwg
Try
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True) 'Opens Assembly.dwg
Catch
MessageBox.Show("There is no Assembly drawing. Rule quit", "Title")
iLogicVb.RunRule("X - Reset Vault Addin")
Exit Sub
End Try
Revision = GetRevision(oAsmDrawingDoc)
oFilePath = oFindFolder(oModelName, QComment, Revision) 'FINDS THE EXPORT DESTINATION
Trace.WriteLine("oFilepath:" & oFilePath)
QuantityText = "| QTY = " & xProduce & "x"
Trace.WriteLine("ASSY: Open DWG")
oAsmDrawingName = Left(oAsmDrawingDoc.FullDocumentName, Len(oAsmDrawingDoc.FullDocumentName) - 3)
If ILOGIC_WATERMARK = True
Trace.WriteLine("ASSY: Watermark")
WaterMark(oAsmDrawingDoc, QuantityText, QComment)
Trace.WriteLine("WATERMARK - COMPLETED")
End If
Trace.WriteLine("ASSY: Export")
Export_PDF_DWG(oAsmDrawingDoc, oStopExport, oFilePath, Revision)
Trace.WriteLine("Doing DrawingList starting thing now:")
DrawingList(oAsmDrawingDoc, xProduce, QComment, False, oFilePath, oStopPrinting, oStopExport, Revision) 'Starts making the DrawingList. Boolean Here is status for the Sub.
Trace.WriteLine("ASSY: Print")
Print(oAsmDrawingDoc, oSizePrinted, oStopPrinting)
Trace.WriteLine("ASSY: Close")
oAsmDrawingDoc.Close(True)
'////////////////////////////END TOP DRAWING ////////////////////////////////////////
If Tools = "ASSY"
vaultaddin.Activate
Exit Sub
End If
Trace.WriteLine("Completed Assembly Drawing. Now openening and processing the underlying drawings.")
'////////////////////////////////////////LOOP DRAWINGS/ UPDATE / EXPORT ////////////////////////////////////////
Dim oDrawDoc As DrawingDocument
For i = 0 To oTotalDict.Count - 1
Key = oTotalDict.Keys(i)
dwgPathName = Left(key, Len(Key) - 3) & "dwg" 'Make a path and replace the last 3 symbols to dwg. (2-123456.iam to 2-123456.dwg)
If (System.IO.File.Exists(dwgPathName)) Then 'Look for DWG files of the models in the BOM
oDrawDoc = ThisApplication.Documents.Open(dwgPathName, True) 'Open the dwg.
Trace.WriteLine("DrawingList: " & Key)
Revision = GetRevision(oDrawDoc) 'Get revision from Function GetRevision()
DrawingList(oDrawDoc, oTotalDict.Values(i), QComment, True, oFilePath, oStopPrinting, oStopExport, Revision) 'MAKE DRAWINLIST ROW.
Trace.WriteLine("i=" & i & " \\ Remaining: " & oTotalDict.Count)
If oDrawDoc.FullFileName.Contains("Libraries") Then 'SKIP Library file
If oPrintLibrary = True 'If Printing is allowed continue.
If Tools = "DEBUG" Then
'skip for speed
Else
Export_PDF_DWG(oDrawDoc, oStopExport, oFilePath, Revision)
Print(oDrawDoc, oSizePrinted, oStopPrinting) 'Print the Library file
End If
End If
oDrawDoc.Close(True) 'Close the LIB file
oTotalDict.Remove(Key)' Remove object from oTotalDict.
i = i - 1
Else If Not oDrawDoc.FullFileName.Contains("Libraries") Then 'Normal file:
Try 'Try loop. Safer way to do it.
QuantityText = "| QTY = " & oTotalDict(Key) & "x" 'Make text for comment on drawing
If ILOGIC_WATERMARK = True
WaterMark(oDrawDoc, QuantityText, QComment) 'Place Watermark on drawing
End If
If Tools = "DEBUG" Then
'skip for speed
Else
Export_PDF_DWG(oDrawDoc, oStopExport, oFilePath, Revision) 'Export Drawing
Print(oDrawDoc, oSizePrinted, oStopPrinting) 'Print Drawing
End If
Catch
ErrorMessage = ErrorMessage & "| " & Key & vbNewLine 'Make error message if failed.
End Try
oDrawDoc.Close(True)
oTotalDict.Remove(Key)' Remove object from oTotalDict.
i = i - 1
End If
Else
'If the model has no drawing of the same path and name - do nothing
'MessageBox.Show("This model has no drawing!" & oRefDoc.FullDocumentName, "Title"
End If
If i = oTotalDict.Count - 1
Trace.WriteLine("********************LAST LEG*************************")
Exit For
End If
Next
Trace.WriteLine("*********************************just finnished the loop")
'//////////////////////////// END OF TOTALDICTLOOP //////////////////////
DrawingList(oAsmDrawingDoc, "END_OF_DRAWINGS", QComment, False, oFilePath, oStopPrinting, oStopExport, "") 'At this stage. The rule will print the TXT and then Delete the Temp file
For i = 0 To oTotalDict.Count - 1
Key = oTotalDict.Keys(i)
oCount = oTotalDict.Values(i)
If Key.Contains("PROJECTS") Then
DrawingList(oAsmDrawingDoc, "MISSING_DRAWINGS", Key, False, oFilePath, oStopPrinting, oStopExport, "") 'At this stage. The rule will print the TXT and then Delete the Temp file
End If
Trace.WriteLine(Key & " : " & oCount)
Next
If ErrorMessage = ""
'No errors. Nice
Else
ErrorMessage = "The following drawings may nog have been printed/exported correctly: " & vbNewLine & "| " & Key & vbNewLine
MessageBox.Show(ErrorMessage, "BULK DWG TOOL")
End If
Trace.WriteLine("NOTE: LAST ACTION")
DrawingList(oAsmDrawingDoc, "STOP", QComment, False, oFilePath, oStopPrinting, oStopExport, "") 'At this stage. The rule will print the TXT and then Delete the Temp file
'//////////////////////////////////////// Windows Voice ////////////////////////////////////////
Dim objSPVoice, colVoices
objSPVoice = CreateObject("SAPI.SpVoice")
objSPVoice.Speak("attention: rule finished")
'- - - - - - - - - - Windows Voice - - END - - - - - - - -
If oStopExport = False
OpenFolder = MessageBox.Show("Would you open the folder? Files saved in: " & oFilePath, "BULK DWG TOOL", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
If OpenFolder = vbYes Then
Dim Proc As String = "Explorer.exe"
Dim Args As String = ControlChars.Quote & oFilePath & ControlChars.Quote
Process.Start(Proc, Args)
End If
Else
MessageBox.Show("FILES PRINTED. CHECK PRINTER/PLOTTER", "Title")
End If
System.Threading.Thread.CurrentThread.Sleep(500)
vaultaddin.Activate
ThisApplication.SilentOperation = False 'Disable all Inventor Pup-Ups
iLogicVb.Automation.RulesOnEventsEnabled = True
End Sub 'END OF MAIN()
Sub WaterMark(oDrawDoc As DrawingDocument, QuantityText As String, QComment As String)
'Trace.WriteLine("WATERMARK - BEGIN")
Dim oTG As TransientGeometry
oTG = ThisApplication.TransientGeometry
oDrafstman = ThisApplication.UserName
Dim oSheet As Sheet
Dim s As Sheet
oSheet = oDrawDoc.ActiveSheet
Dim oGeneralNote As GeneralNote
Dim oGeneralNotes As GeneralNotes
Dim oColor As Color
oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
sFormattedText = "<StyleOverride FontSize='0,32' Bold='True'>" + " prnt by: " & oDrafstman & "| |" & QComment & QuantityText + "</StyleOverride>"
'Trace.WriteLine("WATERMARK - START LOOP")
For Each s In oDrawDoc.Sheets 'BROWSE ALL SHEETS
If s.Size = "9993" Or s.Size = "9994" Or s.Size = "9995" Then 'For A1, A0, A2
s.Activate 'ACTIVATE CURRENT SHEET
For Each oSymbol As SketchedSymbol In s.SketchedSymbols
If oSymbol.Name = "(EU) DRAWING STATE" Then 'FIND DRAWING STATE BLOCK
Dim oPoint As Point2d = oSymbol.Position 'DECLARE POINT2D
oPoint.X = s.Width - 9 'NEW X COORD
oPoint.Y = 9 'NEW Y COORD
oSymbol.Position = oPoint 'UPDATE SYMBOL WITH NEW POSITION
End If
Next
Else 'for A4, A3, A2
s.Activate 'ACTIVATE SHEET
For Each oSymbol As SketchedSymbol In s.SketchedSymbols
If oSymbol.Name = "(EU) DRAWING STATE" Then 'FIND SYMBOL
Dim oPoint As Point2d = oSymbol.Position 'DECLARE NEW POINT
oPoint.X = s.Width - 9 'NEW X COORD
oPoint.Y = 7.3 'NEW Y COORD
oSymbol.Position = oPoint 'UPDATE POSITION WITH NEW POINT
End If
Next
End If
Next
'Trace.WriteLine("WATERMARK - LOOP 2")
For Each s In oDrawDoc.Sheets
s.Activate
oGennotes = s.DrawingNotes.GeneralNotes
If s.Size = "9993" 'A0
If s.Orientation = "10242"
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(102, 10.2), sFormattedText) 'LANDSCAPE
Else
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(68, 10.2), sFormattedText) 'PORTRAIT
End If
End If
If s.Size = "9994" 'A1
If s.Orientation = "10242"
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(67.5, 10.2), sFormattedText) 'LANDSCAPE
Else
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(42.5, 10.2), sFormattedText) 'PORTRAIT
End If
End If
If s.Size = "9995" 'A2
If s.Orientation = "10242"
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(50 - 6 - 0.8, 8.2), sFormattedText) 'LANDSCAPE
Else
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(30 - 3 - 0.8, 8.2), sFormattedText) 'PORTRAIT
End If
End If
If s.Size = "9996" 'A3
If s.Orientation = "10242"
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(30 - 3 - 0.8, 8.2), sFormattedText) 'LANDSCAPE
Else
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(20 - 5 - 0.8, 8.2), sFormattedText) 'PORTRAIT
End If
End If
If s.Size = "9997" 'A4
If s.Orientation = "10242"
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(20 - 5 - 0.8, 8.2), sFormattedText) 'LANDSCAPE
Else
oGeneralNote = oGenNotes.AddFitted(oTG.CreatePoint2d(15 - 9 - 0.8, 8.2), sFormattedText) 'PORTRAIT
End If
End If
oGeneralNote.Color = oColor
Next
'Trace.WriteLine("WATERMARK - END")
End Sub 'END OF WATERMARK()
Sub RecurseBOMRow(oBOMRow As BOMRow, oTotalDict As Dictionary(Of String, Integer), newParentQTY As Integer)
Trace.WriteLine("START of RecurseBOMRor for: " & oBOMRow.ComponentDefinitions.Item(1).Document.FullDocumentName & "QTY = " & oBOMRow.TotalQuantity & " Parent = " & newParentQTY)
ParentQTY = oBOMRow.TotalQuantity ' Set a new ParentQTY amount. When first encountered newParentQTY is 1
For Each oBOMRow In oBOMRow.ChildRows
Dim oCompDef As ComponentDefinition
oCompDef = oBOMRow.ComponentDefinitions.Item(1)
oParent = oBOMRow.Parent
'oParentPartNumber = oParent.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Trace.WriteLine("PARRENT: " & oParentPartNumber)
Call SetRowProps(oCompDef, oBOMRow.TotalQuantity, oTotalDict, newParentQTY) ' Set the oTotalDict Key and Value for this object with the newParent QTY(should be 1 at first run.)
If Not oBOMRow.ChildRows Is Nothing ' Ooooh. Assembly.
ParentQTY = oBOMRow.TotalQuantity 'Now we;re looking in the row of the assembly in the assembly. The current value is just the value in that parent. We still need multiplication
oParent = oBOMRow.Parent
'oParentPartNumber = oParent.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Trace.WriteLine("PARRENT: " & oParentPartNumber)
newnewParentQty = ParentQTY * newParentQTY 'We're a couple of layers in now. We still hold newParentQTY from the current Parent. Parent QTY is th current value and newnewParent is the multiplication of those 2
Trace.WriteLine("DIGGIN DEEPER --: " & oBOMRow.ComponentDefinitions.Item(1).Document.FullDocumentName & " QTY = " & oBOMRow.TotalQuantity & " Parent = " & ParentQTY & " newParent = " & newParentQTY & " newnewParent = " & newnewParentQty)
Call RecurseBOMRow(oBOMRow, oTotalDict, newnewParentQty)
End If
Next
End Sub
Sub SetRowProps(oCompDef As ComponentDefinition, QTY As Integer, oTotalDict As Dictionary(Of String, Integer), ParentQTY As Integer)
Trace.WriteLine("START SetRowProps for " & oCompDef.Document.FullDocumentName & " QTY is: " & QTY & " Parent = " & ParentQTY)
Dim CompFullDocumentName As String = oCompDef.Document.FullDocumentName
Dim CompFileNameOnly As String
Dim index As Integer = CompFullDocumentName.LastIndexOf("\")
CompFileNameOnly = CompFullDocumentName.Substring(index + 1)
If oTotalDict.ContainsKey(CompFullDocumentName) = True Then
KeyValue = oTotalDict(CompFullDocumentName)
Trace.WriteLine("EXISTING KEY. CURRENT QTY = " & KeyValue)
QTY = QTY * ParentQTY
Trace.WriteLine("ADDING: " & QTY)
oTotalDict(CompFullDocumentName) = QTY + KeyValue
Trace.WriteLine("NEW QTY = " & oTotalDict(CompFullDocumentName))
Else
oTotalDict(CompFullDocumentName) = QTY * ParentQTY
Trace.WriteLine("NEW KEY. QTY = " & oTotalDict(CompFullDocumentName))
End If
End Sub
Sub Export_PDF_DWG(oDrawDoc As DrawingDocument, oStopExport As Boolean, oFilePath As String, Revision As String)
If oStopExport = True
Exit Sub
End If
Trace.WriteLine(oFilePath)
oFileName = oDrawDoc.DisplayName 'without extension
oDuctName = oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("description").Value
Dim oCleanString As String = System.Text.RegularExpressions.Regex.Replace(oDuctName, "[^A-Za-z0-9_ .-]", "_") 'REPLACE FORBIDDEN CHARS BY "_" --> ([A-Za-z0-9_ -] ARE NOT (^) FORBIDDEN.
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") 'LOAD PDF ADD-IN
Dim oDWGAddIn As TranslatorAddIn
oDWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}") 'LOAD DWG ADD-IN
oDrafstman = ThisApplication.UserName
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMediumPDF = ThisApplication.TransientObjects.CreateDataMedium
oDataMediumDWG = ThisApplication.TransientObjects.CreateDataMedium'.FileName(False) 'without extension
' - - - - - - - - - - - - - - - - - PDF Setup - - - - - - - - - - - - - - - - - -
oOptions.Value("All_Color_AS_Black") = 0 '0 = color // 1 = black
oOptions.Value("Remove_Line_Weights") = 0 'boolean
oOptions.Value("Vector_Resolution") = 700
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'- - - - - - - - - - - - - - - - - -DWG SETUP - - - - - - - - - - - - - - - - - -
If oDWGAddIn.HasSaveCopyAsOptions(oDrawDoc, oContext, oOptions) Then 'Check whether the translator has 'SaveCopyAs' options
Dim strIniFile As String
strIniFile = "C:\Relco\Vault\CAD Standards\Inventor\Design Data 2018\iLogic\DWG_MODEL_2018.ini" 'INI FILE IS VOOR MODELSPACE
oOptions.Value("Export_Acad_IniFile") = strIniFile 'Create the name-value that specifies the ini file to use.
End If
' - - - - - - - - - - - get target folder path- - - - - - - - - - - - -
If Not System.IO.Directory.Exists(oFilePath) Then
System.IO.Directory.CreateDirectory(oFilePath)
End If
' - - - - - - - - - - - - Set the destination file name - - - - - - - - - - - -
Dim fileName As String
fileName = oDrawDoc.DisplayName & " - " & oCleanString & " - REV " & Revision
oDataMediumDWG.FileName = oFilePath & "\" & fileName & ".dwg"
oDataMediumPDF.FileName = oFilePath & "\" & fileName & ".pdf"
' Trace.WriteLine(fileName & "|| " & Len(fileName))
' Trace.WriteLine(oFilePath & "|| " & Len(oFilePath))
CountString = Len(fileName) + Len(oFilePath) + 1
If CountString > 255
MessageBox.Show("WARNING: CANNOT SAVE FILE> FILENAME TOO LONG", "Title")
Exit Sub
End If
' - - - - - - - - - - - - - Create PDF + DWG - - - - - - - - - - - - - - -
Trace.WriteLine("Make PDF now:")
oPDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMediumPDF)
Trace.WriteLine("Make DWG now:")
oDWGAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMediumDWG)
End Sub 'END OF EXPORT()
Sub Print(oDrawDoc, oSizePrinted, oStopPrinting)
If oStopPrinting = True
Exit Sub
End If
Dim Printer = "RICOH MP-C3004 - beneden"
If ThisApplication.UserName = "JBE" Or ThisApplication.UserName = "JVV"
Printer = "Ricoh MP-C3004 Boven"
End If
Dim Plotter = "HP DesignJet T930 PS HPGL2"
Dim oPrintMgr As PrintManager
oPrintMgr = oDrawDoc.PrintManager
oPrintMgr.ColorMode = 13314
If oSizePrinted = "A4" 'A3 ALWAYS AND EVER
For Each s In oDrawDoc.Sheets 'checks each sheet
s.Activate 'Activate Sheet
oPrintMgr.Printer = Printer
oPrintMgr.PaperSize = "14341"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
Next
Else If oSizePrinted = "A3"
For Each s In oDrawDoc.Sheets 'checks each sheet
s.Activate 'Activate Sheet
oPrintMgr.Printer = Printer
oPrintMgr.PaperSize = "14340"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
Next
Else If oSizePrinted = "ORIGINALS"
For Each s In oDrawDoc.Sheets 'checks each sheet
s.Activate 'Activate Sheet
If s.Size = "9993" 'A0
oPrintMgr.Printer = Plotter
oPrintMgr.PaperSize = "14357"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
End If
If s.Size = "9994" 'A1
oPrintMgr.Printer = Plotter
oPrintMgr.PaperSize = "14359"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
End If
If s.Size = "9995" 'A2
oPrintMgr.Printer = Plotter
oPrintMgr.PaperSize = "14339"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
End If
If s.Size = "9996" 'A3
oPrintMgr.Printer = Printer
oPrintMgr.PaperSize = "14340"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
End If
If s.Size = "9997" 'A4
oPrintMgr.Printer = Printer
oPrintMgr.PaperSize = "14341"
oPrintMgr.ScaleMode = 13826 'kPrintBestFitScale = best scale fit
oPrintMgr.PrintRange = 14081 'kPrintCurrentSheet = current sheet
If s.Orientation = "10242"
oPrintMgr.Orientation = 13570 'LANDSCAPE
Else
oPrintMgr.Orientation = 13569 'PORTRAIT
End If
oPrintMgr.SubmitPrint
End If
Next
End If
End Sub 'END OF PRINT()
Function oFindFolder(oDrawDoc, QComment, Revision)', oFilePath)
''' THIS CODE IS ALTERED SO IT MAY WRITE ALL DRAWINGS TO "R:\Drafting\10 TEKENINGEN\"
''' Previously the location was "R:\Orders\20" & ProjYear & "\Projecten\" & ProjectChooser & "\Tekeningen Engineering\2D Tekeningen"
Dim oComp As String = IO.Path.GetDirectoryName(oDrawDoc)
Dim oModelDir As String
'Check if subfolder "PROJECTS" exists in file path
Dim oAssyName As String
If oComp.Contains("PROJECTS") Then
'Get folder name of folder in "PROJECTS"
Dim mysplit As Array = Split(oComp, "\")
Dim i As Integer = (mysplit.Length - 1)
Dim ii As Integer = i - 7 '7=naam van map in PROJECTS folder 4=naam van company in CUSTOMER WORK folder
Dim Split1 As String() = oComp.Split("\")
oModelDir = Split1(Split1.Length - ii)
Location = "PROJECTS"
Else If oComp.Contains("DESIGN DATA EU") Then
Location = "DESIGN DATA EU"
Dim mysplit As Array = Split(oComp, "\")
Dim i As Integer = (mysplit.Length - 1)
Dim ii As Integer = i - 3 '7=naam van map in PROJECTS folder 4=naam van company in CUSTOMER WORK folder
Dim Split1 As String() = oComp.Split("\")
oModelDir = Split1(Split1.Length - ii)
Else
oModelDir = "CUSTOM"
Location = "CUSTOM"
End If
oDuctName = iProperties.Value("Project", "Description")'oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("description").Value
Dim oCleanString As String = System.Text.RegularExpressions.Regex.Replace(oDuctName, "[^A-Za-z0-9_ .-]", "_") 'Vervang verboden tekens in bestandsnaam door "_" --> ([A-Za-z0-9_ -] zijn NIET (^) verboden.
'Add Projects below
'-----------------------------------------------------------------------------------------------------------------------------------------------
Select Case oModelDir
'Case "Vault Folder Name"
'ProjectChooser = "Folder name on G:\ or R:\"
Case "CUSTOM"
ProjectChooser = "CUSTOM"
Case "DESIGN DATA EU"
ProjectChooser = "DESIGN DATA EU"
Case "LIBRARIES"
ProjectChooser = "LIBRARY"
'''************** COPY THESE TWO LINES TO ADD A NEW PROJECT ****************
Case "" '''Vault FolderName
ProjectChooser = "19PX00 NAME" '''"Name on R:/"
'''************** COPY THESE TWO LINES TO ADD A NEW PROJECT ****************
Case Else 'if no other project is found. It gets the status "Projectless"
ProjectChooser = "Projectless"
End Select
Try 'Get FolderName for current file
FolderNameLoc = Mid(ThisDoc.Path, InStrRev(ThisDoc.Path, "\"))
Catch
MessageBox.Show("error determining the folder location", "Error in BULK DWG TOOL", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Exit Function
End Try
Try
ProjYear = Left(ProjectChooser, 2) ' Read the ProjectYear (valid from 2000 - 2099)
Catch
MessageBox.Show("ERR: 2368*%& Wrong Project. Ask Machiel Veldkamp to fix the Code. Email a screenshot to mveldkamp@relco.net with this error", "ERROR #2018 BULK DWG TOOL")
End Try
If ProjectChooser = "DESIGN DATA EU"
oFindFolder = "R:\Drafting\00 DESIGN DATA EU" & FolderNameLoc & "\" & QComment & oCleanString & " " & ThisDoc.FileName & "-REV " & Revision ' & " - " & Now.ToString("yyyy/MM/dd")
Else If ProjectChooser = "LIBRARY"
oFindFolder = "R:\Drafting\00 DESIGN DATA EU" & ProjectChooser & "\" & FolderNameLoc & "\" & QComment & oCleanString & " " & ThisDoc.FileName & "-REV " & Revision ' & " - " & Now.ToString("yyyy/MM/dd")
Else If ProjectChooser = "Projectless"
MessageBox.Show("This is not the right thing. This tool is meant for Project files and possibly DATA DESIGN Files. Either you are doing something weird or the project isn't added yet. In any case: Notify Machiel Veldkamp. ", "Title")
Else
'oFindFolder = "\\datasrv\Data\RELCO_BV\Orders\20" & ProjYear & "\Projecten\" & ProjectChooser & "\Tekeningen Engineering\2D Tekeningen" & FolderNameLoc & "\" & QComment & " " & ThisDoc.FileName & "-REV " & Revision & " " & oCleanString & " - " & Now.ToString("yyyy/MM/dd")
'oFindFolder = "R:\Orders\20" & ProjYear & "\Projecten\" & ProjectChooser & "\Tekeningen Engineering\2D Tekeningen" & FolderNameLoc & "\" & QComment & " " & ThisDoc.FileName & "-REV " & Revision & " " & oCleanString & " - " & Now.ToString("yyyy/MM/dd")
oFindFolder = "R:\Drafting\10 TEKENINGEN\" & ProjectChooser & FolderNameLoc & "\" & QComment & " " & ThisDoc.FileName & "-REV " & Revision & " " & oCleanString & " - " & Now.ToString("yyyy/MM/dd")
End If
End Function 'END OF oFINDFOLDER()
Function GetRevision(oDrawDoc As DrawingDocument)
'Trace.WriteLine("GetRevision called.")
Try
oDrawDoc.Sheets.Item(1).Activate
Catch
'No fish :(
End Try
Try
' Set a reference to the first revision table on the active sheet.
' This assumes that a revision table is on the active sheet.
Dim oRevTable As RevisionTable
oRevTable = oDrawDoc.ActiveSheet.RevisionTables.Item(1)
GetRevision = oRevTable.RevisionTableRows.Item(oRevTable.RevisionTableRows.Count).Item(1).Text
'Trace.WriteLine("Revision is: " & GetRevision)
Catch
'No revision block
GetRevision = 99
Trace.WriteLine("GetRevision failed. No rev block?.")
'MessageBox.Show("Revision failed", "Title")
End Try
End Function
Sub DrawingList(oDrawDoc As DrawingDocument, QTY As String, QComment As String, oBool As Boolean, oFilePath As String, oStopPrinting As Boolean, oStopExport As Boolean, oCurrRev As String)
Trace.WriteLine("CALLING DRAWINGLIST")
Dim oFile As String
If oStopExport = True 'No export. If there is no export, change folders.
oFile = "C:\Relco\DrawingList.txt"
Trace.WriteLine("DrawingList: PRINT")
Else 'Yes export
oFile = oFilePath & "\DrawingList.txt"
Trace.WriteLine("DrawingList: EXPORT")
End If
Dim oFileExists As Boolean = System.IO.File.Exists(oFile)
Trace.WriteLine(oFileExists)
' Try
' oFileName = oDrawDoc.FullDocumentName
' WhereUsed = oDrawDoc.FindWhereUsed(oFileName)
' ParentPartnumber = WhereUsed.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
' Trace.WriteLine(oFileName & " - PARENT IS: " & ParentPartnumber)
' Catch
' Trace.WriteLine("Fail for the PARENT.....")
' End Try
'Dim oCurrRev As String
Dim Fileout As Object
Dim oPartNumber As String
Dim oFolderName As String
Dim AssyPath As String
Dim oStatus As String
oFolderName = Mid(oFilePath, InStrRev(oFilePath, "\") + 1)
AssyPath = Mid(ThisDoc.Path, InStrRev(ThisDoc.Path, "\"))
Dim fso As Object
fso = CreateObject("Scripting.FileSystemObject")
Try
oPartNumber = oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Catch
Trace.WriteLine("DrawingList Failed: oPartnumber")
End Try
Try
oDescription = oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("description").Value
Catch
Trace.WriteLine("DrawingList Failed: oDescription")
End Try
Try
oStatus = oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("User Status").Value
If oStatus = "PRELIMINARY"
oStatus = "PRE"
Else If oStatus = "FOR APPROVAL"
oStatus = "FAP"
Else If oStatus = "APPROVED FOR CONSTRUCTION"
oStatus = "AFC"
End If
Catch
'Cant get status. Assume Preliminary?
If oStatus = ""
oStatus = " "
End If
End Try
If oBool = False And oFileExists = False ' IF NEW FILE.
Trace.WriteLine("DrawingList: initialising")
Fileout = fso.CreateTextFile(oFile, True)
'Trace.WriteLine("DrawingList: Generating Textfile")
Fileout.WriteLine("DRAWINGLIST: " & Chr(9) & QComment)
Fileout.WriteLine("TOP DRAWING: " & Chr(9) & oPartNumber & " - " & oDescription & "- REV" & oCurrRev)
Fileout.WriteLine("FOLDER: " & Chr(9) & Chr(9) & oFolderName)
Try
Fileout.WriteLine("STATUS: " & Chr(9) & Chr(9) & oDrawDoc.PropertySets.Item("Design Tracking Properties").Item("User Status").Value)
Catch
Trace.WriteLine("DRAWINGLIST: FAILED TO GET STATUS")
End Try
Fileout.WriteLine("PRE = PRELIMINARY")
Fileout.WriteLine("FAP = FOR APPROVAL")
Fileout.WriteLine("AFC = APPROVED FOR CONSTRUCTION")
Fileout.WriteLine("_________________________________")
Fileout.WriteLine("")
Fileout.WriteLine("NUMBER" & Chr(9) & "| QTY" & Chr(9) & " | REV" & Chr(9) & " | STATUS" & Chr(9) & " | DESCRIPTION")
Fileout.WriteLine(oPartNumber & " | " & QTY & "x" & Chr(9) & " | " & "REV" & oCurrRev & Chr(9) & " | " & oStatus & Chr(9) & " | " & oDescription)
Trace.WriteLine("DrawingList: Closed Textfile")
Fileout.close()
Else If oBool = True And oFileExists = True ''' PARTS AND ASSEMBLY LINES
Trace.WriteLine("DrawingList: Write line")
Fileout = fso.OpenTextFile(oFile, 8)
Fileout.WriteLine(oPartNumber & " | " & QTY & "x" & Chr(9) & " | " & "REV" & oCurrRev & Chr(9) & " | " & oStatus & Chr(9) & " | " & oDescription)
Trace.WriteLine("DrawingList: Closed Textfile")
Fileout.close()
Else If oBool = False And QTY = "END_OF_DRAWINGS"
Trace.WriteLine("DrawingList: END OF DRAWINGS")
Fileout = fso.OpenTextFile(oFile, 8)
Fileout.WriteLine(" ")
Fileout.WriteLine("THE FOLLOWING PROJECTFILES HAVE NO DRAWING: ")
Fileout.close()
Else If oBool = False And oFileExists = True And QTY = "MISSING_DRAWINGS"
Trace.WriteLine("DrawingList: MISSING DRAWINGS")
Trace.WriteLine("QComment: " & QComment)
Dim oMissing As String = Mid(QComment, InStrRev(QComment, "\") + 1)
Trace.WriteLine(oMissing & " HAS NO DRAWING!")
Fileout = fso.OpenTextFile(oFile, 8)
Fileout.WriteLine(oMissing)' & oMissing & " has no drawing.")
Fileout.close()
Else If oBool = False And oFileExists = True And QTY = "STOP"
Trace.WriteLine("STOP: print drawinglist")
Fileout = fso.OpenTextFile(oFile, 8)
Fileout.WriteLine("____________________")
Fileout.WriteLine("END OF DRAWINGLIST")
Fileout.close()
If oStopPrinting = False
Trace.WriteLine("PRINT DRAWINGLIST")
Try
Shell("notepad.exe /p " + oFile)
Catch
MessageBox.Show("FAILED TO PRINT DRAWINGLIST. TRYING AGAIN BUT THEN DIFFERENT", "Title")
Shell("notepad.exe /p " & oFile)
End Try
End If
If oStopExport = True
Trace.WriteLine("Kill File")
Kill(oFile)
End If
End If
Trace.WriteLine("ENDING DRAWINGLIST")
End Sub
Public Sub DownloadFiles(fileIters As ICollection(Of VDF.Vault.Currency.Entities.FileIteration))
Trace.WriteLine("TEST")
' download individual files to a temp location
Dim Settings = New Autodesk.DataManagement.Client.Framework.Vault.Settings.AcquireFilesSettings(mVltCon, False)
'Settings.LocalPath = New Autodesk.DataManagement.Client.Framework.Vault.Currency.FolderPathAbsolute("C:\TEMP")
Settings.LocalPath = New VDF.Currency.FolderPathAbsolute("C:\TEMP")
MsgBox (mVltCon.isconnected)
For Each fileIter As VDF.Vault.Currency.Entities.FileIteration In fileIters
Settings.AddFileToAcquire(fileIter, VDF.Vault.Settings.AcquireFilesSettings.AcquisitionOption.Download)
mVltCon.FileManager.AcquireFiles(Settings)
Next
Trace.WriteLine("TEST END")
End Sub
'Private Function GetFileIteration(nameOfFile As String, connection As VDF.Vault.Currency.Connections.Connection) As VDF.Vault.Currency.Entities.FileIteration
' Trace.WriteLine("GetFileIteration")
' Dim conditions As ACW.SrchCond()
' ReDim conditions(0)
' Dim lCode As Long = 1
' Dim Defs As ACW.PropDef() = connection.WebServiceManager.PropertyService.GetPropertyDefinitionsByEntityClassId("FILE")
' Dim Prop As ACW.PropDef = Nothing
' For Each def As ACW.PropDef In Defs
' If def.DispName = "File Name" Then
' Prop = def
' End If
' Next def
' 'store path in new string
' Dim pathname As String = nameOfFile.Substring(0, nameOfFile.LastIndexOf("\") + 1)
' Trace.WriteLine(pathname)
' 'remove path from nameOfFile
' Dim filename As String = nameOfFile.Substring(nameOfFile.LastIndexOf("\") + 1, nameOfFile.Length - pathname.Length)
' Trace.WriteLine(filename)
' 'convert local path string to vault format
' Dim VaultPath As String = pathname.Substring(0, pathname.Length - 1)
' VaultPath = VaultPath.Replace("C:\Relco\Vault\", "$/")
' 'flip the slashes
' VaultPath = VaultPath.Replace("\", "/")
' Debug.WriteLine(VaultPath)
' Dim DocService As Autodesk.Connectivity.WebServices.DocumentService
' Dim myFolder As Folder
' Dim myFolderId As Long
' Trace.WriteLine("GetFileIteration 0.5 ")
' Try
' DocService = New Autodesk.Connectivity.WebServices.DocumentService()
' myFolder = DocService.GetFolderByPath(VaultPath)
' myFolderId = myFolder.Id
' Catch ex As Exception
' Trace.WriteLine(ex.Message)
' End Try
' Trace.WriteLine(myFolderId)
' Dim myFolderIds(0) As Long
' myFolderIds(0) = myFolderId
' Dim searchCondition As ACW.SrchCond = New ACW.SrchCond()
' searchCondition.PropDefId = Prop.Id
' searchCondition.PropTyp = ACW.PropertySearchType.SingleProperty
' searchCondition.SrchOper = lCode
' 'searchCondition.SrchTxt = nameOfFile 'nameofFile includes path
' searchCondition.SrchTxt = filename 'filename does not include path
' conditions(0) = searchCondition
' 'search for files
' Dim FileList As List(Of Autodesk.Connectivity.WebServices.File) = New List(Of Autodesk.Connectivity.WebServices.File)()
' Dim sBookmark As String = String.Empty
' Dim Status As ACW.SrchStatus = Nothing
' While (Status Is Nothing OrElse FileList.Count < Status.TotalHits)
' Dim files As Autodesk.Connectivity.WebServices.File() = connection.WebServiceManager.DocumentService. _
' FindFilesBySearchConditions(conditions, Nothing, myFolderIds, True, True, sBookmark, Status)
' If (Not files Is Nothing) Then
' FileList.AddRange(files)
' End If
' End While
' Dim oFileIteration As VDF.Vault.Currency.Entities.FileIteration = New VDF.Vault.Currency.Entities.FileIteration(connection, FileList(0))
' Return oFileIteration
' Trace.WriteLine("GetFileIteration END")
' End Function
Public Sub GetSelectedFiles(File As Autodesk.Connectivity.WebServices.File, m_connection As VDF.Vault.Currency.Connections.Connection, strTargetFolder As String)
MsgBox(m_connection.IsConnected)
Dim fileIter As VDF.Vault.Currency.Entities.FileIteration = m_connection.FileManager.GetFilesByIterationIds(New Long() {File.Id}).First().Value
MessageBox.Show("Message", "Title")
Dim targetDir As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(strTargetFolder)
If Not targetDir.Exists Then
targetDir.Create()
End If
Dim downloadSettings As Autodesk.DataManagement.Client.Framework.Vault.Settings.AcquireFilesSettings = New VDF.Vault.Settings.AcquireFilesSettings(m_connection)
downloadSettings.LocalPath = New Autodesk.DataManagement.Client.Framework.Currency.FolderPathAbsolute(targetDir.FullName)
downloadSettings.CreateMetaDataFile = True
downloadSettings.AddFileToAcquire(fileIter, Autodesk.DataManagement.Client.Framework.Vault.Settings.AcquireFilesSettings.AcquisitionOption.Download)
m_connection.FileManager.AcquireFiles(downloadSettings)
End Sub
Did you find this reply helpful ? If so please use the Accept as Solution or Kudos button below.
___________________________
