Search all derived parts inside an assembly, open each of them and do something and close again

Charlies_3D_T · ‎01-29-2021

Hello,

I am not able to get a working rule for the following:

I want to scan an assembly and all it's sub assemblies to see how many derived parts there are. After that i want to open eacht of them get a message with info and close the open one and open the next.

Can someon of you guys give me a hint or a beginning for this? Because i keep struggling and don't get it working.

Thank you!

bradeneuropeArthur · ‎01-29-2021

You mean?

If a part in an assembly contains a part that is deriving another part. You want to open it do something and close it?

Correct?

Do you need it recursive?

Regards,

Arthur Knoors

Autodesk Affiliations & Links:

Charlies_3D_T · ‎01-29-2021

Hello,

Yes i have some parts that are derived parts. And i want to find all the parts that are derived parts and open these parts and run a rul inside them and then close them and open the next if there are multiple inside the assembly.

I don't understand what you mean with recursive?

_dscholtes_ · ‎01-29-2021

Well, here's a part of VBA code of mine travelling through all occurrences of an assembly and all derived parts in each occurrence. Note: Occurrences is passed as an argument to the sub this code is in and the check for solid bodies is just added as reference.

Dim oOcc As ComponentOccurrence
Dim oOccCompDef As PartComponentDefinition
Dim oDerivPart As DerivedPartComponent

'Iterate through all the occurences
For Each oOcc In Occurrences

  'Set reference to componentdefinition of current occurrence
  Set oOccCompDef = oOcc.Definition

    'Go through all derived parts
    For Each oDerivPart In oOccCompDef.ReferenceComponents.DerivedPartComponents

    'Check for solid bodies
    If oDerivPart.SolidBodies.Count > 0 Then
      <do something>
    End If

  Next oDerivPart
Next oOcc

And if you want to get info from derived assemblies, here's another piece of VBA code. Note: Occurrences is passed as an argument to the sub this code is in and the name retrieval is just added as reference.

'Declarations
Dim oOcc As ComponentOccurrence
Dim oOccCompDef As PartComponentDefinition
Dim oDerivAss As DerivedAssemblyComponent
Dim oRefFeat As ReferenceFeature
Dim sRefFeatName As String

'Iterate through all the occurences
For Each oOcc In Occurrences

  'Set reference to componentdefinition of current occurrence
  Set oOccCompDef = oOcc.Definition

  'Go through all derived assemblies
  For Each oDerivAss In oOccCompDef.ReferenceComponents.DerivedAssemblyComponents

    'Go through all derived features
    For Each oRefFeat In oDerivAss.ReferenceFeatures

      'Check if there's a reference entity
      If Not oRefFeat.ReferencedEntity Is Nothing Then

        'Get the referenced entity name
        sRefFeatName = oRefFeat.ReferencedEntity.Name

        'Strip occurrence node index
        Dim t As Integer
        t = InStrRev(sRefFeatName, ":", , vbTextCompare)

        If t > 0 Then
          sRefFeatName = Left(sRefFeatName, t - 1)
        End If
      End If

    Next oRefFeat
  Next oDerivAss
Next oOcc

And if you need help travelling through an assembly by occurrences, here is a nice blogpost about it: https://modthemachine.typepad.com/my_weblog/2009/03/accessing-assembly-components.html

Charlies_3D_T · ‎01-29-2021

I get an error when i try this:

Can you see what i do wrong?

Sub Main()
	
Dim oDoc As Document
oDoc = ThisDoc.Document
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDoc.ComponentDefinition


'define the property set
Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

Try
    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
Catch
    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
End Try

If oCompDef.HasFlatPattern = False Then

oCompDef.Unfold
Events
iProperties.Value("Custom","Length") = (Round(SheetMetal.FlatExtentsLength,0))
iProperties.Value("Custom","Width") = (Round(SheetMetal.FlatExtentsWidth,0))
iProperties.Value("Custom", "Thickness") = Parameter("Thickness")
iProperties.Value("Custom", "Profile") = "SM " & (Round(SheetMetal.FlatExtentsLength,0)) & "x" & (Round(SheetMetal.FlatExtentsWidth,0)) & "x" & Parameter("Thickness")
'SheetMetal_Hole

Else
iProperties.Value("Custom","Length") = (Round(SheetMetal.FlatExtentsLength,0))
iProperties.Value("Custom","Width") = (Round(SheetMetal.FlatExtentsWidth,0))
iProperties.Value("Custom", "Thickness") = Parameter("Thickness")
iProperties.Value("Custom", "Profile") = "SM " & (Round(SheetMetal.FlatExtentsLength,0)) & "x" & (Round(SheetMetal.FlatExtentsWidth,0)) & "x" & Parameter("Thickness")
'SheetMetal_Hole

End If

Dim oOcc As ComponentOccurrence
Dim oOccCompDef As PartComponentDefinition
Dim oDerivPart As DerivedPartComponent

'Iterate through all the occurences
For Each oOcc In Occurrences

  'Set reference to componentdefinition of current occurrence
  oOccCompDef = oOcc.Definition

    'Go through all derived parts
    For Each oDerivPart In oOccCompDef.ReferenceComponents.DerivedPartComponents

    'Check for solid bodies
    If oDerivPart.SolidBodies.Count > 0 Then
      SheetMetal_Hole_Manueel
    End If

  Next oDerivPart
Next oOcc



End Sub

bradeneuropeArthur · ‎01-29-2021

Public Sub main()
Dim oActDoc As Inventor.Document
Set oActDoc = ThisApplication.ActiveDocument
Call ReplaceFile(oActDoc)
End Sub

Public Sub ReplaceFile(oActDoc As Inventor.Document)

        Dim oFD As FileDescriptor


Dim oDoc As Inventor.PartDocument

        For Each oDoc In oActDoc.AllReferencedDocuments
        
        If oDoc.DocumentType = kPartDocumentObject Then
        On Error Resume Next
        MsgBox oDoc.ReferencedDocumentDescriptors.Item(1).ReferencedDocumentType = kPartDocumentObject
ElseIf oDoc.DocumentType = kAssemblyDocumentObject Then
Call ReplaceFile(oDoc)
        End If
        
       
        Next
    End Sub

Regards,

Arthur Knoors

Autodesk Affiliations & Links:

Charlies_3D_T · ‎01-29-2021

I don't fully understand where i need to past the last part you shared with me.

_dscholtes_ · ‎01-29-2021

@Charlies_3D_T As I stated, the code is part of a function which uses arguments.

To get it working you need to change the following:

For Each oOcc In Occurrences

into

For Each oOcc In oCompDef.Occurrences

J-Camper · ‎01-29-2021

@Charlies_3D_T,

You need to separate the assembly loop from your document processing rule. It looks like you are doing stuff with Sheet metal parts too, so you need to verify SubType before you can set ComponentDefiniton. Try this approach:

