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
		
Parse Filename and folder from complete Path
		
		'Functions to parse Filename and folder from complete Path
		Public Function FileNameFromPath(strFullPath As String) As String
			FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))
		End Function
		
		Public Function FileNameFromPathNoExt(strFullPath As String) As String
			Dim FileNameFromPath2 As String = FileNameFromPath(strFullPath)
			FileNameFromPathNoExt = Left(FileNameFromPath2, (InStrRev(FileNameFromPath2, ".")-1))
		End Function

		Public Function FolderFromPath(strFullPath As String) As String
			FolderFromPath = Left(strFullPath, InStrRev(strFullPath, "\"))
		End Function

		
Align drawing views horizontally and vertically by selection of lines. Source: Bart Den Otter
		
		Sub Main()
			Dim oDoc As DrawingDocument
			oDoc = ThisDoc.Document

			Dim oCurve1, oCurve2 As DrawingCurveSegment
			oCurve1 = GetCurve1(oDoc)
			oCurve2 = GetCurve2(oDoc)

			Dim oView1, oView2 As DrawingView 
			oView1 = oCurve1.Parent.Parent
			oView2 = oCurve2.Parent.Parent

			Dim Curve1Point1, Curve1Point2, Curve2Point1, Curve2Point2, View1Point, View2Point As Point2d
			Curve1Point1=oCurve1.StartPoint
			Curve1Point2=oCurve1.EndPoint
			Curve2Point1=oCurve2.StartPoint
			Curve2Point2=oCurve2.EndPoint

			If oView1.Name = oView2.Name Then
				MessageBox.Show("Select lines from different views", "Align view error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
				Exit Sub
			End If

			If (Round((Curve1Point1.X - Curve1Point2.X)*1e8) = 0 And Round((Curve2Point1.X - Curve2Point2.X)*1e8) = 0) Then
				MoveView = Curve1Point1.X - Curve2Point1.X
				oView2Point = oView2.Position
				oView2Point.X = oView2Point.X + MoveView
				oView2.Position = oView2Point
			Else If(Round((Curve1Point1.Y - Curve1Point2.Y)*1e8) = 0 And Round((Curve2Point1.Y - Curve2Point2.Y)*1e8) = 0) Then
				MoveView = Curve1Point1.Y - Curve2Point1.Y
				oView2Point = oView2.Position
				oView2Point.Y = oView2Point.Y + MoveView
				oView2.Position = oView2Point
			Else
				MessageBox.Show("Lines are not horizontal or vertical or not in the same orientation.", "Align view error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
				MsgBox(Curve1Point1.Y - Curve1Point2.Y)
				MsgBox(Curve2Point1.Y - Curve2Point2.Y)
				Exit Sub
			End If
		End Sub
		 
		Private Function GetCurve1(ByVal oDoc As DrawingDocument) As DrawingCurveSegment
			Dim Curve As DrawingCurveSegment
			Curve = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Select first line to align")
			Return Curve
		End Function
		 
		Private Function GetCurve2(ByVal oDoc As DrawingDocument) As DrawingCurveSegment
			Dim Curve As DrawingCurveSegment
			Curve = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Select second line to align")
			Return Curve
		End Function
		
A function to check if property exists and otherwise add Custom iProperties to a file
		
		Private Sub CheckSumProp (PropName As String, Value As String, oDoc As Document)
			Dim SumPropertySet As PropertySet 
			SumPropertySet = oDoc.PropertySets.Item("Inventor Summary Information")
			Dim oProp1 As Inventor.Property
			oProp1 = SumPropertySet.Item(PropName)
			If Value <> "" Then oProp1.Expression = Value
			InventorVb.DocumentUpdate()
		End Sub

		Private Sub CheckTrackProp (PropName As String, Value As String, oDoc As Document)
			Dim TrackPropertySet As PropertySet 
			TrackPropertySet = oDoc.PropertySets.Item("Design Tracking Properties")
			Dim oProp1 As Inventor.Property
			oProp1 = TrackPropertySet.Item(PropName)
			If Value <> "" Then oProp1.Expression = Value
			InventorVb.DocumentUpdate()
		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
		
VBA MACRO to start the ESKD add-in and activate the technical notes command

A macro to turn on and of the "Technical Requirements" dialog box found in the GOST standards of Inventor. Mark Lancaster wrote an Article following my featured post in Cadalyst magazine

This macro is useful because the dialogue can only be used when the GOST standards are on. Some users of Inventor do not want the GOST standards to be always active. The add-in will provide other functionality, like different style weld symbols. This macro will activate the add-in allowing the command to be activated and after the dialogue is closed it will unload the add-in again.

		
		Public Sub Technical_notes()

		' Created by Hoppend (AUG 2015)
		' This VBA MACRO will start the ESKD add-in and activate the technical notes command
		' once the technical notes dialog box is closed, it will unload the ESKD add-in.
		' The library for this technical notes resides in the "Design Data\GOST\technical requirements\*.tr"
		' the .tr files can be edited with a regular text editor.

			Dim app As Application
			Set app = ThisApplication
			Dim oDoc As Document
			Set oDoc =  app.ActiveDocument
		 
			' Turn on the ESKD Add-In.
			Call Activate
		  
			' Get the CommandManager object.
			Dim oCommandMgr As CommandManager
			Set oCommandMgr = ThisApplication.CommandManager

			' Get control definition for the line command.
			Dim oControlDef As ControlDefinition
			Set oControlDef = oCommandMgr.ControlDefinitions.Item("Gost.Command.TechRequirements")
			' Execute the command.
			Call oControlDef.Execute
		   
			' Turn off the ESKD Add-In.
			Call Deactivate
			
			' Update the document.
			app.ActiveDocument.Update

			' update the ribbons by editing a sketch
			Dim oSketch As DrawingSketch
			Dim oSketches As DrawingSketches
			Set oSketches = oDoc.ActiveSheet.Sketches
				For Each oSketch In oSketches
					If oSketch.Name = "Technical Requirements" Then
					oSketch.Edit
					oSketch.ExitEdit
					End If
				Next
		 End Sub


		Public Sub Activate()
			Dim app As Application
			Set app = ThisApplication

			Dim addins As ApplicationAddIns
			Set addins = app.ApplicationAddIns

			' Get the DWF AddIn using its ID
			Dim AddIn As ApplicationAddIn
			Set AddIn = addins.ItemById("{005B21FC-8537-4926-9F57-3A3216C294C3}")
		 
			' Activate AddIn
			If AddIn.Activated = True Then
				Exit Sub
				Else
				AddIn.Activate
			End If
		End Sub

		Public Sub Deactivate()
			Dim app As Application
			Set app = ThisApplication

			Dim addins As ApplicationAddIns
			Set addins = app.ApplicationAddIns

			' Get the DWF AddIn using its ID
			Dim AddIn As ApplicationAddIn
			Set AddIn = addins.ItemById("{005B21FC-8537-4926-9F57-3A3216C294C3}")
		 
			' Activate AddIn
			If AddIn.Activated = False Then
				Exit Sub
				Else
				AddIn.Deactivate
			End If
		End Sub