Inventor

list of snippets

I am a CAD administrator by profession and I create iLogic scripts. On this page you can find snippets that I use regularly

CheckCustomProp
		
	   
		'Sub to check for custom property in the file, if the property does not exist, we create it. Tested on Inventor 2018

		Private Sub CheckCustomProp (PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oPropThickness As Inventor.Property
			Try
				oPropThickness = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oPropThickness = customPropertySet.add("", PropName)
			End Try
			
			If Value <> "" Then oPropThickness.Expression = Value
			InventorVb.DocumentUpdate()
		End Sub<
		
		
CopyCustomProp
		
	   
		'Code snippet that copies all custom Inventor properties from drawing to drawing. Tested on Inventor 2018


		Sub Main()
			'assumes that we are running the rule from the source document.
			Dim TargetDrawing As Inventor.Document = ThisApplication.ActiveDocument
			Dim SourceDrawing As Inventor.Document

			'Set File Selection dialogue object
			Dim oFileDlg As Inventor.FileDialog = Nothing
			InventorVb.Application.CreateFileDialog(oFileDlg)
			oFileDlg.InitialDirectory = oOrigRefName
			oFileDlg.CancelError = True
			
			'Set the error handling to next (needed for the detection user pressing cancel)
			On Error Resume Next
			
			oFileDlg.ShowOpen()
			If Err.Number <> 0 Then
				Return
			'check if string is empty
			ElseIf oFileDlg.FileName <> "" Then
				selectedfile = oFileDlg.FileName
			End If
			'open the selected source drawing, using the false setting to open the document Hidden
			SourceDrawing = ThisApplication.Documents.Open(selectedfile,False)
			On Error GoTo 0
			
			'Define both User defined Property sets
			Dim TargetPorps As PropertySet = TargetDrawing.PropertySets.Item("Inventor User Defined Properties")
			Dim SourceProps As PropertySet = SourceDrawing.PropertySets.Item("Inventor User Defined Properties")
			
			'declare the property variable
			Dim oProp As Inventor.Property
			
			'iterate though each user property in the source drawing and create 
			For Each oProp In SourceProps
				On Error Resume Next
				'MessageBox.Show("Trying To add value: " & oProp.Value, "Message for debugging purposes")
				TargetPorps.Add(oProp.Value, oProp.Name)
				'MessageBox.Show("Err.Number: " & Err.Number, "Message for debugging purposes")

				If Err.Number = 5 Then
					'MessageBox.Show("Value is already there: " & oProp.Value, "Message for debugging purposes")
					Dim InvPropery As [Property]
					InvPropery = TargetPorps.Item(oProp.Name)
					InvPropery.Value = oProp.Value
				End If
			Next
			'Close the source drawing without saving
			SourceDrawing.Close(True)
			InventorVb.DocumentUpdate()

			MessageBox.Show("Done copying!", "Custom iProperties copy tool")

		End Sub
		
		
RunRuleInParts
		
	   
		
		'Code snippet that Runs rule in all occurrences of an assembly (If rule is present in occurrence). Tested on Inventor 2018

		Sub Main()
		'Define the Assembly Document
		Dim oDoc As AssemblyDocument 
		Dim RuleName as string = "Test"

		' check if active document is an assembly
		Try
			oDoc = ThisApplication.ActiveDocument
		Catch
			MessageBox.Show("Please run on assembly", "Run Rule")
		End Try

		Dim oOcc As ComponentOccurrence

		GoThrough:
		For Each oOcc In oDoc.ComponentDefinition.Occurrences
				'Get Document from Occurrence 
				Dim oOccDoc As Document
				oOccDoc = oOcc.Definition.Document
				
				'Check if document is a part
				If oOccDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
					
					oOccDoc = oOcc.Definition.Document
					Try
					iLogicVb.RunRule(oOccDoc.DisplayName, RuleName)
					'MessageBox.Show("Rule run in: " & oOccDoc.DisplayName, "Message for debugging purposes")
					Catch
						'MessageBox.Show("Rule not present in: " & oOccDoc.DisplayName, "Message for debugging purposes")
					End Try
				'if the document is an assembly we need to run the same code in each occurrence of that assembly (we uses a goto function)
				Else If oOccDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject	Then 
					oDoc = oOccDoc
					GoTo GoThrough
				End If	
		Next

		End Sub

		
		
Check document type, and sub type
		
		
		Sub Main
		Dim oDoc As Document
		oDoc = ThisDoc.Document
		'Declare the ID for Sheetmetal
		Const CLSID_InventorSheetMetalPart_RegGUID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"

		'check if Document type is part
		If oDoc.DocumentType <> Inventor.DocumentTypeEnum.kPartDocumentObject Then Exit Sub
		
		'Here is a list of all of the the DocumentType enumerators available in the API:
		'kUnknownDocumentObject 
		'kPartDocumentObject 
		'kAssemblyDocumentObject 
		'kDrawingDocumentObject 
		'kPresentationDocumentObject 
		'kDesignElementDocumentObject 
		'kForeignModelDocumentObject 
		'kSATFileDocumentObject  
		'kNoDocument

		'check If part Is SheetMetal
		If oDoc.SubType = CLSID_InventorSheetMetalPart_RegGUID Then

			Dim sheetMetalDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

			'Calculate Width and height
			Calc:
			If  sheetMetalDef.HasFlatPattern() Then
							
				Dim oWidth As Double = Round(SheetMetal.FlatExtentsWidth, 3)
				Dim oHeight As Double = Round(SheetMetal.FlatExtentsLength,3)
				Dim oThick As Double = Parameter("Thickness")
						
				'create custom properties for sheet extents.
				CheckCustomProp ("Width", oWidth, oDoc)
				CheckCustomProp ("Height", Height, oDoc)
				CheckCustomProp ("Thickness", oThick, oDoc)
				iProperties.Value("Project", "Description") = "Sheet " & oWidth & "x" & oHeight & "mm T=" & Parameter("Thickness")
			Else
				Uncomment the action that is desired. Crete property to indicate work is necessary or create the flat pattern
				'iProperties.Value("Project", "Description") = "*CREATE FLAT PATTERN*"
				
				''Create the flat pattern
				'oDoc.Unfold()
				'Try
				''exit the flatpattern environment, Try statements is necessary because part might not be in flatpattern mode.
				'oSMDef.FlatPattern.ExitEdit
				'Catch
				'End Try
				
				'Goto Calc:
			End If
			

		End If


		'Endoffile:
		End Sub


		Private Sub CheckCustomProp (PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oPropThickness As Inventor.Property
			Try
				oPropThickness = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oPropThickness = customPropertySet.add("", PropName)
			End Try
			
			If Value <> "" Then oPropThickness.Expression = Value
			
			InventorVb.DocumentUpdate()

		End Sub


		
		
Add a value to an array (VBA)
		
		'Function to add one value to an array	
		Function toArray(arr() As String, value As String)
			
			Try
				Dim x As Integer = arr.Count
				ReDim Preserve arr(0 To (x))
				arr(x) = value
				toArray = arr
			Catch
				ReDim arr(0)
				arr(0) = value
				toArray = arr
			End Try

		End Function