Change color of features only on flatpattern view

[gildas.lincot]

Hello,

I have been looking for a few days but without result a way to change the color of a function named "Gravure..." only on the view of the flatpattern.

I already have a code start but I can't "reach" the "Gravure..." function in the flatpattern.

I found in "Inventor help" the function "GetFlatPetternEntity or GetSheetMetalEntity" but I did not find an example to understand how it works.

Does anyone have an idea? Thank you

Here, my code:

'Regle pour changer la couleur de la gravure sur mise en plan Déplié

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
	'MsgBox("Cette Règle '" & iLogicVb.RuleName & "' ne fonctionne que pour les Mise en Plans!",vbOKOnly, "MAUVAIS TYPE DE DOCUMENT")
	Exit Sub
	Return
End If

Dim oDoc As DrawingDocument = ThisDrawing.Document
Dim oSheet As Inventor.Sheet = oDoc.ActiveSheet
Dim oPDoc As PartDocument = oSheet.DrawingViews.Item(1).ReferencedDocumentDescriptor.ReferencedDocument
Dim oPDef As SheetMetalComponentDefinition = oPDoc.ComponentDefinition
Dim oGravure As EmbossFeature


For Each oView As DrawingView In oSheet.DrawingViews
	If oView.IsFlatPatternView Then		
		
		'Verification qu'il y ai des bossages "GravureX"
		For Each oGravure In oPDef.Features.EmbossFeatures
			If Left(oGravure.Name, 7) = "Gravure" Then
			
			Dim oDCurves2 As DrawingCurvesEnumerator
			
			oDCurves2 = oView.DrawingCurves(oGravure) 'Here Something's wrong!
			
				If oDCurves2.Count <> 0  Then
					'Definition des lignes en rouge (R, G, B)
					Dim oRed As Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
					For Each oDCurve As DrawingCurve In oDCurves2
					oDCurve.Color = oRed
					Next
				Else
					'Sortie de la regle
					Exit Sub
				End If
			End If
		Next
	End If
Next
	

[WCrihfield]

Hi @gildas.lincot.  Judging from the attached images, the feature you are looking for was defined while the part was not in its Flat Pattern mode, and the view you are working with is of its FlatPattern, so I do not think you will find that feature in that view.  The FlatPattern is like its own ComponentDefinition, so it may contain geometry that resulted from that feature, but will not contain that feature directly, so you will need to identify which 'Faces' of the FlatPattern's body model were 'created by' that feature, then use each of those Faces in the DrawingCurves part of the code.  Below is a modified example of your code.  Give this version a try, and see if it works better for you.

'Regle pour changer la couleur de la gravure sur mise en plan Déplié

If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
	'MsgBox("Cette Règle '" & iLogicVb.RuleName & "' ne fonctionne que pour les Mise en Plans!",vbOKOnly, "MAUVAIS TYPE DE DOCUMENT")
	Exit Sub
	Return
End If
Dim oDoc As DrawingDocument = ThisDoc.Document
Dim oSheet As Inventor.Sheet = oDoc.ActiveSheet
'Definition des lignes en rouge (R, G, B)
Dim oRed As Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0)

For Each oView As DrawingView In oSheet.DrawingViews
	If oView.IsFlatPatternView = False Then Continue For
	Dim oPDoc As PartDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oSMDef As SheetMetalComponentDefinition = oPDoc.ComponentDefinition
	Dim oEFs As EmbossFeatures = oSMDef.Features.EmbossFeatures
	Dim oGravure As EmbossFeature = Nothing
	For Each oEF As EmbossFeature In oEFs
		If Left(oGravure.Name, 7) = "Gravure" Then
			oGravure = oEF
			Exit For
		End If
	Next 'oEF
	If IsNothing(oGravure) Then
		MsgBox("Gravure EmbossFeature Not Found", vbCritical, "")
		Exit Sub
	End If
	'now get the FlatPattern, so we can find the Edges of that feature in it
	Dim oFP As FlatPattern = oSMDef.FlatPattern
	Dim oFaces As Faces = oFP.Body.Faces
	For Each oFace As Face In oFaces
		If oFace.CreatedByFeature IsNot oGravure Then Continue For
		Dim oDCurves2 As DrawingCurvesEnumerator = Nothing
		Try
			oDCurves2 = oView.DrawingCurves(oFace)
		Catch oEx As Exception
			Logger.Error("Error getting DrawingCurves from Face created by Gravure feature")
			Continue For 'skip to next oView
		End Try
		If IsNothing(oDCurves2) OrElse oDCurves2.Count = 0 Then Continue For
		For Each oDCurve As DrawingCurve In oDCurves2
			oDCurve.Color = oRed
		Next 'oDCurve
	Next 'oFace
Next 'oView

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[gildas.lincot]

Hi,

Thanks for your help. I've tried your code and there is an error on line 20.

So i have change this part:

For Each oEF As EmbossFeature In oEFs

              If Left(oGravure.Name, 7) = "Gravure" Then

                          oGravure = oEF

like that:

 For Each oEF As EmbossFeature In oEFs

              oGravure = oEF

                   If Left(oGravure.Name, 7) = "Gravure" Then

No more error, but no action... The color of lines doesn't change...

Have you an another idea ?

Kind regard.