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:
This site from fellow Dutchman is full of usefull scripts but also add-ins. His article about VBA being obsolete or not is also worth a read: | http://www.hjalte.nl/ |
A very well known website, they have been posting Inventor Related articles since 2008 and there are tons of tips to be found: | https://modthemachine.typepad.com/my_weblog |
Certainly worth a mention is Clint Brown's website. Although the ilogic section should be considered "archived": | https://clintbrown.co.uk/category/inventor/ |
Also, don't forget the Autodesk Forum, especially when googleling, this is a huge help with tons of very knowledgeable people that are ready to help: | https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/bd-p/120 |
List of snippets:
Link to a document that contains everything you need to know about working with iProperties in iLogic. I never seem to be able to find the document so I thought I'd link to it here: | ipropertiesandparameters.pdf |
Sub to check for custom property in the file, if the property does not exist, we create it. | CheckCustomProp |
iLogic (VB) that copies all custom Inventor properties | CopyCustomProp |
iLogic Script to run rules in underlying | RunRule |
Check document type, and sub type. Also create flatpattern trough iLogic and determine the sheet extents | SheetMetal |
A separate iLogic (VB) Function that adds a value to an array and resizes it. | AddToArray |
iLogic (VB) Functions to parse Filename and folder from complete Path. | Parse |
Bart Den Otter's iLogic script to align drawing views horizontally and vertically by selection of lines. | AlignView |
My iLogic function to check if property exists and otherwise add Custom iProperties to a file. | iPropertyFunction |
My VBA 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 | Technical Requirements |
My iLogic script to turn visibility off for objects in all files in an assembly. Objects like Sketches, work planes, work axis and work points | Object Visibility |
My iLogic script purge style overrides on textboxes. This is normally needed only on drawing sketches drawing sketch blocks or Titleblocks. | Purge text style Override |
Sometimes it we want a flexible configurable file. Loading an XML with settings can be a good idea to make your code configurable. | Load XML configuration |
Switching between font sizes on a drawing can be involved, this is a way of automating most of the process. | Switch font size |
So you want to create a button for an iLogic script on your Ribbon. | iLogic ribbon button. |
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<
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
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
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
'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
'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
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
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
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
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
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
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>
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
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