Sub Main
	'External rule lockout to avoid errors running code in wrong document type
	If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then MessageBox.Show("This rule is designed to only work in assembly documents.", "Wrong Document Type") : Exit Sub
	'Define Assembly
	Dim AsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
	'Search All referenced Documents
	For Each RefDoc As Document In AsmDoc.AllReferencedDocuments
		'Only look at part documents
		If RefDoc.DocumentType = kPartDocumentObject
			'Only look at referenced documents that exist as occurrences in the assembly
			If AsmDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(RefDoc).Count > 0
				'Anything in here is a Part Document that exists in the open assembly
				Dim PartDoc As PartDocument = RefDoc
				'make sure document has derived parts
				If PartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Count > 0
					Logger.Debug("Derived Part Components in Part Document")
					'Process based on sub type if you have both sheet metal and normal parts
					If PartDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" 'Sheet metal sub type
						Call RunSMpart(PartDoc)
					Else 'Can be assumed to be normal part sub type
						Call RunNormalpart(PartDoc)
					End If
				End If
			End If
		End If
	Next
End Sub

Sub RunSMpart(SourceDoc As PartDocument)
	'Define Objects
	Dim pDoc As PartDocument = SourceDoc
	Dim pDef As SheetMetalComponentDefinition = pDoc.ComponentDefinition
	Logger.Debug("Defined Sheet Metal Part Document")
	
	MessageBox.Show("Do what you want for sheet metal parts", pDoc.DisplayName)
	
End Sub

Sub RunNormalpart(SourceDoc As PartDocument)
	'Define Objects
	Dim pDoc As PartDocument = SourceDoc
	Dim pDef As PartComponentDefinition = pDoc.ComponentDefinition
	Logger.Debug("Defined Normal Part Document")
	
	MessageBox.Show("Do what you want for normal parts", pDoc.DisplayName)
	
End Sub

You would need to fill in you other rule in the two sub routines. Let me know if you have any questions, or if it is not working as intended.

Charlies_3D_T · ‎01-29-2021

@J-Camper

I think my explination was not good.

I have the following situation:

1 have sm parts and i have sm parts that are derived parts from other sheet metal parts.

I have a rule inside these sm parts that search for threads and bends and that then fills in some custom properties.

If i have sheet metal parts that are derived these rules don't work because i can not see what is inside the master part. My solution was that when i have a derived part i ask the user to fill in the custom properties by hand.

But when i change an assembly where some sheet metals are inside and i save i get some errors. So i tried to call the part and open it but the rule is inside that part.

So it's not working like i was thinking. Is there an option to transfer the custom properties of some info from master part to the derived part? So that my normal sheet metal unfold rule and custom properties rule works also inside the derived sheet metal.

I hope the explaination is a bit better then my first question?

J-Camper · ‎01-29-2021

So, would this rule live in your template file for all new sheet metal parts? If so, I think this might give you what you need, or at least a starting point

This is written as a local rule that lives inside the Part Documents:

