In mijn professionele werk als CAD administrator en Vault, Plant 3D en Inventor Expert heb ik een aantal scripts en script fragmenten welke ik vaak gebruik, via deze website stel ik deze beschikbaar zodat jij ook de kracht van iLogic kan gebruiken.
Dit document bevat alles wat u moet weten over het werken met iProperties in iLogic. Ik heb altijd moeite om het document online te vinden, dus heb ik het hier opgenomen: | ipropertiesandparameters.pdf |
Sub om te controleren of een custom property bestaat, bestaat hij niet, dan maken we hem aan. | CheckCustomProp |
iLogic (VB) die alle custom Inventor properties kopieert van tekening naar tekening | CopyCustomProp |
iLogic Script om alle iLogic te starten in onderliggende documenten | RunRule |
Check document type, en sub type. Creeer een plaatuitslag en maximale afmetingen van een Sheetmetal plaat. | SheetMetal |
iLogic (VB) functie om een waarde toe te voegen aan een Array en automatich te vergroten. | AddToArray |
iLogic (VB) Functions Filename en folder uit het complete pad te filteren. | Parse |
Bart Den Otter's iLogic script voor het verticaal en horizontaal uit te lijnen van views op een tekening | AlignView |
Sub om te controleren of een custom property bestaat, bestaat hij niet, dan maken we hem aan. | iPropertyFunction |
My VBA macro om het "Technical Requirements" dialog venster van de GOST standards in Inventor aan en uit te zetten. Mark Lancaster schreef een artikel in navolging van mijn post in Cadalyst magazine | Technical Requirements |
My iLogic script om sketches, werkvlakken, werkassen en werkpunten onzichtbaar te maken in het part zelf. | Object Visibility |
Soms wil je gewoon meer flexibiliteit in het laden van settings voor een iLogicscript | Load XML configuration |
Automatiseren van text groote bij het schakelen van tekening formaat (A3 naar A1 bijvoorbeeld). | Switch font size |
Dus je wil een knop op jouw Ribbon om een iLogic script te starten? | 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
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<
'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
'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
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