---

Hallo

Weil das rekursive durchlaufen einer Baugruppe sehr langsam ist möchte ich folgendes tun.
Alle Objekte (ab dem ersten Komponenteneintrag normalerweise der 5te)
auswählen und das Kommando "Fixiert" aufrufen.
Im Moment bekomme ich jedoch die Auswahl der Browsernodes nicht hin 
Hat jemand eine Idee ??
Danke Frank

------------------
************************************
 

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

---

Hallo Frank,

was genau bekommst du denn nicht hin?
Wie weit bist du denn mit deinem Code?

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

Chris

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

---

Hallo Frank,

ich habe vor längerer Zeit mal dieses Makro zum fixieren hier aus dem Forum bekommen, vielleicht hilft dir das.

Code:

---

Sub Markierte_Bauteile_Fixieren() 'and suppress constraints
    If ThisApplication.Documents.Count = 0 Then
    MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If
 
    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
        MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If
    Dim oAsm As AssemblyDocument
    Set oAsm = ThisApplication.ActiveDocument
    If oAsm.SelectSet.Count = 0 Then
        MsgBox "Es sind keine Komponenten selektiert"
        Exit Sub
    End If

Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oSel As SelectSet
Set oSel = oDoc.SelectSet

Dim oObject As Object
Dim oCompOccsEnum As ComponentOccurrencesEnumerator
Dim oCompOcc As ComponentOccurrence
Dim oPattern As OccurrencePatternElement
Dim oConstraint As Object

For Each oObject In oSel
    If TypeOf oObject Is OccurrencePattern Then
        For Each oPattern In oObject.OccurrencePatternElements
            For Each oCompOcc In oPattern.Occurrences
                If oCompOcc.SubOccurrences.Count = 0 Then
                    If oCompOcc.DefinitionDocumentType = kPartDocumentObject Then
                        If oCompOcc.IsSubstituteOccurrence = False Then
                            oCompOcc.Grounded = True
                            For Each oConstraint In oCompOcc.Constraints
                                oConstraint.Suppressed = True
                            Next
                        End If
                    End If
                Else
                    oCompOcc.Grounded = True
                    For Each oConstraint In oCompOcc.Constraints
                        oConstraint.Suppressed = True
                    Next
                    Call AllSubOccs(oCompOcc)
                End If
            Next
        Next
    Else
        If oObject.SubOccurrences.Count = 0 Then
            If oObject.DefinitionDocumentType = kPartDocumentObject Then
                If oObject.IsSubstituteOccurrence = False Then
                    oObject.Grounded = True
                    For Each oConstraint In oObject.Constraints
                        oConstraint.Suppressed = True
                    Next
                End If
            End If
        Else
            oObject.Grounded = True
            For Each oConstraint In oObject.Constraints
                oConstraint.Suppressed = True
            Next
            Call AllSubOccs(oObject)
        End If
    End If
Next
End Sub

Sub AllSubOccs(ByVal oCompOcc As ComponentOccurrence)
    Dim oSubCompOcc As ComponentOccurrence
    Dim oProp As Property
    Dim sValue As String
    Dim oConstraint As Object
 
    On Error Resume Next
 
    For Each oSubCompOcc In oCompOcc.SubOccurrences
        If oSubCompOcc.SubOccurrences.Count = 0 Then
            If oSubCompOcc.DefinitionDocumentType = kPartDocumentObject Then
                If oSubCompOcc.IsSubstituteOccurrence = False Then
                    oSubCompOcc.Grounded = True
                    For Each oConstraint In oSubCompOcc.Constraints
                        oConstraint.Suppressed = True
                    Next
                End If
            Else
                oSubCompOcc.Grounded = True
                For Each oConstraint In oSubCompOcc.Constraints
                    oConstraint.Suppressed = True
                Next
                Call AllSubOccs(oSubCompOcc)
            End If
        End If
    Next
End Sub

---

------------------
Gruß, Gandhi
"Dem guten Frager ist schon halb geantwortet" - Friedrich Nietzsche

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

---

Erstmal danke für eure Antworten.
Genau hier ist der Punkt.
" If oAsm.SelectSet.Count = 0 Then
        MsgBox "Es sind keine Komponenten selektiert"
        Exit Sub
    End If"

das wäre eine interaktive Auswahl des Anwenders vorher.
Ich muss jedoch alle Komponenten per VBA im Browser vorher auswählen und da hakts 

------------------
************************************
 

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

---

Hallo

Ein Script welches alles im Browser fixiert, ohne selekt!

Code:

---

Public Sub KomponentenFixieren()
    If ThisApplication.Documents.Count = 0 Then
    MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If

    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
        MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If

    Dim oAsm As AssemblyDocument
    Set oAsm = ThisApplication.ActiveDocument

    ForAllComponents oAsm.ComponentDefinition.Occurrences
