---

Guten Morgen zusammen,
kann mir einer mit einer Anpassung einer rountine helfen? Ich möchte das die folgende Routine bei bestimmten Bauteilfarben z.B. Blau die FArbe des Bauteils nicht mir der in der Routine angebenen überschreibt.
Anbei die Routine - welche die Bauteile ohne Schreibschutz aus der Baugruppenebene mit einer Standardfarbe versieht.

Sub Color_All_Parts_Assembly()
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get the assembly component definition.
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = oAsmDoc.ComponentDefinition

    ' Get all of the leaf occurrences of the assembly.
    Dim oLeafOccs As ComponentOccurrencesEnumerator
    Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

    ' Iterate through the occurrences and print the name.
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oLeafOccs
        On Error Resume Next
        Dim oDoc As Document
        Set oDoc = oOcc.Definition.Document
 
            ' Get a reference to the RenderStyle
        Dim oRenderStyle As RenderStyle
        Set oRenderStyle = oDoc.RenderStyles.Item("A - Standard")
 
        ' Assign the render style to the part.
 
        oDoc.ActiveRenderStyle = oRenderStyle
 
        ' Force the view to update to see the change.
        ThisApplication.ActiveView.Update
    Next
End Sub

Vielen Dank schon mal für eure Hilfe
Gruss

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo BlueJay

Ersetze:

Code:

---

        ' Assign the render style to the part.

        oDoc.ActiveRenderStyle = oRenderStyle

---

Durch:

Code:

---

If Not oDoc.ActiveRenderStyle.name = "Blau" Then 'wie gewünscht anpassen
    ' Assign the render style to the part.
    oDoc.ActiveRenderStyle = oRenderStyle
End If

---

Sollte passen.

Grüße

EIBe 3D

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin

Nur mal so am Rande, RenderStyles sind seit 2014 obsolet. So langsam würde ich mich nicht mehr darauf verlassen, dass die noch ewig weiter funktionieren. Besser mal in einer ruhigen Minute auf Darstellungen umstellen. Ich würde dann noch mindestens eine Prüfung einbauen, ob die Darstellung im Dokument vorhanden ist und ggf. aus der aktuellen Darstellungsbibliothek kopieren. Sollte die Darstellung dort auch nicht existieren, vorerst eine Fehlermeldung. Man könnte dann noch schauen, ob die Bibliothek schreibbar ist, die Darstellung anlegen und in die Bibliothek kopieren. Das wäre hier vermutlich etwas "drüber".

Code:

---

Option Explicit

Private Const sAppearAssetName As String = "Blau"
Private Const sStandardAppearAssetName As String = "A - Standard"

Sub Color_All_Parts_Assembly()
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
   
    Dim oAssetLib As AssetLibrary
    Set oAssetLib = oApp.ActiveAppearanceLibrary
           
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get the assembly component definition.
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = oAsmDoc.ComponentDefinition

    ' Get all of the leaf occurrences of the assembly.
    Dim oLeafOccs As ComponentOccurrencesEnumerator
    Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

    ' Iterate through the occurrences and print the name.
    Dim oOcc As ComponentOccurrence
    Dim oPartDoc As PartDocument
    Dim oLibAsset As Asset
    Dim oAppearAsset As Asset
   
    For Each oOcc In oLeafOccs
        If oOcc.DefinitionDocumentType = kPartDocumentObject Then
            Set oPartDoc = oOcc.Definition.Document
   
            If Not oPartDoc.ActiveAppearance.Name = sAppearAssetName Then
                'Search for Appearance Asset in document
                For Each oAppearAsset In oPartDoc.AppearanceAssets
                    If oAppearAsset.DisplayName = sStandardAppearAssetName Then
                        Exit For
                    End If
                Next
               
                'if not found, search for AppearanceAsset in library and copy to doc
                If oAppearAsset Is Nothing Then
                    For Each oLibAsset In oAssetLib.AppearanceAssets
                        If oLibAsset.DisplayName = sStandardAppearAssetName Then
                            Set oAppearAsset = oLibAsset.CopyTo(oPartDoc)
                            Exit For
                        End If
                    Next
                End If
               
                If oAppearAsset Is Nothing Then
                    Call MsgBox("Darstellung '" & sStandardAppearAssetName & "' im Dokument und der aktiven Darstellungsbibliothek nicht gefunden.", vbCritical, "Color all parts in assembly")
                    Exit Sub
                End If
         
                oPartDoc.ActiveAppearance = oAppearAsset
         
                ' Force the view to update to see the change.
                ThisApplication.ActiveView.Update
            End If
        End If
    Next