Sub Main
	'local sheet metal part rule.  No document typ checking	
	Dim oDoc As Document = ThisDoc.Document
	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	'define the property set
	Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

	Try
	    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
	Catch
	    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
	End Try
	
	'New Code:
	
	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Length", 20.5)
	PropList.Add("Width", 10.5)
	PropList.Add("Thickness", 1.5)
	PropList.Add("Profile", "Empty String")
	Logger.Debug("Setup NameValueMap")
	
	'Fill values based on whether or not there is a derived part	
	If oCompDef.ReferenceComponents.DerivedPartComponents.Count > 0
		Logger.Debug("DerivedPartComponents Count > 0")
		
		Dim ParentDef As SheetMetalComponentDefinition = Nothing
		For Each RefDoc As Document In oDoc.ReferencedDocuments
		
			Logger.Debug("DerivedPartComponent Loop")
			If RefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
			
				Logger.Debug("Derived Comp Is SM")
				ParentDef = RefDoc.ComponentDefinition
				Exit For
			End If
		Next
		
		'I'm exiting here. if you have sheet metal parts with derived parts that are not Sheet Metal, this would be an issue
		If IsNothing(ParentDef) Then MessageBox.Show("No Derived Part was a Sheet Metal Part", "Termination") : Exit Sub
		'Otherwise it will be fine
		
		'Fill Values from Parent Document
		If ParentDef.HasFlatPattern = True
			Logger.Debug("Parent HasFlatPattern")
			PropList.Value("Length") = (Round(ParentDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(ParentDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("Parent Not HasFlatPattern")
			PropList.Value("Length") = FindMax(ParentDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(ParentDef.RangeBox, "W") 
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	Else 'No Referenced Documents
	
		Logger.Debug("DerivedPartComponents Count <= 0")
		'Fill Values from open document
		If oCompDef.HasFlatPattern = True
			Logger.Debug("ThisDoc HasFlatPattern")
			PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("ThisDoc Not HasFlatPattern")
			PropList.Value("Length") = FindMax(oCompDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(oCompDef.RangeBox, "W") 
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	End If
	
	'Set iProperties
	Dim CustProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
End Sub

Function FindMax(aBox As Box, Selection As String) As Double
	Dim Result As Double = 0
	Dim DeltaX As Double = Round((aBox.MaxPoint.X - aBox.MinPoint.X),0)
	Dim DeltaY As Double = Round((aBox.MaxPoint.Y - aBox.MinPoint.Y),0)
	Dim DeltaZ As Double = Round((aBox.MaxPoint.Z - aBox.MinPoint.Z),0)
	
	If Selection = "L" 'Length is longest
		If DeltaX > DeltaY And DeltaX > DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY > DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ > DeltaY
			Result = DeltaZ
		End If
		
	Else If Selection = "W" 'Width is middle value
		If DeltaX > DeltaY And DeltaX < DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY < DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ < DeltaY
			Result = DeltaZ
		End If
	End If

	Return Result
End Function

Let me know if you have any questions, or if this is not working as intended.

Charlies_3D_T · ‎01-30-2021

@J-Camper

Hello,

Something is not working. I get the dimension of 20 in my parameters in my derived part. So it does not add the correct parent values. THis is what i have:

Sub Main
	'local sheet metal part rule.  No document typ checking	
	Dim oDoc As Document = ThisDoc.Document
	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	'define the property set
	Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

	Try
	    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
	Catch
	    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
	End Try
	
	'New Code:
	
	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Length", 20.5)
	PropList.Add("Width", 10.5)
	PropList.Add("Thickness", 1.5)
	PropList.Add("Profile", "Empty String")
	Logger.Debug("Setup NameValueMap")
	
	'Fill values based on whether or not there is a derived part	
	If oCompDef.ReferenceComponents.DerivedPartComponents.Count > 0
		Logger.Debug("DerivedPartComponents Count > 0")
		
		Dim ParentDef As SheetMetalComponentDefinition = Nothing
		For Each RefDoc As Document In oDoc.ReferencedDocuments
		
			Logger.Debug("DerivedPartComponent Loop")
			If RefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
			
				Logger.Debug("Derived Comp Is SM")
				ParentDef = RefDoc.ComponentDefinition
				Exit For
			End If
		Next
		
		'I'm exiting here. if you have sheet metal parts with derived parts that are not Sheet Metal, this would be an issue
		If IsNothing(ParentDef) Then MessageBox.Show("No Derived Part was a Sheet Metal Part", "Termination") : Exit Sub
		'Otherwise it will be fine
		
		'Fill Values from Parent Document
		If ParentDef.HasFlatPattern = True
			Logger.Debug("Parent HasFlatPattern")
			PropList.Value("Length") = (Round(ParentDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(ParentDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("Parent Not HasFlatPattern")
			PropList.Value("Length") = FindMax(ParentDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(ParentDef.RangeBox, "W") 
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	Else 'No Referenced Documents
	
		Logger.Debug("DerivedPartComponents Count <= 0")
		'Fill Values from open document
		If oCompDef.HasFlatPattern = True
			Logger.Debug("ThisDoc HasFlatPattern")
			SheetMetal_Hole
			PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("ThisDoc Not HasFlatPattern")
			oCompDef.Unfold
			Events
			SheetMetal_Hole
			PropList.Value("Length") = FindMax(oCompDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(oCompDef.RangeBox, "W") 
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	End If
	
	'Set iProperties
	Dim CustProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
End Sub

Function FindMax(aBox As Box, Selection As String) As Double
	Dim Result As Double = 0
	Dim DeltaX As Double = Round((aBox.MaxPoint.X - aBox.MinPoint.X),0)
	Dim DeltaY As Double = Round((aBox.MaxPoint.Y - aBox.MinPoint.Y),0)
	Dim DeltaZ As Double = Round((aBox.MaxPoint.Z - aBox.MinPoint.Z),0)
	
	If Selection = "L" 'Length is longest
		If DeltaX > DeltaY And DeltaX > DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY > DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ > DeltaY
			Result = DeltaZ
		End If
		
	Else If Selection = "W" 'Width is middle value
		If DeltaX > DeltaY And DeltaX < DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY < DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ < DeltaY
			Result = DeltaZ
		End If
	End If

	Return Result
End Function


Sub Events
	On Error Resume Next
	Dim EventPropSet As Inventor.PropertySet
	EventPropSet = GetiLogicEventPropSet(ThisApplication.ActiveDocument)
		
	' To make sure that the document has an iLogic DocumentInterest, add a temporary rule
	Dim tempRule = iLogicVb.Automation.AddRule(ThisDoc.Document, "TemporaryRule_392856A2", "")

	EventPropSet.Add("file://COS_FlatPattern", "PartBodyChanged", 1250)
	EventPropSet.Add("file://BendRadius", "BeforeDocSave1", 701)
	EventPropSet.Add("file://COS_Sheet_Metal_Unfol_Rule_Trumpf", "BeforeDocSave2", 702)
	iLogicVb.Automation.DeleteRule(ThisDoc.Document, tempRule.Name)

'After Open Document					: AfterDocOpen                 		: 400
'Close(Document)						: DocClose                     		: 500
'Before Save Document                   : BeforeDocSave           			: 700
'After Save Document               		: AfterDocSave               		: 800
'Any Model Parameter Change        		: AfterAnyParamChange   			: 1000
'Part Geometry Change**            		: PartBodyChanged         			: 1200
'Material Change**                  	: AfterMaterialChange     			: 1400
'Drawing View Change***               	: AfterDrawingViewsUpdate  			: 1500
'iProperty(Change)                  	: AfterAnyiPropertyChange           : 1600
'Feature Suppression Change**          	: AfterFeatureSuppressionChange   	: 2000
'Component Suppression Change*   		: AfterComponentSuppressionChange 	: 2200
'iPart / iAssembly Change Component* 	: AfterComponentReplace   			: 2400
'New Document                         	: AfterDocNew                  		: 2600

InventorVb.DocumentUpdate()
	

End Sub


Function GetiLogicEventPropSet(cDocument As Document) As Inventor.PropertySet
	On Error Resume Next
		iLogicEventPropSet = cDocument.PropertySets.Item("iLogicEventsRules")
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Item("_iLogicEventsRules")
		End If
		
		If iLogicEventPropSet.InternalName <> "{2C540830-0723-455E-A8E2-891722EB4C3E}" Then
			Call iLogicEventPropSet.Delete
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			MsgBox ("Unable to create the Event Triggers property for this file!", , "Event Triggers Not Set")
			Err.Raise(1)
			Exit Function
		End If
	On Error GoTo 0
	
	Return iLogicEventPropSet
End Function


Sub SheetMetal_Hole

Dim Feature As PartFeature
Dim Features As PartFeatures

Features = ThisDoc.Document.ComponentDefinition.Features

i = 0
j = 0
k = 0
l = 0

For Each Feature In Features
	'check if its a hole
	If TypeOf Feature Is ExtrudeFeature And Feature.Suppressed = False And Feature.Name.Contains("Chamfer") Then
		'increment one
		i = i + 1
	End If	
Next

For Each hole_cb As HoleFeature In Features.HoleFeatures
	If hole_cb.HoleType = HoleTypeEnum.kCounterSinkHole
'    Dim info_cb As HoleInfo = hole_cb.Info
 '   If (info_cb IsNot Nothing) Then
       j = j + 1
 '       ' Your hole changing code go's here
    End If
Next
 

For Each hole_tap As HoleFeature In Features.HoleFeatures
 '   Dim info_tap As HoleTapInfo = hole_tap.TapInfo
If hole_tap.Tapped = True Then
        k = k + 1
        ' Your hole changing code go's here
    End If
Next

For Each Feature In Features
	'check if its a hole
	'TypeOf Feature Is ExtrudeFeature
	If Feature.Suppressed = False And Feature.Name.Contains("Flange") Then
		'increment one
		l = l + 1
	End If
	
	If Feature.Suppressed = False And Feature.Name.Contains("Contour Flange") Then
		'increment one
		l = l + 1
	End If		
		
Next


' Get the active part document.
Dim invPartDoc As PartDocument = ThisDoc.Document
        'Get the custom property set.
Dim invCustomPropertySet As PropertySet = invPartDoc.PropertySets.Item("Inventor User Defined Properties")

'MessageBox.Show(i, "i")
'MessageBox.Show(j, "j")
'MessageBox.Show(k, "k")
'MessageBox.Show(l, "l")


If i = 0 And j = 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = ""
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j = 0 And k = 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	


If i > 0 And j > 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j > 0 And k = 0 And l >  0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If	

If i = 0 And j > 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j > 0 And k = 0 And l >  0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j = 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Chamfer"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i > 0 And j = 0 And k = 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j = 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If

If i > 0 And j = 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If

If i = 0 And j = 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j = 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j > 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i = 0 And j > 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Tapping"
End If	

End Sub

Charlies_3D_T · ‎01-30-2021

@JCamper

Hello,

I also added the unfold part with the derived part but it does not unfold my part. Thank you for the help with this one!

Sub Main
	'local sheet metal part rule.  No document typ checking	
	Dim oDoc As Document = ThisDoc.Document
	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	'define the property set
	Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

	Try
	    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
	Catch
	    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
	End Try
	
	'New Code:
	
	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Length", 20.5)
	PropList.Add("Width", 10.5)
	PropList.Add("Thickness", 1.5)
	PropList.Add("Profile", "Empty String")
	Logger.Debug("Setup NameValueMap")
	
	'Fill values based on whether or not there is a derived part	
	If oCompDef.ReferenceComponents.DerivedPartComponents.Count > 0
		Logger.Debug("DerivedPartComponents Count > 0")
		
		Dim ParentDef As SheetMetalComponentDefinition = Nothing
		For Each RefDoc As Document In oDoc.ReferencedDocuments
		
			Logger.Debug("DerivedPartComponent Loop")
			If RefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
			
				Logger.Debug("Derived Comp Is SM")
				ParentDef = RefDoc.ComponentDefinition
				Exit For
			End If
		Next
		
		'I'm exiting here. if you have sheet metal parts with derived parts that are not Sheet Metal, this would be an issue
		If IsNothing(ParentDef) Then MessageBox.Show("No Derived Part was a Sheet Metal Part", "Termination") : Exit Sub
		'Otherwise it will be fine
		
		'Fill Values from Parent Document
		If ParentDef.HasFlatPattern = True
			Logger.Debug("Parent HasFlatPattern")
			PropList.Value("Length") = (Round(ParentDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(ParentDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("Parent Not HasFlatPattern")
			oCompDef.Unfold
			Events
			SheetMetal_Hole
			PropList.Value("Length") = FindMax(ParentDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(ParentDef.RangeBox, "W") 
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	Else 'No Referenced Documents
	
		Logger.Debug("DerivedPartComponents Count <= 0")
		'Fill Values from open document
		If oCompDef.HasFlatPattern = True
			Logger.Debug("ThisDoc HasFlatPattern")
			SheetMetal_Hole
			PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		Else
			Logger.Debug("ThisDoc Not HasFlatPattern")
			oCompDef.Unfold
			Events
			SheetMetal_Hole
			PropList.Value("Length") = FindMax(oCompDef.RangeBox, "L") 
			PropList.Value("Width") = FindMax(oCompDef.RangeBox, "W") 
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		End If
	End If
	
	'Set iProperties
	Dim CustProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
End Sub

Function FindMax(aBox As Box, Selection As String) As Double
	Dim Result As Double = 0
	Dim DeltaX As Double = Round((aBox.MaxPoint.X - aBox.MinPoint.X),0)
	Dim DeltaY As Double = Round((aBox.MaxPoint.Y - aBox.MinPoint.Y),0)
	Dim DeltaZ As Double = Round((aBox.MaxPoint.Z - aBox.MinPoint.Z),0)
	
	If Selection = "L" 'Length is longest
		If DeltaX > DeltaY And DeltaX > DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY > DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ > DeltaY
			Result = DeltaZ
		End If
		
	Else If Selection = "W" 'Width is middle value
		If DeltaX > DeltaY And DeltaX < DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY < DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ < DeltaY
			Result = DeltaZ
		End If
	End If

	Return Result
End Function


Sub Events
	On Error Resume Next
	Dim EventPropSet As Inventor.PropertySet
	EventPropSet = GetiLogicEventPropSet(ThisApplication.ActiveDocument)
		
	' To make sure that the document has an iLogic DocumentInterest, add a temporary rule
	Dim tempRule = iLogicVb.Automation.AddRule(ThisDoc.Document, "TemporaryRule_392856A2", "")

	EventPropSet.Add("file://COS_FlatPattern", "PartBodyChanged", 1250)
	EventPropSet.Add("file://BendRadius", "BeforeDocSave1", 701)
	EventPropSet.Add("file://COS_Sheet_Metal_Unfol_Rule_Trumpf", "BeforeDocSave2", 702)
	iLogicVb.Automation.DeleteRule(ThisDoc.Document, tempRule.Name)

'After Open Document					: AfterDocOpen                 		: 400
'Close(Document)						: DocClose                     		: 500
'Before Save Document                   : BeforeDocSave           			: 700
'After Save Document               		: AfterDocSave               		: 800
'Any Model Parameter Change        		: AfterAnyParamChange   			: 1000
'Part Geometry Change**            		: PartBodyChanged         			: 1200
'Material Change**                  	: AfterMaterialChange     			: 1400
'Drawing View Change***               	: AfterDrawingViewsUpdate  			: 1500
'iProperty(Change)                  	: AfterAnyiPropertyChange           : 1600
'Feature Suppression Change**          	: AfterFeatureSuppressionChange   	: 2000
'Component Suppression Change*   		: AfterComponentSuppressionChange 	: 2200
'iPart / iAssembly Change Component* 	: AfterComponentReplace   			: 2400
'New Document                         	: AfterDocNew                  		: 2600

InventorVb.DocumentUpdate()
	

End Sub


Function GetiLogicEventPropSet(cDocument As Document) As Inventor.PropertySet
	On Error Resume Next
		iLogicEventPropSet = cDocument.PropertySets.Item("iLogicEventsRules")
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Item("_iLogicEventsRules")
		End If
		
		If iLogicEventPropSet.InternalName <> "{2C540830-0723-455E-A8E2-891722EB4C3E}" Then
			Call iLogicEventPropSet.Delete
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			MsgBox ("Unable to create the Event Triggers property for this file!", , "Event Triggers Not Set")
			Err.Raise(1)
			Exit Function
		End If
	On Error GoTo 0
	
	Return iLogicEventPropSet
End Function


Sub SheetMetal_Hole

Dim Feature As PartFeature
Dim Features As PartFeatures

Features = ThisDoc.Document.ComponentDefinition.Features

i = 0
j = 0
k = 0
l = 0

For Each Feature In Features
	'check if its a hole
	If TypeOf Feature Is ExtrudeFeature And Feature.Suppressed = False And Feature.Name.Contains("Chamfer") Then
		'increment one
		i = i + 1
	End If	
Next

For Each hole_cb As HoleFeature In Features.HoleFeatures
	If hole_cb.HoleType = HoleTypeEnum.kCounterSinkHole
'    Dim info_cb As HoleInfo = hole_cb.Info
 '   If (info_cb IsNot Nothing) Then
       j = j + 1
 '       ' Your hole changing code go's here
    End If
Next
 

For Each hole_tap As HoleFeature In Features.HoleFeatures
 '   Dim info_tap As HoleTapInfo = hole_tap.TapInfo
If hole_tap.Tapped = True Then
        k = k + 1
        ' Your hole changing code go's here
    End If
Next

For Each Feature In Features
	'check if its a hole
	'TypeOf Feature Is ExtrudeFeature
	If Feature.Suppressed = False And Feature.Name.Contains("Flange") Then
		'increment one
		l = l + 1
	End If
	
	If Feature.Suppressed = False And Feature.Name.Contains("Contour Flange") Then
		'increment one
		l = l + 1
	End If		
		
Next


' Get the active part document.
Dim invPartDoc As PartDocument = ThisDoc.Document
        'Get the custom property set.
Dim invCustomPropertySet As PropertySet = invPartDoc.PropertySets.Item("Inventor User Defined Properties")

'MessageBox.Show(i, "i")
'MessageBox.Show(j, "j")
'MessageBox.Show(k, "k")
'MessageBox.Show(l, "l")


If i = 0 And j = 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = ""
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j = 0 And k = 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	


If i > 0 And j > 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j > 0 And k = 0 And l >  0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If	

If i = 0 And j > 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j > 0 And k = 0 And l >  0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j = 0 And k = 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Chamfer"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i > 0 And j = 0 And k = 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i > 0 And j = 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If

If i > 0 And j = 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If

If i = 0 And j = 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j = 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = 0 And j > 0 And k > 0 And l = 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i = 0 And j > 0 And k > 0 And l > 0 Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Tapping"
End If	

End Sub


Sub SheetMetal_Hole_Manueel

Dim Feature As PartFeature
Dim Features As PartFeatures

'Features = Doc.Document.ComponentDefinition.Features

i = False
j = False
k = False
l = False

'Dim oDoc As Document
'oDoc = ThisDoc.Document
'docName0 = oDoc.FullFileName

'ThisApplication.CommandManager.ControlDefinitions.Item("AppZoomallCmd").Execut

'MessageBox.Show(docName0, "We will change the following part:")
i = InputRadioBox("Does the part has chamfered edges?", "Yes", "No", booleanParam, Title := "Chamfer")
j = InputRadioBox("Does the part has countersink holes?", "Yes", "No", booleanParam, Title := "Countersink")
k = InputRadioBox("Does the part has threaded holes?", "Yes", "No", booleanParam, Title := "Thread")
l = InputRadioBox("Does the part has bends?", "Yes", "No", booleanParam, Title := "Bends")

' Get the active part document.
Dim invPartDoc As PartDocument = ThisDoc.Document
        'Get the custom property set.
Dim invCustomPropertySet As PropertySet = invPartDoc.PropertySets.Item("Inventor User Defined Properties")

'MessageBox.Show(i, "i")
'MessageBox.Show(j, "j")
'MessageBox.Show(k, "k")
'MessageBox.Show(l, "l")


If i = False And j = False And k = False And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = ""
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = False And j = False And k = False And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	


If i > 0 And j = True And k = False And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = True And j = True And k = False And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If	

If i = False And j = True And k = False And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = False And j = True And k = False And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = True And j = False And k = False And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Chamfer"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i = True And j = False And k = False And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = True And j = False And k = True And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = "Chamfer"
	iProperties.Value("Custom", "Operation_4") = ""
End If

If i = True And j = False And k = True And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = "Chamfer"
End If

If i = False And j = False And k = True And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Tapping"
	iProperties.Value("Custom", "Operation_3") = ""
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = False And j = False And k = True And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If	

If i = False And j = True And k = True And l = False Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Countersink"
	iProperties.Value("Custom", "Operation_3") = "Tapping"
	iProperties.Value("Custom", "Operation_4") = ""
End If 

If i = False And j = True And k = True And l = True Then
	iProperties.Value("Custom", "Operation_1") = "Laser cutting"
	iProperties.Value("Custom", "Operation_2") = "Bending"
	iProperties.Value("Custom", "Operation_3") = "Countersink"
	iProperties.Value("Custom", "Operation_4") = "Tapping"
End If	

End Sub

J-Camper · ‎01-30-2021

@Charlies_3D_T,

I didn't realize at first that you wanted to create the flat pattern if none existed. That's why I added the range box Function. I believe I have the Unfold integrated into the derived part portion. Unfortunately the Parent document must be opened visibly in order to Unfold, but it appears to be working now, in my small sample parts. I had to re-work the SheetMetal_Holes Sub in order to work with both Open document and Parent document when needed.

One thing I can't check are the 3 external rules you are creating Event Triggers for. I can't verify they will work with both original and derived SheetMetal Parts. If those are causing issues with derived parts too, I'll be happy to take a look at them.

New Code: [I'm not using the FindMax Function anymore, but I have left it in at the bottom]

Sub Main
	'local sheet metal part rule.  No document typ checking	
	Dim oDoc As Document = ThisDoc.Document
	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	'define the property set
	Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

	Try
	    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
	Catch
	    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
	End Try
	
	'New Code
	
	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Length", 20.5)
	PropList.Add("Width", 10.5)
	PropList.Add("Thickness", 1.5)
	PropList.Add("Profile", "Empty String")
	Logger.Debug("Setup NameValueMap 1")
	'Fill values based on whether or not there is a derived part	
	If oCompDef.ReferenceComponents.DerivedPartComponents.Count > 0
		Logger.Debug("DerivedPartComponents Count > 0")
		Dim ParentDef As SheetMetalComponentDefinition = Nothing
		For Each RefDoc As Document In oDoc.ReferencedDocuments
			Logger.Debug("DerivedPartComponent Loop")
			If RefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
				Logger.Debug("Derived Comp Is SM")
				ParentDef = RefDoc.ComponentDefinition
				Exit For
			End If
		Next
		
		'I'm exiting here. if you have sheet metal parts with derived parts that are not Sheet Metal, this would be an issue
		If IsNothing(ParentDef) Then MessageBox.Show("No Derived Part was a Sheet Metal Part", "Termination") : Exit Sub
		'Otherwise it will be fine
		
		'Fill Values from Parent Document
		If ParentDef.HasFlatPattern = True
			Logger.Debug("HasFlatPattern")
			PropList.Value("Length") = (Round(ParentDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(ParentDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
			Logger.Debug("Parent-existing FlatPattern Values: " & PropList.Value("Profile"))
			
			Call SheetMetal_Hole(ParentDef.Document, oDoc)
			Logger.Debug("Completed SheetMetal_Hole")
		Else
			Logger.Debug("Not HasFlatPattern")
			
			'Open parent document to create flat pattern.  It seems it must be open Visilby inorder to successfully unfold
			Dim ParentDoc As PartDocument = ThisApplication.Documents.Open(ParentDef.Document.FullDocumentName, True)
			Logger.Debug("Parent is visibly open")
			ParentDoc.ComponentDefinition.Unfold
			Logger.Debug("Parent is Unfolded")
			ParentDoc.Update
			Logger.Debug("Parent is Updated")
			ParentDoc.Save
			Logger.Debug("Parent is Saved")
			ParentDoc.Close
			
			Logger.Debug("Created Flat Pattern in Parent")
			
			PropList.Value("Length") = (Round(ParentDef.FlatPattern.Length,0))'FindMax(ParentDef.RangeBox, "L") 
			PropList.Value("Width") = (Round(ParentDef.FlatPattern.Width, 0))'FindMax(ParentDef.RangeBox, "W") 
			PropList.Value("Thickness") = ParentDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
			Logger.Debug("Parent-New FlatPattern Values: " & PropList.Value("Profile"))
			
			Call SheetMetal_Hole(ParentDef.Document, oDoc)
			Logger.Debug("Completed SheetMetal_Hole")
			
		End If
	Else
		Logger.Debug("DerivedPartComponents Count <= 0")
		'Fill Values from open document
		If oCompDef.HasFlatPattern = True
			Logger.Debug("HasFlatPattern")
			PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0)) 
			PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
			Logger.Debug("local-existing FlatPattern Values: " & PropList.Value("Profile"))
			
			Call SheetMetal_Hole(oDoc, oDoc)
			Logger.Debug("Completed SheetMetal_Hole")
			
		Else
			Logger.Debug("Not HasFlatPattern")
			
			oCompDef.Unfold
			Logger.Debug("Open Part is Unfolded")
			oDoc.Update
			Logger.Debug("Open Part is Updated")
			oDoc.Save
			Logger.Debug("Open Part is Saved")
			
			PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0))'FindMax(oCompDef.RangeBox, "L") 
			PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))'FindMax(oCompDef.RangeBox, "W") 
			PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
			PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
			Logger.Debug("local-new FlatPattern Values: " & PropList.Value("Profile"))
			
			Call SheetMetal_Hole(oDoc, oDoc)
			Logger.Debug("Completed SheetMetal_Hole")
			
		End If
	End If
	
	'Set iProperties
	Dim CustProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
	Call Events
		
End Sub

Sub Events
	On Error Resume Next
	Dim EventPropSet As Inventor.PropertySet
	EventPropSet = GetiLogicEventPropSet(ThisApplication.ActiveDocument)
		
	' To make sure that the document has an iLogic DocumentInterest, add a temporary rule
	Dim tempRule = iLogicVb.Automation.AddRule(ThisDoc.Document, "TemporaryRule_392856A2", "")

	EventPropSet.Add("file://COS_FlatPattern", "PartBodyChanged", 1250)
	EventPropSet.Add("file://BendRadius", "BeforeDocSave1", 701)
	EventPropSet.Add("file://COS_Sheet_Metal_Unfol_Rule_Trumpf", "BeforeDocSave2", 702)
	iLogicVb.Automation.DeleteRule(ThisDoc.Document, tempRule.Name)

'After Open Document					: AfterDocOpen                 		: 400
'Close(Document)						: DocClose                     		: 500
'Before Save Document                   : BeforeDocSave           			: 700
'After Save Document               		: AfterDocSave               		: 800
'Any Model Parameter Change        		: AfterAnyParamChange   			: 1000
'Part Geometry Change**            		: PartBodyChanged         			: 1200
'Material Change**                  	: AfterMaterialChange     			: 1400
'Drawing View Change***               	: AfterDrawingViewsUpdate  			: 1500
'iProperty(Change)                  	: AfterAnyiPropertyChange           : 1600
'Feature Suppression Change**          	: AfterFeatureSuppressionChange   	: 2000
'Component Suppression Change*   		: AfterComponentSuppressionChange 	: 2200
'iPart / iAssembly Change Component* 	: AfterComponentReplace   			: 2400
'New Document                         	: AfterDocNew                  		: 2600

InventorVb.DocumentUpdate()
	

End Sub

Function GetiLogicEventPropSet(cDocument As Document) As Inventor.PropertySet
	On Error Resume Next
		iLogicEventPropSet = cDocument.PropertySets.Item("iLogicEventsRules")
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Item("_iLogicEventsRules")
		End If
		
		If iLogicEventPropSet.InternalName <> "{2C540830-0723-455E-A8E2-891722EB4C3E}" Then
			Call iLogicEventPropSet.Delete
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			MsgBox ("Unable to create the Event Triggers property for this file!", , "Event Triggers Not Set")
			Err.Raise(1)
			Exit Function
		End If
	On Error GoTo 0
	
	Return iLogicEventPropSet
End Function

Sub SheetMetal_Hole(ValuesDoc As PartDocument, OpenDoc As PartDocument)

	Dim Feature As PartFeature
	Dim Features As PartFeatures

	Features = ValuesDoc.ComponentDefinition.Features

	i = 0
	j = 0
	k = 0
	l = 0

	For Each Feature In Features
		'check if its a hole
		If TypeOf Feature Is ExtrudeFeature And Feature.Suppressed = False And Feature.Name.Contains("Chamfer") Then
			'increment one
			i = i + 1
		End If	
	Next

	For Each hole_cb As HoleFeature In Features.HoleFeatures
		If hole_cb.HoleType = HoleTypeEnum.kCounterSinkHole
	'    Dim info_cb As HoleInfo = hole_cb.Info
	 '   If (info_cb IsNot Nothing) Then
	       j = j + 1
	 '       ' Your hole changing code go's here
	    End If
	Next
	 

	For Each hole_tap As HoleFeature In Features.HoleFeatures
	 '   Dim info_tap As HoleTapInfo = hole_tap.TapInfo
	If hole_tap.Tapped = True Then
	        k = k + 1
	        ' Your hole changing code go's here
	    End If
	Next

	For Each Feature In Features
		'check if its a hole
		'TypeOf Feature Is ExtrudeFeature
		If Feature.Suppressed = False And Feature.Name.Contains("Flange") Then
			'increment one
			l = l + 1
		End If
		
		If Feature.Suppressed = False And Feature.Name.Contains("Contour Flange") Then
			'increment one
			l = l + 1
		End If		
			
	Next

	Logger.Debug("i="& i &"  j=" & j & "  k=" & k & "  l=" & l)

	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Operation_1", "")
	PropList.Add("Operation_2", "")
	PropList.Add("Operation_3", "")
	PropList.Add("Operation_4", "")
	Logger.Debug("Setup NameValueMap 2")


	If i = 0 And j = 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = ""
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j = 0 And k = 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j > 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j > 0 And k = 0 And l >  0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = "Chamfer"
	Else If i = 0 And j > 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k = 0 And l >  0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Chamfer"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k = 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Tapping"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = "Chamfer"
	Else If i = 0 And j = 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Tapping"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j = 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = "Tapping"
	End If	
	
	Logger.Debug("PropsList in SheetMetal_Hole is set")
	
	'Set iProperties
	Dim CustProps As PropertySet = OpenDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
End Sub

Function FindMax(aBox As Box, Selection As String) As Double
	Dim Result As Double = 0
	Dim DeltaX As Double = Round((aBox.MaxPoint.X - aBox.MinPoint.X),0)
	Dim DeltaY As Double = Round((aBox.MaxPoint.Y - aBox.MinPoint.Y),0)
	Dim DeltaZ As Double = Round((aBox.MaxPoint.Z - aBox.MinPoint.Z),0)
	
	If Selection = "L" 'Length is longest
		If DeltaX > DeltaY And DeltaX > DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY > DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ > DeltaY
			Result = DeltaZ
		End If
	Else If Selection = "W" 'Width is middle value
		If DeltaX > DeltaY And DeltaX < DeltaZ
			Result = DeltaX
		Else If DeltaY > DeltaX And DeltaY < DeltaZ
			Result = DeltaY
		Else If DeltaZ > DeltaX And DeltaZ < DeltaY
			Result = DeltaZ
		End If
	End If

	Return Result
End Function

Let me know if you are still having issues. If it is still not working properly, it would help to have a copy of the files which are causing errors, so I can address them first hand. Also running the rule in Log Level: Debug will print all the debug lines to the iLogic Log which would help determine where you might be getting errors.

DO NOT POST CONFIDENTIAL DOCUMENTS

Charlies_3D_T · ‎01-30-2021

Hello,

No i still don't get an unfold on my derived part...

The flat pattern rule is the one you adjusted. I want it to be past in the partbodychange for when i change something the parameters are updated.

The rest works. So i hope you can see whats wrong with the rule with the 2 files in attachment.

J-Camper · ‎01-30-2021

@Charlies_3D_T,

Oh, my misunderstanding again. I was checking the derived part parent document for flat pattern and creating it in the parent if it didn't exist. You just need the Derived part parent for the "SheetMetal_Hole" sub routine, to check features. You still want to use the Derived part to get the flat pattern extents from, correct?

Let me see what i need to change.

J-Camper · ‎01-30-2021

@Charlies_3D_T,

I think this is it, it is now creating the flat pattern in the open document regardless of if it was derived or not:

Sub Main
	'local sheet metal part rule.  No document type or subtype checking checking	
	Dim oDoc As Document = ThisDoc.Document
	Dim oCompDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

	'define the property set
	Dim userParams As UserParameters = oDoc.ComponentDefinition.Parameters.UserParameters

	Try
	    BendRadius_Parm = oDoc.ComponentDefinition.Parameters("BendRadius_Ilogic")
	Catch
	    Dim newParam As UserParameter = userParams.AddByExpression("BendRadius_Ilogic", 1, "mm")
	End Try
	
	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Length", 20.5)
	PropList.Add("Width", 10.5)
	PropList.Add("Thickness", 1.5)
	PropList.Add("Profile", "Empty String")
	Logger.Debug("Setup NameValueMap 1")
	
	'Fill values based on whether or not there is a derived part
	If oCompDef.HasFlatPattern = True
		
		Logger.Debug("HasFlatPattern")
		
		PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length,0)) 
		PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))
		PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
		PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		
		Logger.Debug("existing FlatPattern Values: " & PropList.Value("Profile"))
		
	Else
		Logger.Debug("Not HasFlatPattern")
		
		oCompDef.Unfold
		Logger.Debug("Open Part is Unfolded")
		oDoc.Update
		Logger.Debug("Open Part is Updated")
		oDoc.Save
		Logger.Debug("Open Part is Saved")
		
		PropList.Value("Length") = (Round(oCompDef.FlatPattern.Length, 0))'FindMax(oCompDef.RangeBox, "L") 
		PropList.Value("Width") = (Round(oCompDef.FlatPattern.Width, 0))'FindMax(oCompDef.RangeBox, "W") 
		PropList.Value("Thickness") = oCompDef.Parameters("Thickness").Value
		PropList.Value("Profile") = "SM " & PropList.Value("Length") & "x" & PropList.Value("Width") & "x" & PropList.Value("Thickness")
		
		Logger.Debug("local-new FlatPattern Values: " & PropList.Value("Profile"))
	
	End If
	
	'Set iProperties
	Dim CustProps As PropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
	'Check for derived part parent to get features
	If oCompDef.ReferenceComponents.DerivedPartComponents.Count > 0
		Logger.Debug("DerivedPartComponents Count > 0")
		
		Dim ParentDef As SheetMetalComponentDefinition = Nothing
		
		For Each RefDoc As Document In oDoc.ReferencedDocuments
			Logger.Debug("DerivedPartComponent Loop")
			If RefDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
				Logger.Debug("Derived Comp Is SM")
				ParentDef = RefDoc.ComponentDefinition
				Exit For
			End If
		Next
		
		'I'm exiting here. if you have sheet metal parts with derived parts that are not Sheet Metal, this would be an issue
		If IsNothing(ParentDef) Then Logger.Debug("No Derived Part was a Sheet Metal Part") : Exit Sub
		'Otherwise it will be fine
		
		Call SheetMetal_Hole(ParentDef.Document, oDoc)
		
		Logger.Debug("Completed SheetMetal_Hole on parent document")

Else
		Logger.Debug("DerivedPartComponents Count <= 0")
		
		Call SheetMetal_Hole(oDoc, oDoc)
		
		Logger.Debug("Completed SheetMetal_Hole on open document")
			
	End If
	
	Call Events
		
End Sub

Sub Events
	On Error Resume Next
	Dim EventPropSet As Inventor.PropertySet
	EventPropSet = GetiLogicEventPropSet(ThisApplication.ActiveDocument)
		
	' To make sure that the document has an iLogic DocumentInterest, add a temporary rule
	Dim tempRule = iLogicVb.Automation.AddRule(ThisDoc.Document, "TemporaryRule_392856A2", "")

	EventPropSet.Add("file://COS_FlatPattern", "PartBodyChanged", 1250)
	EventPropSet.Add("file://BendRadius", "BeforeDocSave1", 701)
	EventPropSet.Add("file://COS_Sheet_Metal_Unfol_Rule_Trumpf", "BeforeDocSave2", 702)
	iLogicVb.Automation.DeleteRule(ThisDoc.Document, tempRule.Name)

'After Open Document					: AfterDocOpen                 		: 400
'Close(Document)						: DocClose                     		: 500
'Before Save Document                   : BeforeDocSave           			: 700
'After Save Document               		: AfterDocSave               		: 800
'Any Model Parameter Change        		: AfterAnyParamChange   			: 1000
'Part Geometry Change**            		: PartBodyChanged         			: 1200
'Material Change**                  	: AfterMaterialChange     			: 1400
'Drawing View Change***               	: AfterDrawingViewsUpdate  			: 1500
'iProperty(Change)                  	: AfterAnyiPropertyChange           : 1600
'Feature Suppression Change**          	: AfterFeatureSuppressionChange   	: 2000
'Component Suppression Change*   		: AfterComponentSuppressionChange 	: 2200
'iPart / iAssembly Change Component* 	: AfterComponentReplace   			: 2400
'New Document                         	: AfterDocNew                  		: 2600

InventorVb.DocumentUpdate()
	

End Sub

Function GetiLogicEventPropSet(cDocument As Document) As Inventor.PropertySet
	On Error Resume Next
		iLogicEventPropSet = cDocument.PropertySets.Item("iLogicEventsRules")
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Item("_iLogicEventsRules")
		End If
		
		If iLogicEventPropSet.InternalName <> "{2C540830-0723-455E-A8E2-891722EB4C3E}" Then
			Call iLogicEventPropSet.Delete
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			iLogicEventPropSet = cDocument.PropertySets.Add("iLogicEventsRules", "{2C540830-0723-455E-A8E2-891722EB4C3E}")
		End If
		
		If iLogicEventPropSet Is Nothing Then
			MsgBox ("Unable to create the Event Triggers property for this file!", , "Event Triggers Not Set")
			Err.Raise(1)
			Exit Function
		End If
	On Error GoTo 0
	
	Return iLogicEventPropSet
End Function

Sub SheetMetal_Hole(ValuesDoc As PartDocument, OpenDoc As PartDocument)

	Dim Feature As PartFeature
	Dim Features As PartFeatures

	Features = ValuesDoc.ComponentDefinition.Features

	i = 0
	j = 0
	k = 0
	l = 0

	For Each Feature In Features
		'check if its a hole
		If TypeOf Feature Is ExtrudeFeature And Feature.Suppressed = False And Feature.Name.Contains("Chamfer") Then
			'increment one
			i = i + 1
		End If	
	Next

	For Each hole_cb As HoleFeature In Features.HoleFeatures
		If hole_cb.HoleType = HoleTypeEnum.kCounterSinkHole
	'    Dim info_cb As HoleInfo = hole_cb.Info
	 '   If (info_cb IsNot Nothing) Then
	       j = j + 1
	 '       ' Your hole changing code go's here
	    End If
	Next
	 

	For Each hole_tap As HoleFeature In Features.HoleFeatures
	 '   Dim info_tap As HoleTapInfo = hole_tap.TapInfo
	If hole_tap.Tapped = True Then
	        k = k + 1
	        ' Your hole changing code go's here
	    End If
	Next

	For Each Feature In Features
		'check if its a hole
		'TypeOf Feature Is ExtrudeFeature
		If Feature.Suppressed = False And Feature.Name.Contains("Flange") Then
			'increment one
			l = l + 1
		End If
		
		If Feature.Suppressed = False And Feature.Name.Contains("Contour Flange") Then
			'increment one
			l = l + 1
		End If		
			
	Next

	Logger.Debug("i="& i &"  j=" & j & "  k=" & k & "  l=" & l)

	'Set Object to collect values to names
	Dim PropList As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	PropList.Add("Operation_1", "")
	PropList.Add("Operation_2", "")
	PropList.Add("Operation_3", "")
	PropList.Add("Operation_4", "")
	Logger.Debug("Setup NameValueMap 2")


	If i = 0 And j = 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = ""
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j = 0 And k = 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j > 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j > 0 And k = 0 And l >  0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = "Chamfer"
	Else If i = 0 And j > 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k = 0 And l >  0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k = 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Chamfer"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k = 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Tapping"
		PropList.Value(PropList.Name(3)) = "Chamfer"
		PropList.Value(PropList.Name(4)) = ""
	Else If i > 0 And j = 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = "Chamfer"
	Else If i = 0 And j = 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Tapping"
		PropList.Value(PropList.Name(3)) = ""
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j = 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k > 0 And l = 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Countersink"
		PropList.Value(PropList.Name(3)) = "Tapping"
		PropList.Value(PropList.Name(4)) = ""
	Else If i = 0 And j > 0 And k > 0 And l > 0 Then
		PropList.Value(PropList.Name(1)) = "Laser cutting"
		PropList.Value(PropList.Name(2)) = "Bending"
		PropList.Value(PropList.Name(3)) = "Countersink"
		PropList.Value(PropList.Name(4)) = "Tapping"
	End If	
	
	Logger.Debug("PropsList in SheetMetal_Hole is set")
	
	'Set iProperties
	Dim CustProps As PropertySet = OpenDoc.PropertySets.Item("Inventor User Defined Properties")
	
	For i = 1 To PropList.Count
		Try 
			CustProps.Item(PropList.Name(i)).Expression = PropList.Value(PropList.Name(i))
		Catch
			CustProps.Add(PropList.Value(PropList.Name(i)), PropList.Name(i))
		End Try
	Next
	
End Sub

Let me know, if it is still not working as expected

Charlies_3D_T · ‎01-30-2021

In the open document? If i press save in an assembly when the parts are
updated then the rule also will run?

J-Camper · ‎01-30-2021

@Charlies_3D_T,

I'm not sure you want to set this rule to an event trigger for "BeforeSave" because we have to save the document after creating the flat pattern and making iProperty changes. I tried this and got save errors because the documents were activating the rule mid rule when saving the new flat patterns

What you can do with the modified code attached to this post, is call the rule to run from your assembly when ever you want them to update [This rule can be saved as an external rule or locally in your assembly level]:

Sub Main
	
	If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then Logger.Debug("Wrong Document Type: This rule is designed to only work in assembly documents.") : Exit Sub
	
	For Each co As ComponentOccurrence In ThisApplication.ActiveDocument.ComponentDefinition.Occurrences.AllLeafOccurrences
		Try
			iLogicVb.RunRule(co.Name, "Your SheetMetal iLogic Rule Name")
		Catch
		End Try
	Next

End Sub

The main change in the new modified code is this extra level of "Main Sub":

Sub Main
	'Check Active Document to Add return if running in assembly
	Dim ActiveDoc As Document = ThisApplication.ActiveDocument
	
	If ActiveDoc.DocumentType = kAssemblyDocumentObject
		Dim pDoc As PartDocument = ThisDoc.Document
		Logger.Debug("Running " & pDoc.DisplayName & "  From Assembly")
		ThisApplication.Documents.Open(pDoc.FullDocumentName)
		pDoc.Activate
		Call SM_Bundle(pDoc)
		Logger.Debug("From Assembly: " & pDoc.DisplayName & "  Complete")
		pDoc.Save
		pDoc.Close(False)
		ActiveDoc.Activate
		Logger.Debug("From Assembly: " & pDoc.DisplayName & "  Total Complete")
	Else If ActiveDoc.DocumentType = kPartDocumentObject And ActiveDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" 'Sheet metal sub type
		Logger.Debug("Running " & ActiveDoc.DisplayName & "  From It Self")
		Call SM_Bundle(ActiveDoc)
	End If
	
End Sub

Sub SM_Bundle(PassDoc As PartDocument)

       'Mostly the same as before but definitely copy from the attached text file

End Sub

Let me know if you are still having issues, if this is an acceptable update method, or if you have any questions.

Charlies_3D_T · ‎01-31-2021

One thing i dont understand. The flat pattern rule i run normaly just
before i save then i get everything stored in the part.

This worked find but when i tried to get the parameter inside a derived
part this did not work anymore when i pressed save inside an assembly.

But the flat pattern rule needs to work when i save a part only or save all
parts inside an assembly. I will try your rule later today because i dont
fully understand why before save is not a good place to put this rule. You
would put it after save? Are the parameters then also stored inside the
part?

Community

Search all derived parts inside an assembly, open each of them and do something and close again

Search all derived parts inside an assembly, open each of them and do something and close again

Search all derived parts inside an assembly, open each of them and do something and close again