---

Hallo,

folgendes Problem: Ich bekomme eine recht umfangreiche Baugruppe als Step-Datei. Einlesen kein Problem. Die soll jetzt in sich fixiert werden.

Gibt es ein Tool, daß in der Lage ist den kompletten Strukturbaum zu fixieren, also mit allen Teilen und Baugruppen unter Unterbaugruppen usw. ?

Grüße Stefan

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

---

Code:

---

Sub GroundComponents()
    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

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

---

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

FX64 Software Solutions
HMI ~ 16.-20. April 2007 ~ CAD.de Halle 17, Stand F60

[Diese Nachricht wurde von daywa1k3r am 16. Mrz. 2007 editiert.]

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

---

Hallo Stefan,

erster Teil - shift Taste - letzter Teil

RMK - Teile fixieren.

Anbei ein Code, der aber auch die Teile auf 0,0,0 verschiebt.

Sub Teile_fixieren()

  Dim oDoc As Document
  Set oDoc = ThisApplication.ActiveDocument
 
  ' Wenn kein Dokument offen, dann beenden
  If oDoc Is Nothing Then Exit Sub
 
  ' Wenn keine Baugruppe offen, dann beenden
  If oDoc.DocumentType <> kAssemblyDocumentObject Then Exit Sub
 
  Dim bDelete As Boolean
  bDelete = False
 
  ' Frage - bestehende Abhängigkeiten löschen oder unterdrücken
  'If MsgBox("Sollen alle vorhandenen Anhängigkeiten gelöscht werden?", vbYesNo + vbQuestion) = vbYes Then
  '  bDelete = True
  'Else
  '  bDelete = False
  'End If
 
  Dim oAsmCompDef As AssemblyComponentDefinition
  Set oAsmCompDef = oDoc.ComponentDefinition
 
  Dim oConstraint As AssemblyConstraint
  For Each oConstraint In oAsmCompDef.Constraints
      If bDelete Then
        oConstraint.Delete
      Else
        oConstraint.Suppressed = True
      End If
  Next
 
  Dim oOccurrence As ComponentOccurrence
  For Each oOccurrence In oAsmCompDef.Occurrences
      Dim oTransform As Matrix
      Set oTransform = oOccurrence.Transformation
     
      ' Komponenten platzieren in Nullpunkt
      oTransform.SetTranslation ThisApplication.TransientGeometry.CreateVector(0, 0, 0)
      oOccurrence.Transformation = oTransform
     
      ' Komponenten fixieren
      oOccurrence.Grounded = True
  Next
 
  ' Zoom alles
  Call oDoc.Views.Item(1).Fit(True)
End Sub

------------------

Lg, Daniel

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

---

Zitat:

---

Original erstellt von Husky:

Gibt es ein Tool, daß in der Lage ist den kompletten Strukturbaum zu fixieren, also mit allen Teilen und Baugruppen unter Unterbaugruppen usw. ?

---

Jetzt ja 

------------------
Der vernünftige Mensch paßt sich der Welt an;
der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen.

Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab.
(George Bernard Shaw)

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

---

Daniel, eigentlich alles OK, aber wird nur mit ersten Ebene funktionieren. Mein Beispiel zeigt wie man eine Funktion rekursiv aufruft. Ist eigentlich immer das Gleiche, nur der Teil mit den Occurrences ändert sich.

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

FX64 Software Solutions
HMI ~ 16.-20. April 2007 ~ CAD.de Halle 17, Stand F60

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

---

Hallo Igor  ,

Nur zum Unterschied dass du es selber gemacht hast.     
Aber schön langsam verstehe ich auch die Befehle.

------------------

Lg, Daniel

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

---

Hallo Igor,

genial    

@Daniel:  Das mit der Shift Taste usw war mir schon bekannt ... aber hier hat der Baum bis zu 8 Ebenen ... das macht keine Freude. Aber Dank Igor no Problem

Grüße Stefan

[Diese Nachricht wurde von Husky am 16. Mrz. 2007 editiert.]

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

---

Zitat:

---

Original erstellt von daywa1k3r:

Code:

---

Sub GroundComponents()
    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

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

---

---

Jetzt wo du's schreibst wäre ich auch drauf gekommen... 

------------------
Grüsse
Jürgen
Neue FAQ-Seite blog.inventor-faq.de
www.dressler-ds.de
Autodesk Inventor Certified Expert

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

---

wo gebe ich diesen code ein?
und ist es besser die konstruktion zu fixieren oder mit abhängikeiten zu arbeiten?

------------------

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

---

Mein lieber Herr Garbovski,

wenn der Igor den Code auch nur mit kleinbuchstaben geschrieben hätte und dann nochanverschiedenenstellendiespacetasteausgelassenhätte
unddiekommasetzungignoriertdannkönnteesgutseindassdasprogramm
immernochläuftaberdielesbarkeitistdeutlicheingeschränkt

Und wenn die Tastatur schön geschmiert wird, dann kann man auch für alle  die Tipps geben:

Hier VBA-Modul öffnen (Alt+F11) und den Code dort in einem neuen Modul einfügen  (im Anwendungsprojekt, dann steht es später wieder zur Verfügung).

------------------
Gruß Lothar

---------------------------------------------------

Während man es aufschiebt, verrinnt das Leben.
Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)

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

---

Hallo Lothar

Habe den Code im Makro probiert und funktioniert.
Besten Dank

mfg Grabovski

------------------

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