@robbeRtek
Your first option works like my try after you mentioned to highlight the faces via coloring and not with the highlightset. (with the little "Edit")
In your second option something must be missing. Cause it shows the same strange behavior of the highlightset that is mentioned in my start post. I also tried to clear an rebuild the whole highlightset. But if there are many faces selected, they will all highlight one after another which looks also very strange.
But I found an workaround.
Now every time an already highlighted face is selected (without pressing CTRL), it is removed from the highlightset and will be immediately added back.
This is not the most elegant solution, but it works (at least for me).
I also got rid of the collection cause everything can be done with the highlightset. (thanks to @WCrihfield for this idea). Besides this I also replaced the messagebox for the output with an inputbox as used in the other thread. This gives you the option for "copy and past" for the result.
Thanks for your help and effort. 👍
My solution via highlightset:
'Definition
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = oApp.ActiveDocument
Dim oStartFace,oFace As Inventor.Face '= Nothing
Dim AreaCache As Double = 0
Dim oHSet As HighlightSet = oDoc.CreateHighlightSet()
oHSet.Clear
'if done, start again
TheStart:
On Error GoTo ENDE
While True
Dim k As Integer
k = 1
Dim bNEW As Boolean
bNEW = True
oStartFace = oApp.CommandManager.Pick(Inventor.SelectionFilterEnum.kPartFaceFilter, "Fläche anwählen + ""Esc"" bestätigen.")
' If nothing gets selected then we're done
If IsNothing(oStartFace) Then Exit While
If System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then
If oHSet.Count>0 Then
For Each oFace In oHSet
If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
bNEW = False
Exit For
End If
k = k + 1
Next
End If
If bNEW = False
oHSet.Remove(k)
oApp.ActiveView.Update
End If
Else
If oHSet.Count>0 Then
For Each oFace In oHSet
If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
bNEW = False
Exit For
End If
k = k + 1
Next
End If
If bNEW = True Then
oHSet.AddItem(oStartFace)
Else If bNEW = False Then
oHSet.Remove(k)
oHSet.AddItem(oStartFace)
End If
End If
''Läuft nicht
oStartFace = Nothing
End While
'For Each oFace In FaceCol
For Each oFace In oHSet
AreaCache = AreaCache + oFace.Evaluator.Area
Next
If AreaCache = 0 Then Return
AreaCache = Math.Round(AreaCache*100,1)
Dim Auswahl As String
'MessageBox.Show(AreaCache & "mm²")
Auswahl = InputBox("Oberfläche:", "Oberflaeche_berechnen_Multiselect", AreaCache & "mm²")
'MessageBox.Show (Auswahl)
oHSet.Clear
AreaCache = 0
If Auswahl = "" Then Exit Sub
'if done, go to the start
GoTo TheStart
Return
ENDE:
My Solution with changing the color:
'Definition
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = oApp.ActiveDocument
Dim oEdDoc As Document = oApp.ActiveEditDocument
Dim oCompDef As ComponentDefinition
oCompDef = oDoc.ComponentDefinition
Dim oStartFace,oFace As Inventor.Face '= Nothing
Dim AreaCache As Double = 0
Dim FaceCol As New Collection
FaceCol.Clear
Dim ColorCol As New Collection
ColorCol.Clear
Dim oHSet As HighlightSet = oDoc.CreateHighlightSet()
oHSet.Clear
' Definition der transienten Geometrie
Dim oTransObj As TransientObjects
oTransObj = oApp.TransientObjects
Dim docAsset As Assets
docAsset = oDoc.Assets
Dim oAssetLib As AssetLibrary
oAssetLib = oApp.AssetLibraries.Item("Autodesk Darstellungs-Bibliothek") 'Autodesk Appearance Library
Dim oColor As String
oColor = "Markierung"
' Get an asset In the library
Dim oHighlightColor As Asset
Try 'Copy the asset locally.
oHighlightColor = docAsset.Item(oColor)
Catch 'or just use it if it's already local
oHighlightColor = docAsset.Add(AssetTypeEnum.kAssetTypeAppearance, "Generic", oColor, oColor)
Dim generic_highlight_color As ColorAssetValue
generic_highlight_color = oHighlightColor.Item("generic_diffuse")
generic_highlight_color.Value = oHSet.Color
End Try
'wenn fertig, starte von vorn
TheStart:
While True
Dim k As Integer
k = 1
Dim bNEW As Boolean
bNEW = True
oStartFace = oApp.CommandManager.Pick(Inventor.SelectionFilterEnum.kPartFaceFilter, "Fläche anwählen + ""Esc"" bestätigen.")
' If nothing gets selected then we're done
If oStartFace Is Nothing Then Exit While
'wenn STRG gedrückt wird, sollen bereits selektierte Flächen wieder abgewählt werden
If System.Windows.Forms.Control.ModifierKeys = System.Windows.Forms.Keys.Control Then 'STRG wird gedrückt beim Selektieren
If FaceCol.Count>0 Then
For k = 1 To FaceCol.Count
oFace= FaceCol.Item(k)
If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
bNEW = False
Exit For
End If
Next
End If
If bNEW = False
FaceCol.Remove(k)
oFace.Appearance = ColorCol.Item(k)
ColorCol.Remove(k)
'oHSet.Remove(oFace)
oApp.ActiveView.Update
End If
Else 'STRG wird nicht gedrückt beim selektieren
If FaceCol.Count>0 Then
For k = 1 To FaceCol.Count
oFace= FaceCol.Item(k)
If oFace.InternalName = oStartFace.InternalName And oFace.TransientKey = oStartFace.TransientKey Then
bNEW = False
Exit For
End If
Next
End If
If bNEW = True Then
FaceCol.Add(oStartFace)
ColorCol.Add(oStartFace.Appearance)
oStartFace.Appearance = oHighlightColor
'oHSet.AddItem(oStartFace)
oApp.ActiveView.Update
End If
End If
oStartFace = Nothing
End While
'Berechenen der Flächeninhalte der Selektion
Dim i As Integer
If FaceCol.Count > 0 Then
For i = 1 To FaceCol.Count
oFace = FaceCol.Item(i)
AreaCache = AreaCache + oFace.Evaluator.Area
Next
End If
If AreaCache = 0 Then Return
'Ausgabe Flächeninhalt
AreaCache = Math.Round(AreaCache * 100, 1)
InputBox("Oberfläche:", "Oberflaeche_berechnen_Multiselect", AreaCache & "mm²")
'MessageBox.Show(AreaCache & "mm²")
For i = 1 To FaceCol.Count
oFace = FaceCol.Item(i)
oFace.Appearance = ColorCol.Item(i)
oApp.ActiveView.Update
Next
'oCompDef.ClearAppearanceOverrides() 'Alle farbig veränderten Flächen werden auf Standard gesetzt
oHSet.Clear
FaceCol.Clear
ColorCol.Clear
AreaCache = 0
'End If
'if done, go to the start
GoTo TheStart
