Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Hello all,

 

This might be interesting for people who are using a Vault and want to use the above rule with numbering scheme from Vault:

 

I added some code to the rule, so the automatically created files are saved with filenames according to a vault numbering scheme.

(The rule above uses filenames from the excel sheet.)

 

 

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop.Excel
AddReference "Autodesk.Connectivity.WebServices"
AddReference "Autodesk.DataManagement.Client.Framework.Forms"
AddReference "Autodesk.DataManagement.Client.Framework.Vault"
AddReference "Autodesk.DataManagement.Client.Framework.Vault.Forms"
AddReference "Connectivity.InventorAddin.EdmAddin"
Imports ACW = Autodesk.Connectivity.WebServices
Imports VDF = Autodesk.DataManagement.Client.Framework
Imports Autodesk.DataManagement.Client.Framework.Vault.Services
Imports Autodesk.DataManagement.Client.Framework.Vault.Currency.Connections
Imports edm = Connectivity.InventorAddin.EdmAddin
Sub Main
'Specify the Excel file's (Workbook) full path & file name (with extension)
'It is calling a Windows OpenFileDialog to allow the user to do this
Dim oFileName As String = GetExcelFile()
'Specify the Sheet name within the workbook
'perhaps this name could be selected from a list of all available sheets
'in the Excel Workbook once opened, of you don't want to manually specify it here?
Dim oSheetName As String = "Sheet1"

'Start a new instance of the Excel application
Dim oExcelApp As Microsoft.Office.Interop.Excel.Application
oExcelApp = New Microsoft.Office.Interop.Excel.ApplicationClass
oExcelApp.DisplayAlerts = False
oExcelApp.Visible = False

'[ Attempt to open the specified Workbook (file) using the supplied file name
Dim oWB As Workbook
Try
	oWB = oExcelApp.Workbooks.Open(oFileName)
Catch oEx As Exception
	MsgBox("The attempt to open the Excel file named '" & oFileName & "' failed." & vbCrLf & _
	"The error message for this failure is as follows:" & vbCrLf & _
	oEx.Message & vbCrLf &  vbCrLf & _
	"Its 'StackTrace is as follows:" & vbCrLf & _
	oEx.StackTrace & vbCrLf & vbCrLf & _
	"Its source is as follows:" & vbCrLf & _
	oEx.Source, vbOKOnly + vbCritical, "Couldn't Open File")
	Exit Sub
End Try
'Attempt to get the Worksheet
Dim oWS As Worksheet
Try
	oWS = oWB.Sheets.Item(oSheetName)
Catch
	oWS = oWB.ActiveSheet
Catch
	oWS = oWB.Worksheets.Item(1)
Catch
	MsgBox("No Worksheet was found in the specified Excel file. Exiting.", vbOKOnly + vbCritical, " ")
	Exit Sub
End Try

Dim oCells As Range = oWS.Cells

'Define the active Assembly and all related variables
If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
	MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Assembly Documents.",vbOKOnly, "WRONG DOCUMENT TYPE")
	Exit Sub
End If
Dim oADoc As AssemblyDocument = ThisAssembly.Document
Dim oDir As String = System.IO.Path.GetDirectoryName(oADoc.FullFileName)
Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition
Dim oOccs As ComponentOccurrences = oADef.Occurrences
Dim oOcc As ComponentOccurrence
Dim oPDoc As PartDocument
Dim oDProps As Inventor.PropertySet 'Design Tracking Properties (Project)
Dim oSProps As Inventor.PropertySet 'Inventor Summary Information (Summary)
Dim oMatrix As Inventor.Matrix = ThisApplication.TransientGeometry.CreateMatrix

'Find the last row and last column being used to limit our loop ranges
Dim oLastRow As Integer = oWS.UsedRange.Rows.Count
'Dim oLastCol As Integer = oWS.UsedRange.Columns.Count
'Dim oColumnHeadersRow As Integer = 1
Dim o1stDataRow As Integer = 2
Dim oRow, oQty As Integer
Dim oPName, oPNum, oVendor, oNotes As String
Dim oPFilename As String

