---

Guten Morgen zusammen,
ich habe mir vor längerer Zeit mal folgendes Makro zusammenkopiert bzw. angepasst. Mit diesem Makro wird abhängig von der Bauteilfarbe auf der Zeichnung die Linien / Layer angepasst. Leider funktioniert es nur bei Zeichnungen die von Baugruppen abhängig sind. Schön währe es würde für alle Zeichnungen egal von welcher Inventordatei diese abstammen.

Ich habe schon versucht es umzuhebeln - bisher erfolglos - nun meine Frage hat jemand lust und Zeit mir hierbei zuhelfen? Ich würde mich sehr freuen (-:

Public Sub RefDarstellung()
' Aktives Dokument auswählen
Dim drawDoc As DrawingDocument
Set drawDoc = ThisApplication.ActiveDocument

Dim drawView As DrawingView
For Each drawView In drawDoc.ActiveSheet.DrawingViews

Dim docDesc As DocumentDescriptor
Set docDesc = drawView.ReferencedDocumentDescriptor

' Checken das die selectierte Drawing View von einer Baugruppe ist
If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
MsgBox "Die Zeichnung muss von einer Baugruppe abstammen!"
Exit Sub
End If

' Get the component definition for the assembly.
Dim asmDef As AssemblyComponentDefinition
Set asmDef = docDesc.ReferencedDocument.ComponentDefinition

' Process the occurrences, wrapping it in a transaction so the
' entire process can be undone with a single undo operation.
Dim trans As Transaction
Set trans = ThisApplication.TransactionManager.StartTransaction(drawDoc, "Change drawing view Layer")

' Call the recursive function that does all the work.
Call ProcessAssemblyColor(drawView, asmDef.Occurrences)
trans.End

Next
MsgBox "Layer wurden zur Referenzansicht angepasst!!"
End Sub

Private Sub ProcessAssemblyColor(drawView As DrawingView, Occurrences As ComponentOccurrences)
' Iterate through the current collection of occurrences.
Dim occ As ComponentOccurrence
Dim sLayer As String
For Each occ In Occurrences

' Check to see if this occurrence is a part or assembly.
If occ.DefinitionDocumentType = kPartDocumentObject Then

' ** It's a part so process the BOM structureŽ
sLayer = ""

' Get the render style of the occurrence.
        Dim color As RenderStyle
        Dim sourceType As StyleSourceTypeEnum
        Set color = occ.GetRenderStyle(sourceType)
        Select Case color.Name
       
Case "Ansicht Referenz 1": sLayer = "Ansicht Referenz 1"
Case "Ansicht Referenz 2": sLayer = "Ansicht Referenz 2"
Case "Ansicht Referenz 3": sLayer = "Ansicht Referenz 3"
End Select

If sLayer <> "" Then

' Get the TransientsObjects object to use later.
Dim transObjs As TransientObjects
Set transObjs = ThisApplication.TransientObjects

' Verify that the layers Referenz exist
Dim layers As LayersEnumerator
Set layers = drawView.Parent.Parent.StylesManager.layers

Dim drawDoc As DrawingDocument
Set drawDoc = drawView.Parent.Parent

On Error Resume Next
Dim oLayer As Layer
Set oLayer = layers.Item(sLayer)
If Not oLayer Is Nothing Then

' Get all of the curves associated with this occurrence.
On Error Resume Next
Dim drawcurves As DrawingCurvesEnumerator
Set drawcurves = drawView.DrawingCurves(occ)
If Err.Number = 0 Then
On Error GoTo 0

' Create an empty collection.
Dim objColl As ObjectCollection
Set objColl = transObjs.CreateObjectCollection()

' Add the curve segments to the collection.
Dim drawCurve As DrawingCurve
For Each drawCurve In drawcurves
Dim segment As DrawingCurveSegment
For Each segment In drawCurve.Segments
objColl.Add segment
Next
Next

' Change the layer of all of the segments.
Call drawView.Parent.ChangeLayer(objColl, oLayer)
End If
End If
On Error GoTo 0
End If
Else

' It's an assembly so process its contents.
Call ProcessAssemblyColor(drawView, occ.SubOccurrences)
End If
Next

End Sub

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

BlueJay

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

---

Hallo  ,

Code am besten als "Code" einfügen, dann geht die Formatierung nicht verloren und ist besser lesbar.
Den Ursprung des Codes hätte man noch hinzufügen können.
http://modthemachine.typepad.com/my_weblog/2010/10/changing-drawing-curves-to-match-assembly-color.html

Ganz gelöst habe ich das Problem nicht, scheinbar ist es nicht ganz so einfach die Drawingcurves von einem Part in einer Assembly zu bekommen.
Brian Ekins hat das in VB.Net gelöst, muss man nur aufdröseln und umschreiben. Dazu fehlt mir dann aber grad die Zeit (und ein bisschen die Lust)
https://forums.autodesk.com/t5/inventor-forum/get-drawingcurves-from-occurrence-very-frustrating/td-p/6648874

Zu DrawingCurves hab ich auch nicht viel in der API-Help gefunden, kann also nicht genau sagen womit die gefüttert werden will.
Vielleicht reicht es eine GeometryProxy zu von jedem Part zu erstellen.

Kurz gesagt: Ich hab mich noch nicht eingehend damit befasst und kann sagen wie es funktioniert.
Was hab ich gemacht: Egal ob ComponentOccurrence oder PartDocument, es werden alle als Part in eine Variable abgespeichert ("oPart") und der Plan ist mit der Variable einheitlich weiter zu arbeiten.
Color funktioniert auch, nur die DrawingCurves wollen noch nicht.

Code:

---

Public Sub RefDarstellung()
' Aktives Dokument auswählen
Dim drawDoc As DrawingDocument
Set drawDoc = ThisApplication.ActiveDocument

Dim drawView As DrawingView
For Each drawView In drawDoc.ActiveSheet.DrawingViews

    Dim docDesc As DocumentDescriptor
    Set docDesc = drawView.ReferencedDocumentDescriptor
   
   
    ' Checken das die selectierte Drawing View von einer Baugruppe ist
    If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
    'MsgBox "Die Zeichnung muss von einer Baugruppe abstammen!"
    'Exit Sub
    End If
   
    ' Get the component definition for the assembly.
    Dim asmDef As Object 'AssemblyComponentDefinition
    Set asmDef = docDesc.ReferencedDocument.ComponentDefinition
   
    ' Process the occurrences, wrapping it in a transaction so the
    ' entire process can be undone with a single undo operation.
    Dim trans As Transaction
    Set trans = ThisApplication.TransactionManager.StartTransaction(drawDoc, "Change <" & drawView.Name & "> view Layer")
   
    ' Call the recursive function that does all the work.
    Call ProcessAssemblyColor(drawView, asmDef)
    trans.End

Next
MsgBox "Layer wurden zur Referenzansicht angepasst!!"
End Sub

Private Sub ProcessAssemblyColor(ByRef drawView As DrawingView, ByRef oObject As Object)
' Iterate through the current collection of occurrences.
Dim occ As ComponentOccurrence

If oObject.Type = kAssemblyComponentDefinitionObject Then
    For Each occ In oObject.Occurrences
        Call Work(drawView, occ)
    Next
ElseIf oObject.Type = kPartComponentDefinitionObject Then
    Call Work(drawView, oObject.Document)
End If

End Sub

Sub Work(ByRef drawView As DrawingView, ByRef occ As Object)

Dim sLayer As String

' Check to see if this occurrence is a part or assembly.
If occ.Type = Inventor.kDocumentObject Or occ.Type = Inventor.kComponentOccurrenceObject Then
    Dim oPart As Inventor.PartDocument
    ' ** It's a part so process the BOM structureŽ
    sLayer = ""
   
    If occ.Type = Inventor.kComponentOccurrenceObject Then
        Set oPart = occ.Definition.Document
    ElseIf occ.Type = Inventor.kDocumentObject Or occ.Type Then
        Set oPart = occ.ComponentDefinition.Document
    End If
   
   
    ' Get the render style of the occurrence.
            Dim color As RenderStyle
            Dim sourceType As StyleSourceTypeEnum
            Set color = oPart.ActiveRenderStyle
            Select Case color.Name
               
                Case "Ansicht Referenz 1": sLayer = "Ansicht Referenz 1"
                Case "Ansicht Referenz 2": sLayer = "Ansicht Referenz 2"
                Case "Ansicht Referenz 3": sLayer = "Ansicht Referenz 3"
            End Select
   
    If sLayer <> "" Then
   
        ' Get the TransientsObjects object to use later.
        Dim transObjs As TransientObjects
        Set transObjs = ThisApplication.TransientObjects
       
        ' Verify that the layers Referenz exist
        Dim layers As LayersEnumerator
        Set layers = drawView.Parent.Parent.StylesManager.layers
       
        Dim drawDoc As DrawingDocument
        Set drawDoc = drawView.Parent.Parent
       
        On Error Resume Next
        Dim oLayer As Layer
        Set oLayer = layers.Item(sLayer)
        If Not oLayer Is Nothing Then
           
            ' Get all of the curves associated with this occurrence.
            On Error Resume Next
            Dim drawcurves As DrawingCurvesEnumerator
            Set drawcurves = drawView.DrawingCurves(oPart)
            If Err.Number = 0 Then
                On Error GoTo 0
               
                ' Create an empty collection.
                Dim objColl As ObjectCollection
                Set objColl = transObjs.CreateObjectCollection()
               
                ' Add the curve segments to the collection.
                Dim drawCurve As DrawingCurve
                For Each drawCurve In drawcurves
                    Dim segment As DrawingCurveSegment
                    For Each segment In drawCurve.Segments
                        objColl.Add segment
                    Next
                Next
               
                ' Change the layer of all of the segments.
                Call drawView.Parent.ChangeLayer(objColl, oLayer)
            End If
        End If
        On Error GoTo 0
    End If
Else
    ' It's an assembly so process its contents.
    Call ProcessAssemblyColor(drawView, occ.SubOccurrences)
End If

End Sub

---

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