End Sub

Public Sub KomponentenFixierungAufheben()
    If ThisApplication.Documents.Count = 0 Then
    MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If

    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
        MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Sub
    End If

    Dim oAsm As AssemblyDocument
    Set oAsm = ThisApplication.ActiveDocument

    ForAllComponentsFree oAsm.ComponentDefinition.Occurrences
End Sub

'  Hilfsfunktionen ----------------------------------------------------------------------------------------------------
Sub ForAllComponents(oOccs As ComponentOccurrences)
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oOccs
        On Error Resume Next
        oOcc.Grounded = True
        If oOcc.Constraints.Count > 0 Then
          For Each oConstraint In oOcc.Constraints
              oConstraint.Suppressed = True
        Next
        End If
        ThisApplication.StatusBarText = oOcc.Name
        If Err.Number <> 0 Then
            Err.Number = 0
            GoTo NEXTCOMP
        End If
NEXTCOMP:
        ForAllComponents oOcc.SubOccurrences
    Next
End Sub

Sub ForAllComponentsFree(oOccs As ComponentOccurrences)
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oOccs
        On Error Resume Next
        oOcc.Grounded = False
        If oOcc.Constraints.Count > 0 Then
          For Each oConstraint In oOcc.Constraints
              oConstraint.Suppressed = False
        Next
        End If
        ThisApplication.StatusBarText = oOcc.Name
        If Err.Number <> 0 Then
            Err.Number = 0
            GoTo NEXTCOMP
        End If
NEXTCOMP:
        ForAllComponentsFree oOcc.SubOccurrences
    Next
End Sub

---

Gruß
Berno

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

---

Zitat:

---

Original erstellt von Frank_Schalla:
...Ich muss jedoch alle Komponenten per VBA im Browser vorher auswählen und da hakts   

---

Servus Frank,

Soweit ich das sehen kann musst du nur die oberste Komponente selektieren und die Struktur darunter wird rekursiv abgearbeitet. Mit der Selektion gibst du eben bekannt wo die Rekursion anfangen soll.

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

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

---

Wenn ich das nicht völlig falsch interpretiere, dann durchlaufen doch beide geposteten Codes rekursiv die Baugruppe, was ja nicht erwünscht war.

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

Chris

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

---

Hallo Frank,

Ich hab mal einen Code aus den Beispielen ein bisschen umgedichtet.
Er wählt den angegebenen BrowserNode aus und selectiert das Teil.
Ich denke mal, ne Schleife drum herum bekommst du ohne weiteres hin.

Code:

---

Sub SelectBrowserNodes()
    Dim oAssDoc As AssemblyDocument
    Set oAssDoc = ThisApplication.ActiveDocument
    Dim oOcc As ComponentOccurrence
    Set oOcc = oAssDoc.ComponentDefinition.Occurrences.Item(5)    'Hier die zu selectierende Nummer

    Dim oNativeBrowserNodeDef As NativeBrowserNodeDefinition
    Set oNativeBrowserNodeDef = oAssDoc.BrowserPanes.GetNativeBrowserNodeDefinition(oOcc)
   
    Dim oTopBrowserNode As BrowserNode
    Set oTopBrowserNode = oAssDoc.BrowserPanes.ActivePane.TopNode

    Dim oTargetNode As BrowserNode
    Set oTargetNode = oTopBrowserNode.AllReferencedNodes(oNativeBrowserNodeDef).Item(1)
    oTargetNode.DoSelect
End Sub

---

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

Chris

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

---

Zitat:

---

Original erstellt von Chris 31:
Wenn ich das nicht völlig falsch interpretiere, dann durchlaufen doch beide geposteten Codes rekursiv die Baugruppe, was ja nicht erwünscht war.

---

Wie interpretierst du es denn? Hilf mal, oder auch Frank, denn drei haben es bisher schon falsch interpretiert :)

Berno, dein Code, jedoch ein wenig gesäubert und umstrukturiert:

Code:

---

Sub KomponentenFixieren()
    If MeineBaugruppe Is Nothing Then Exit Sub
    ForAllComponents MeineBaugruppe.ComponentDefinition.Occurrences, True
End Sub

Sub KomponentenFixierungAufheben()
    If MeineBaugruppe Is Nothing Then Exit Sub
    ForAllComponents MeineBaugruppe.ComponentDefinition.Occurrences, False
End Sub

Function MeineBaugruppe() As Inventor.AssemblyDocument
    If ThisApplication.Documents.Count = 0 Then
        MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Function
    End If

    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
        MsgBox "Die Baugruppe öffnen.", vbExclamation, "Keine Baugruppe"
        Exit Function
    End If
   
    Set MeineBaugruppe = ThisApplication.ActiveDocument
