Inventor

list of snippets

I am a CAD administrator by profession and I create iLogic scripts. On this page you can find snippets and complete scripts that have created (unless stated otherwise) and I use regularly. Feel free to use them, most of these scripts are adaptations of other rules that can be found on the internet.

Other good VBA resources:

List of snippets:

CheckCustomProp

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

		
	   
		'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

iLogic (VB) that copies all custom Inventor properties

The rule has to be executed on a drawing, and it will copy all the custom properties over to a second drawing. This drawing can be chosen with the file dialog box presented to the user.

		
	   
		'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

iLogic (VB) Script to run rules in underlying parts.

Runs rule in all occurrences of an assembly (If rule is present in occurrence)

		
	   
		

'Code snippet that Runs rule in all occurrences of an assembly (If rule is present in occurrence). Tested on Inventor 2018
Class ThisRule
	
	Dim RuleName As String = "Test"

Sub Main()
	'Define the Assembly Document
	Dim oDoc As AssemblyDocument

	' 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
	RunRuleInParts(oDoc.ComponentDefinition.Occurrences)

End Sub


Private Sub RunRuleInParts (CompOcc As Inventor.ComponentOccurrences)
	
	For Each oOcc In CompOcc
		'Get Document from Occurrence
		Dim oOccDoc As Document
		Try
		oOccDoc = oOcc.Definition.Document
		Catch
			Continue For
		End Try

		'Check if document is a part
		If oOccDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
			Try
			iLogicVb.RunRule("PartA:1", "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
			Dim oDoc As Inventor.AssemblyDocument
			oDoc = oOccDoc
			Try
				RunRuleInParts(oDoc)
			Catch
				Continue For
			End Try
		End If
	Next
End Sub

End Class

		
		
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


		
iLogic script to turn visibility off for objects in all files in an assembly

Sometimes simply hiding all work features, sketches and origin planes with the overall settings of Inventor is just not enough. This is Especially the case when viewing files with the Inventor viewer. Inventor viewer will not allow the user to hide these features. These features can obstruct the view of the model.

This Rule will Present the user with a multiple choice input box. After the choice is made the rule will set visibility for the selected object to off.

		
		'This Rule will Present the user with a multiple choice input box. After the choice is made the rule will set visibility for the selected object to off.

		Class ThisRule
			' Setup Progress Bar
			Dim ReferenceCount As Integer
			Dim oStep As Integer
			Dim oMessage As String = "Setting visibility for objects to off"
			Dim oProgressBar As Inventor.ProgressBar
			Dim DocFailed As Integer

		Sub Main()
			'get the active document
			Dim oDoc As Document 
			oDoc = ThisApplication.ActiveDocument

			'check if the rule is run on an Assembly
			Dim Assydoc As AssemblyDocument
			If oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then   
				Assydoc = oDoc
			Else
				MessageBox.Show("Rule needs to be run from Assembly", "Rule: Object visibility")
				Exit Sub
			End If	

			
			'Present user with multiple choice
			Dim Options() As String = {"All", "Only Origin planes", "Work planes and Origin planes", "Axis only", "Work points only", "Sketches only"}
			Result1 = InputListBox("Please select", Options, Options(0), Title := "Object Visibility", ListName := "List")

			'perform actions on basis of multiple choice. First all documents in the assembly are counted, then the objects are turned off whilst the user is presented with a progress bar
			Select Case Result1
				Case options(0)
					CountReferencedDocuments(Assydoc, 4)
					RemoveWorkPlanes(Assydoc)
					RemoveSketches(Assydoc)
					RemoveWorkpoints(Assydoc)
					RemoveAxis(Assydoc)
				Case options(1)
					CountReferencedDocuments(Assydoc, 1)
					RemoveOriginPlanes(Assydoc)
				Case options(2)
					CountReferencedDocuments(Assydoc, 1)
					RemoveWorkPlanes(Assydoc)
				Case options(3)
					CountReferencedDocuments(Assydoc, 1)
					RemoveAxis(Assydoc)
				Case options(4)
					CountReferencedDocuments(Assydoc, 1)
					RemoveWorkpoints(Assydoc)
				Case options(5)
					CountReferencedDocuments(Assydoc, 1)
					RemoveSketches(Assydoc)
			End Select
			
			oProgressBar.Close
			
			'Check if there are any failed files, and show user how many files.
			If DocFailed <> 0 Then
				MessageBox.Show(DocFailed & " Objects failed to set to invisible", "Object Visibility")
			End If
			'Update file
			iLogicVb.UpdateWhenDone = True
		End Sub

		'this sub will count the objects and create the progress bar
		Sub CountReferencedDocuments(Assydoc As AssemblyDocument, Passes As Integer)
			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
					ReferenceCount = ReferenceCount + Passes
				End If
			 Next
			oProgressBar = ThisApplication.CreateProgressBar(False, ReferenceCount, oMessage)
		End Sub

		'This Sub will set visibility for all origin planes to off
		Sub RemoveOriginPlanes (Assydoc As AssemblyDocument)
			For Each oWorkPlane In Assydoc.ComponentDefinition.WorkPlanes
				If oWorkPlane.Name = "XY Plane" Or oWorkPlane.Name = "XZ Plane" Or oWorkPlane.Name = "YZ Plane"
				oWorkPlane.Visible = False
				End If
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPlane In Partdoc.ComponentDefinition.WorkPlanes
						If oWorkPlane.Name = "XY Plane" Or oWorkPlane.Name = "XZ Plane" Or oWorkPlane.Name = "YZ Plane"
							Try
								oWorkPlane.Visible = False
							Catch
								DocFailed = DocFailed + 1
							End Try
						End If
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work planes to off
		Sub RemoveWorkPlanes (Assydoc As AssemblyDocument)
			For Each oWorkPlane In Assydoc.ComponentDefinition.WorkPlanes
				oWorkPlane.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPlane In Partdoc.ComponentDefinition.WorkPlanes
						Try
							oWorkPlane.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work axis to off
		Sub RemoveAxis (Assydoc As AssemblyDocument)
			For Each oAxes In Assydoc.ComponentDefinition.WorkPlanes
				oAxes.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oAxes In Partdoc.ComponentDefinition.WorkAxes
						Try
							oAxes.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work points to off
		Sub RemoveWorkpoints (Assydoc As AssemblyDocument)
			For Each oWorkPoint In Assydoc.ComponentDefinition.WorkPoints
				oWorkPoint.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPoint In Partdoc.ComponentDefinition.WorkPoints
						Try
							oWorkPoint.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all sketches to off
		Sub RemoveSketches(Assydoc As AssemblyDocument)
			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oSketch In Partdoc.ComponentDefinition.Sketches
						Try
							oSketch.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
					For Each o3DSketch In Partdoc.ComponentDefinition.Sketches3D
						Try
						o3DSketch.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub


		'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

		End Class

		
iLogic script to Purge style overrides on text boxes.

Sometimes it can be necessary to purge overrides on textboxes inside drawings or sketch blocks. This makes sure that the text follows the set text style as intended.

'This Rule will Clear text (textboxes) inside a sketch (drawing Sketch) of style overrides, these can be very difficult to get rid off in any other way.

		
		'This Rule will Clear text (textboxes) inside a sketch (drawing Sketch) of style overrides, these can be very difficult to get rid off in any other way.

		Sub Main()
			Dim oDoc As DrawingDocument
			oDoc = ThisDoc.Document
			
			SelectNew: 
			
			Dim oText1 As Inventor.TextBox
			oText1 = GetSelection1(oDoc)

			If StyleOverrideFont(oText1.FormattedText) = True Then
				Answer1 = MessageBox.Show("Override on Text style Found Do you want to remove?", "Purge Override",MessageBoxButtons.OKCancel)
				Else
				Answer2 = MessageBox.Show("No override found, do you want to test another textbox?", "Purge Override",MessageBoxButtons.OKCancel)

				If Answer2 = vbOK Then
					GoTo SelectNew
				Else
					Exit Sub
				End If
			End If
			
			If Answer1 = vbOK Then
				RemoveAllStyleOverride(oText1) 
			End If
		End Sub

		Private Function GetSelection1(ByVal oDoc As DrawingDocument) As Inventor.TextBox
			Dim oText As Inventor.TextBox
			oText = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kSketchTextBoxFilter, "Select Textbox")
			Return oText
		End Function

		Private Function StyleOverrideFont(FormattedText As String) As Boolean
			If InStr(FormattedText, " 0 Then
				StyleOverrideFont = True
			Else 
				StyleOverrideFont = False
			End If
		End Function



		Private Sub RemoveAllStyleOverride(Textbox As Inventor.TextBox) 
			Dim PlainText As String
			PlainText = Textbox.Text
			Textbox.FormattedText = PlainText
		End Sub
		
iLogic script load configurations.

Sometimes it we want a flexible configurable file. Loading an XML with settings can be a good idea to make your code configurable.

'This Rule will add iProperties for all parts in an Inventor Assembly on basis of the configuration file. (for configfile example, see below) but this technique can be used to load all kinds of settings.

		
		'AddReference "System.Linq"
		AddReference "System.Xml"
		AddReference "System.Xml.Linq"
		AddReference "System.Core"
		Imports System.Linq
		Imports System.Xml
		Imports System.Xml.Linq
		Imports System.Xml.Schema
		Class ThisRule


		Dim ConfigPath As String = "C:\TEMP\Config\"
		Dim xConfigurations As XElement

		'https://analystcave.com/vba-xml-working-xml-files/
		'Scan the directory for multiple configurations


		Sub Main()
			'Set reference to the active document 
			Dim oDoc As Document
			oDoc = ThisApplication.ActiveDocument
			
			'check if rule is run on assembly
			If oDoc.DocumentType <> Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then 
				MessageBox.Show("Run Rule on assembly", "Message")
				Exit Sub
			End If
				
			'Read configuration XML 
			'Read dir for all configuration XML files
			Dim ListConfigurations As New ArrayList
			ListConfigurations = ReadConfigurations(ConfigPath)

			'Get user input for choice configuration
			Result1 = InputListBox("Please Choose", ListConfigurations , ListConfigurations.Item(0), Title := "Configurations", ListName := "List")
			
			'Check if user has exited without a choice
			If Result1 = "" Then Exit Sub
			
			sConfigXML = ConfigPath & Result1 & ".xml"
			Try
				xConfigurations = XElement.Load(sConfigXML)
			Catch
				Exit Sub
			End Try
			
			'Get all referenced files
			Dim oRefDoc As Inventor.Document
			
			'add property to each file
			For Each oRefDoc In oDoc.ReferencedDocuments
				'Check if document is read only
				Dim fio As New System.IO.FileInfo(oRefDoc.FullDocumentName)
				Dim ModCheck As Boolean
				Try
					ModCheck = fio.IsReadOnly
				Catch
					Continue For
				End Try
				
				'Add properties when the document is a Part and modifiable
				If oRefDoc.DocumentType = Inventor.DocumentTypeEnum.kPartDocumentObject And ModCheck = False Then
					AddProperty(oRefDoc)
				End If
			Next
			
		End Sub

		Private Sub AddProperty(oDoc As Inventor.Document)

			'get the configurations
			Dim Configuration As IEnumerable(Of XElement) = From el In xConfigurations. Select el

			'Check what the configuration value is if property is string type
			Dim sConfigValue As String
			
			For Each el As XElement In Configuration
				Try
					sConfigValue = el.Element("PropertyName").Value
				Catch
					MessageBox.Show("5001, Value1 does not exist in Config file","Message")
					Exit Sub
				End Try

				If sConfigValue = "" Then Continue For
				CheckCustomProp(sConfigValue, "", oDoc)
			Next
		End Sub	

		Private Function ReadConfigurations(sPath As String)
			Dim vaArray As New ArrayList
			Dim i           As Integer
			Dim oFile       As Object
			Dim oFSO        As Object
			Dim oFolder     As Object
			Dim oFiles		As Object
			Dim sFilterExt As String = ".xml"

			oFSO = CreateObject("Scripting.FileSystemObject")
			oFolder = oFSO.GetFolder(sPath)
			oFiles = oFolder.Files

			If oFiles.Count = 0 Then 
				MessageBox.Show("No Configurations found", "Title")
				Exit Function
			End If

			i = 1
			For Each oFile In oFiles
				
				If Right(oFile.Name,4) = sFilterExt Then
					vaArray.Add(Left(oFile.Name,(Len(oFile.Name)-4)))
				End If
				i = i + 1
			Next
			
			If vaArray.Count = 0 Then 
				MessageBox.Show("Could not find XML", "Title")
				Exit Function
			End If

			ReadConfigurations = vaArray
		End Function


		Sub CheckCustomProp (PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oProp As Inventor.Property
			Try
				oProp = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oProp = customPropertySet.Add("", PropName)
			End Try
			oProp.Expression = Value
		End Sub

		End Class

		

Configfile example:

		
		<?xml version="1.0" encoding="utf-8"?>
		<!--Structure derived from: https://analystcave.com/vba-xml-working-xml-files/.-->
		
		
		<ValuesSetup>
		
			<!--Configuration file. 
			Create .XML file in C:\TEMP\Config\ and copy paste this text with a text editor.
			More Values can be added to the setup if needed.-->
			<PropertyConfig Type="New">
				<PropertyName>Name1</PropertyName>
			</PropertyConfig>
			<PropertyConfig Type="New">
				<PropertyName>Name1</PropertyName>
			</PropertyConfig>
		

		</ValuesSetup>
		
		
iLogic script to switch fontsize.

In the drawing environment of Inventor, it is quite involved to change existing dimension style and font size for view labels. This is often necessary when switching between sheet sizes. This can of course be automated with iLogic.

'The following rule will change replace dimension styles and the view label font-size on a drawing. It presents the user with a boolean messagebox to switch between to two.

		
		

		Dim bBigText As Boolean

		bBigText = InputRadioBox("What is the main text size ", "3,5 (A1 sheet size)", "2,5 (A3 sheet size)", booleanParam, Title := "Please select")


		If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
			MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Drawing Documents.",vbOKOnly, "WRONG DOCUMENT TYPE")
			Exit Sub
		End If
		Dim oDDoc As DrawingDocument = ThisDrawing.Document
		Dim oDSMgr As DrawingStylesManager = oDDoc.StylesManager
		Dim oNewStyle As DimensionStyle
		Try
			If bBigText = True Then
				oNewStyle = oDSMgr.DimensionStyles.Item("Dimension style-A1")
			Else
				oNewStyle = oDSMgr.DimensionStyles.Item("Dimension style")	
			End If
		Catch
			MsgBox("That source Dimsnesion Style was not found. Exiting.", vbOKOnly, " ")
			Exit Sub
		End Try



		For Each oSheet As Inventor.Sheet In oDDoc.Sheets
			
			'Change Sheet Size
			Try	
				If bBigText = True Then
					oSheet.Size = 9994
				Else
					oSheet.Size = 9996
				End If
			Catch
				'Continue For
			End Try
			
			'Change sheet dimensionstyles
			
			For Each oBDimSet As BaselineDimensionSet In oSheet.DrawingDimensions.BaselineDimensionSets
				oBDimSet.Style = oNewStyle
			Next
			For Each oCDimSet As ChainDimensionSet In oSheet.DrawingDimensions.ChainDimensionSets
				oCDimSet.Style = oNewStyle
			Next
			For Each oGDim As GeneralDimension In oSheet.DrawingDimensions.GeneralDimensions
				oGDim.Style = oNewStyle
			Next
			For Each oODim As OrdinateDimension In oSheet.DrawingDimensions.OrdinateDimensions
				oODim.Style = oNewStyle
			Next
			For Each oODimSet As OrdinateDimensionSet In oSheet.DrawingDimensions.OrdinateDimensionSets
				oODimSet.Style = oNewStyle
			Next
			
			'Change View Labels:
			Dim oViews As DrawingViews
			
			oViews=oSheet.DrawingViews
			
			Dim oView As DrawingView
			Dim sLabel As String
			Dim sNewLabel As String
			Dim sTopLabel As String
			Dim sBotomLabel As String
			Dim iDelimLoc As Integer
			Dim iFontSizeLoc As Integer

			 For Each oView In oViews
		   
				Try
					sLabel = oView.Label.FormattedText
					iDelimLoc = 0
					iDelimLoc = InStr(sLabel, "")
					
					If iDelimLoc <> 0 Then
					
						sTopLabel = Left(sLabel, iDelimLoc - 1)
						sBotomLabel = Right(sLabel, Len(sLabel) - iDelimLoc - 11)
						
						'Check if we have an override
						iFontSizeLoc = 0
						iFontSizeLoc = InStr(sTopLabel, "FontSize=")
						

						If iFontSizeLoc <> 0 Then
							If bBigText = True Then
								sTopLabel = Replace(sTopLabel, "FontSize='0.25'", "FontSize='0.35'")
							Else
								sTopLabel = Replace(sTopLabel, "FontSize='0.35'", "FontSize='0.25'")
							End If
						Else
							If bBigText = True Then
								sTopLabel = "" & sTopLabel & ""
							Else
								sTopLabel = "" & sTopLabel & ""
							End If
						End If
						
						'Check botom label
						'Check if we have an override
						iFontSizeLoc = 0
						iFontSizeLoc = InStr(sBotomLabel, "FontSize=")
						
						If iFontSizeLoc <> 0 Then
							If bBigText = True Then
								sBotomLabel = Replace(sBotomLabel, "FontSize='0.18'", "FontSize='0.25'")	
							Else
								sBotomLabel = Replace(sBotomLabel, "FontSize='0.25'", "FontSize='0.18'")	
							End If
						Else
							If bBigText = True Then
								sBotomLabel = "" & sBotomLabel & ""
							Else
								sBotomLabel = "" & sBotomLabel & ""	
							End If
						End If
						
						sNewLabel = sTopLabel & "" & sBotomLabel
						
						'MessageBox.Show(sNewLabel, "sNewLabel")
					Else
						
						'Check botom label
						'Check if we have an override
						iFontSizeLoc = 0
						iFontSizeLoc = InStr(sLabel, "FontSize=")
						
						If iFontSizeLoc <> 0 Then
							If bBigText = True Then
								sLabel = Replace(sLabel, "FontSize='0.18'", "FontSize='0.25'")
								sLabel = Replace(sLabel, "FontSize='0.25'", "FontSize='0.35'")
							Else
								sLabel = Replace(sLabel, "FontSize='0.25'", "FontSize='0.18'")
								sLabel = Replace(sLabel, "FontSize='0.35'", "FontSize='0.25'")
							End If
						Else
							If bBigText = True Then
								sLabel = "" & sLabel & ""
							Else 
								sLabel = "" & sLabel & ""
							End If
						End If
						sNewLabel = sLabel
					End If
					oView.Label.FormattedText = sNewLabel 

				Catch
				'do nothing if error        
				End Try
			Next
			
		Next


		
Button on Ribbon to Activate iLogic.

So you want to create a button for an iLogic script on your Ribbon?

Just follow these steps:

Step 1

Step 2

Step 3

Step 4

Step 6

The Code:

		
		
		

		'Run an external iLogic rule
		Public Sub YourExternalMacro()
			RunExtiLogic ("InsertRuleName")
		End Sub

		'Run an Document iLogic rule
		Public Sub YourMacro()
			RuniLogic ("InsertRuleName")
		End Sub
		
		
		Function RuniLogic(ByVal RuleName As String)
		  Dim iLogicAuto As Object
		  Dim oDoc As Document
		  Set oDoc = ThisApplication.ActiveDocument
		  
		  If oDoc Is Nothing Then
			MsgBox "Missing Inventor Document"
			Exit Function
		  End If

		  Set iLogicAuto = GetiLogicAddin(ThisApplication)
		  If (iLogicAuto Is Nothing) Then Exit Function
		   
		  
		  iLogicAuto.RunRule oDoc, RuleName


		End Function
				
		
		Function RunExtiLogic(ByVal RuleName As String)
		  Dim iLogicAuto As Object
		  Dim oDoc As Document
		  Set oDoc = ThisApplication.ActiveDocument
		  
		  If oDoc Is Nothing Then
			MsgBox "Missing Inventor Document"
			Exit Function
		  End If

		  Set iLogicAuto = GetiLogicAddin(ThisApplication)
		  If (iLogicAuto Is Nothing) Then Exit Function
		   
		On Error GoTo eh
		  iLogicAuto.RunExternalRule oDoc, RuleName

		Exit Function

		eh:
		MsgBox "Could not Find rule " & vbCrLf & vbCrLf & "Error Msg: " & vbCrLf & Err.Description


		End Function
		


		Function GetiLogicAddin(oApplication As Inventor.Application) As Object
		Dim addIns As ApplicationAddIns
		Set addIns = oApplication.ApplicationAddIns

		Dim addIn As ApplicationAddIn
		Dim customAddIn As ApplicationAddIn
		For Each addIn In addIns
		If (addIn.ClassIdString = "{3BDD8D79-2179-4B11-8A5A-257B1C0263AC}") Then
		Set customAddIn = addIn
		Exit For
		End If
		Next

		If (customAddIn Is Nothing) Then Exit Function

		customAddIn.Activate
		Set GetiLogicAddin = customAddIn.Automation
		End Function