End Sub

---

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank für eure beiden Lösungsansätze - werde dann folgend mit dem Beispiel von rkauskh weiterarbeiten. Gibt es noch die Möglichkeit alle Darstellungen im Bauteil mit der Farbe zu überschreiben?

Dank und Gruss

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Besser wäre alle Überschreibungen zu entfernen und dann nur die eine neue zu setzen.

Code:

---

Option Explicit

Private Const sAppearAssetName As String = "Blau"
Private Const sStandardAppearAssetName As String = "A - Standard"
Private Const bClearAllOverrides As Boolean = True

Sub Color_All_Parts_Assembly()
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
 
    Dim oAssetLib As AssetLibrary
    Set oAssetLib = oApp.ActiveAppearanceLibrary
         
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get the assembly component definition.
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = oAsmDoc.ComponentDefinition

    ' Get all of the leaf occurrences of the assembly.
    Dim oLeafOccs As ComponentOccurrencesEnumerator
    Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

    ' Iterate through the occurrences and print the name.
    Dim oOcc As ComponentOccurrence
    Dim oPartDoc As PartDocument
    Dim oPartCompDef As PartComponentDefinition
    Dim oLibAsset As Asset
    Dim oAppearAsset As Asset
 
    For Each oOcc In oLeafOccs
        If oOcc.DefinitionDocumentType = kPartDocumentObject Then
            Set oPartCompDef = oOcc.Definition
            Set oPartDoc = oPartCompDef.Document
            If Not oPartDoc.ActiveAppearance.Name = sAppearAssetName Then
                'Reset all appearance overrides
                If bClearAllOverrides = True Then
                    Call oPartCompDef.ClearAppearanceOverrides
                End If
           
                'Search for Appearance Asset in document
                For Each oAppearAsset In oPartDoc.AppearanceAssets
                    If oAppearAsset.DisplayName = sStandardAppearAssetName Then
                        Exit For
                    End If
                Next
             
                'if not found, search for AppearanceAsset in library and copy to doc
                If oAppearAsset Is Nothing Then
                    For Each oLibAsset In oAssetLib.AppearanceAssets
                        If oLibAsset.DisplayName = sStandardAppearAssetName Then
                            Set oAppearAsset = oLibAsset.CopyTo(oPartDoc)
                            Exit For
                        End If
                    Next
                End If
             
                If oAppearAsset Is Nothing Then
                    Call MsgBox("Darstellung '" & sStandardAppearAssetName & "' im Dokument und der aktiven Darstellungsbibliothek nicht gefunden.", vbCritical, "Color all parts in assembly")
                    Exit Sub
                End If
       
                oPartDoc.ActiveAppearance = oAppearAsset
       
                ' Force the view to update to see the change.
                ThisApplication.ActiveView.Update
            End If
        End If
    Next
   
    oAsmDoc.Update
End Sub

---

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank rkauskh,
gibt es eine einfache Möglichkeit weitere Farben wie z.B.

Private Const sAppearAssetName As String = "Blau"

auszuschließen?

Danke und Gruss

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Ja, geht. Arrays kann man keine Werte auf Modulebene zuweisen, daher ist das jetzt in die Prozedur gewandert. Macht aber sonst kaum einen Unterschied.

Code:

---

Option Explicit

Private Const sStandardAppearAssetName As String = "A - Standard"
Private Const bClearAllOverrides As Boolean = True