End Function

Sub ForAllComponents(oOccs As ComponentOccurrences, KomponenteFixieren As Boolean)
    For Each oOcc In oOccs
        On Error Resume Next
        oOcc.Grounded = KomponenteFixieren
        For Each oConstraint In oOcc.Constraints
            oConstraint.Suppressed = KomponenteFixieren
        Next
        ThisApplication.StatusBarText = oOcc.Name
        ForAllComponents oOcc.SubOccurrences, KomponenteFixieren
    Next
End Sub

---

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

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

---

Zitat:

---

Original erstellt von Frank_Schalla:
Hallo

Weil das rekursive durchlaufen einer Baugruppe sehr langsam ist möchte ich folgendes tun.
Alle Objekte (ab dem ersten Komponenteneintrag normalerweise der 5te)
auswählen und das Kommando "Fixiert" aufrufen.
Im Moment bekomme ich jedoch die Auswahl der Browsernodes nicht hin  
Hat jemand eine Idee ??
Danke Frank

---

Er möchte doch durch Auswahl der Browsernodes durch die Baugruppe gehen.

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

Chris

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

---

Zitat:

---

Original erstellt von Chris 31:

Er möchte doch durch Auswahl der Browsernodes durch die Baugruppe gehen.

---

Ich verstehe den Umweg über die Browsernodes nicht. Aber egal, sofern der Vorschlag funktioniert muss ich ja auch nicht 

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

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

---

Zitat:

---

Original erstellt von daywa1k3r:

Ich verstehe den Umweg über die Browsernodes nicht. Aber egal, sofern der Vorschlag funktioniert muss ich ja auch nicht  

---

Den Umweg verstehe ich auch nicht, aber ich hab auch nur versucht, auf seine eigentliche Frage: Wie wähle ich die Browsernodes aus? zu antworten. 

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

Chris

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

---

Zitat:

---

Original erstellt von Chris 31:

Den Umweg verstehe ich auch nicht, aber ich hab auch nur versucht, auf seine eigentliche Frage: Wie wähle ich die Browsernodes aus? zu antworten.   

---

So gesehen hätte das auch gereicht:

Code:

---

Sub SelectBrowserNodes2()
    ThisApplication.ActiveDocument.SelectSet.Select ThisApplication.ActiveDocument.ComponentDefinition.Occurrences.Item(5)
End Sub

---

Aber gut, der Node ist selektiert und was dann? Alle Nodes unter diesem Node müssen selektiert werden (nur die erste Ebene)? Um die dann zu fixieren? Lässt mir irgendwie keine Ruhe  

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

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

---

Hi erst mal Danke für eure Antworten.
Hi Igor 
Wegen "Den Umweg verstehe ich auch nicht, aber ich hab auch nur versucht, auf seine eigentliche Frage: Wie wähle ich die Browsernodes aus? zu antworten."
Tja weil die DIVA da wieder völlig ander von der Performance tickt 
Ich habe eine Baugruppe wo ingesamt 3000 unique components drin sind.
Die Knoten der ersten Ebene sollen nun fixiert werden.
Dauer per der bekannten recursiven VBA Methode bei mir ca. 2 Minuten.
Wenn man nun mal einfach im Browser alles unterhalb der IV Rep Folders
(also Views/Pos/LOD) markiert (interaktiv) und dann RMT Fixiert anwählt dauerts genau 8 Sekunden.
Deshalb der Ansatz in die Richtung
for each node in asm.nodes (alles nach 5 wählen) und dann selectset ground 

------------------
************************************
 

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

---

Hallo Frank, klar ist nur die erste Ebene viel schneller als die rekursive Methode. Wird aber nichts mit den Nodes zu tun haben. Das Makro selektiert alles ab den ersten Node. Alternativ kannst du ja testen die eine Zeile innerhalb der Schleife aus- und die andere ein- zu kommentieren. Da dürfte kein Nachteil in der Ausführungsgeschwindigkeit entstehen.

Code:

---

Sub SelectBrowserNodes3()
    Dim StartNode As Integer
   
    Dim oAsm As Inventor.AssemblyDocument
    Set oAsm = ThisApplication.ActiveDocument
   
    For StartNode = 5 To oAsm.ComponentDefinition.Occurrences.Count 'Hier StartNode festlegen
        'oAsm.ComponentDefinition.Occurrences.Item(StartNode).Grounded = True
        oAsm.SelectSet.Select oAsm.ComponentDefinition.Occurrences.Item(StartNode)
    Next
End Sub

---

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

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

---

IGOR

Nun weiss ich warum einige Programmiere sind und ich nur ein wenig dengeln kann 
DANKE 

------------------
************************************
 

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