For oRow = o1stDataRow To oLastRow
	'First number is Row index, second number is Column Index
	oQty = oCells.Item(oRow, 1).Value
	oPName = oCells.Item(oRow, 2).Value
	oPNum = oCells.Item(oRow, 3).Value
	oVendor = oCells.Item(oRow, 4).Value
	oNotes = oCells.Item(oRow, 5).Value
	
	'Create the new Part
	oPDoc = ThisApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject, , False)
	'Set the iProperties within the new Part
	oDProps = oPDoc.PropertySets.Item("Design Tracking Properties")
	oSProps = oPDoc.PropertySets.Item("Inventor Summary Information")
	oDProps.Item("Description").Value = oPName
	oDProps.Item("Part Number").Value = oPNum
	oDProps.Item("Vendor").Value = oVendor
	oSProps.Item("Comments").Value = oNotes
	
	'<<<< !!! CHECK IF THIS IS OK BEFORE RUNNING !!! >>>>
	'Saving each new Part to the same directory as the Assembly
	'if this is not OK, you could specify a different directory
	'or you could use a SaveFileDialog for this
	'or just skip saving the parts at this stage altogether
	oPFilename = getFilenamesFromVaultNamingScheme("CT", "", 1)
	'note: CT is the name of my numbering scheme in vault has to be adjusted to personal needs!!
	'oPDoc.SaveAs(oDir & "\" & oPName & ".ipt", False)
	oPDoc.SaveAs(oDir & "\" & oPFilename & ".ipt", False)
	
	'Add that many of this part to the assembly
	For i = 1 To oQty
		oOccs.AddByComponentDefinition(oPDoc.ComponentDefinition, oMatrix)
	Next
Next

'Close the Workbook (file)
oWB.Close
'Close this instance of the Excel application
oExcelApp.Quit
End Sub

Function GetExcelFile() As String
	Dim oFileName As String
	Dim oOpenDlg As New System.Windows.Forms.OpenFileDialog
	oOpenDlg.Title = "Browse To And Select Your Excel File."
	oOpenDlg.InitialDirectory = ThisApplication.DesignProjectManager.ActiveDesignProject.WorkspacePath
	oOpenDlg.Filter = "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx"
	oOpenDlg.Multiselect = False
	oOpenDlg.RestoreDirectory = False
	Dim oResult = oOpenDlg.ShowDialog
	If oResult = vbOK Then
		If oOpenDlg.FileName <> vbNullString Then
			oFileName = oOpenDlg.FileName
		Else
			MsgBox("No file was selected. Exiting.", vbOKOnly + vbExclamation, "FILE NOT SELECTED")
		End If
	ElseIf oResult = vbCancel Then
		MsgBox("The dialog was Canceled. Exiting.", vbOKOnly + vbInformation, "CANCELED")
	End If
	GetExcelFile = oFileName
End Function


Function getFilenamesFromVaultNamingScheme(RequiredSchemeName As String, RequiredSchemeString As String, numberOfNames As Integer)
Dim oPFilename As String
Dim Connection As VDF.Vault.Currency.Connections.Connection = edm.EdmSecurity.Instance.VaultConnection()
Dim genNum As String = String.Empty

If Not Connection Is Nothing Then
Dim entityClassId = VDF.Vault.Currency.Entities.EntityClassIds.Files
Dim numSchemes As ACW.NumSchm() = Connection.WebServiceManager.NumberingService.GetNumberingSchemes(entityClassId, Nothing) 'kanske inte nothing
Dim requiredScheme As ACW.NumSchm = (From sch As ACW.NumSchm In numSchemes
Where sch.Name = RequiredSchemeName
Select sch).FirstOrDefault()
Dim numGenArgs() As String = {RequiredSchemeString }

	
	oPFilename = Connection.WebServiceManager.DocumentService.GenerateFileNumber(requiredScheme.SchmID, numGenArgs)

'MessageBox.Show("Numbers generated: " & oPFilename & " to ", "Success!", _
'MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
MessageBox.Show("Vault didn't work", "Fail!", _
MessageBoxButtons.OK, MessageBoxIcon.Error)
End If 
getFilenamesFromVaultNamingScheme = oPFilename
End Function

 

 

I got the code for the vault numbering scheme from here:

https://forums.autodesk.com/t5/inventor-customization/create-parts-and-save-using-vault-numbering-sc...

so thanks to