Sub Color_All_Parts_Assembly()

    'Liste auszuschließender Darstellungen
    Dim aAppearAssetNames() As String
    aAppearAssetNames() = Split("Blau;Grün;Rot;Gelb", ";")
   
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication

    Dim oAssetLib As AssetLibrary
    Set oAssetLib = oApp.ActiveAppearanceLibrary
       
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get the assembly component definition.
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = oAsmDoc.ComponentDefinition

    ' Get all of the leaf occurrences of the assembly.
    Dim oLeafOccs As ComponentOccurrencesEnumerator
    Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

    ' Iterate through the occurrences and print the name.
    Dim oOcc As ComponentOccurrence
    Dim oPartDoc As PartDocument
    Dim oPartCompDef As PartComponentDefinition
    Dim oLibAsset As Asset
    Dim oAppearAsset As Asset
    Dim sAppearAssetName As Variant
   
    For Each oOcc In oLeafOccs
        If oOcc.DefinitionDocumentType = kPartDocumentObject Then
            Set oPartCompDef = oOcc.Definition
            Set oPartDoc = oPartCompDef.Document
            For Each sAppearAssetName In aAppearAssetNames
                If oPartDoc.ActiveAppearance.Name = sAppearAssetName Then
                    GoTo ENDNEXT
                End If
            Next
            'Reset all appearance overrides
            If bClearAllOverrides = True Then
                Call oPartCompDef.ClearAppearanceOverrides
            End If
       
            'Search for Appearance Asset in document
            For Each oAppearAsset In oPartDoc.AppearanceAssets
                If oAppearAsset.DisplayName = sStandardAppearAssetName Then
                    Exit For
                End If
            Next
         
            'if not found, search for AppearanceAsset in library and copy to doc
            If oAppearAsset Is Nothing Then
                For Each oLibAsset In oAssetLib.AppearanceAssets
                    If oLibAsset.DisplayName = sStandardAppearAssetName Then
                        Set oAppearAsset = oLibAsset.CopyTo(oPartDoc)
                        Exit For
                    End If
                Next
            End If
         
            If oAppearAsset Is Nothing Then
                Call MsgBox("Darstellung '" & sStandardAppearAssetName & "' im Dokument und der aktiven Darstellungsbibliothek nicht gefunden.", vbCritical, "Color all parts in assembly")
                Exit Sub
            End If
   
            oPartDoc.ActiveAppearance = oAppearAsset
   
            ' Force the view to update to see the change.
            ThisApplication.ActiveView.Update
            End If
ENDNEXT:
    Next
 
    oAsmDoc.Update
End Sub

---

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hallo, vielen Dank dir - es scheint als ob das Programm den  GoTo ENDNEXT Punkt nicht richtig erkennt - es scheint immer zum Farbänderungspunkt zu springen - sorry das ich da noch mal Frage - aber ich bekomme es momentan nicht angepasst?

Danke und Gruss

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Sorry, Fehler vom Amt. Die Zeile

Code:

---

If oAppearAsset.Name = sStandardAppearAssetName Then

---

muß heißen

Code:

---

If oAppearAsset.DisplayName = sStandardAppearAssetName Then

---

Sonst vergleicht man den internen mit dem Anzeigenamen. Das wird nur in sehr seltenen Ausnahmefällen einen Treffer geben.

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Die Zeile

If oAppearAsset.DisplayName = sStandardAppearAssetName Then

ist doch schon so aufgebaut?

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Das muss man erstmal hinkriegen, in der Fehlerkorrektur in der Zeile verrutschen.
Ich meinte eigentlich die Zeile

Code:

---

If oPartDoc.ActiveAppearance.Name = sAppearAssetName Then

---

die geändert werden muss in

Code:

---

If oPartDoc.ActiveAppearance.DisplayName = sAppearAssetName Then

---

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Guten Morgen rkauskh,
Vielen Dank dir - jetzt läuft das ganze rund - Vielen Dank für deine Mühe - Dank auch allen anderen die an diesem Thema mitgewirkt haben (-:

------------------
MFG

BlueJay

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP