---

Falls es jemand braucht...
Vorhaben:
Vom Kunden wurde eine CATpart Datei geschickt. Diese beinhaltet eingentlich eine Baugruppe.
Beim öffnen im IV wird daraus ein Mehrkörperbauteil.
Jeder Volumenkörper in diesem Teil stellt also ein eigenständiges Bauteil dar.
Aufgabe:
Aus der ipt alle Volumenkörper rausspeichern, in eine asm auf Urpsrung wieder einsetzen und die Teile fixieren.

Code:

---

Sub Ref()

Dim oapp As Inventor.Application
Set oapp = ThisApplication

If oapp.ActiveDocument Is Nothing Then
MsgBox "Kein Dokument geöffnet", vbInformation
Exit Sub
End If

If oapp.ActiveDocument.DocumentType <> kPartDocumentObject Then
MsgBox "Funktion ist nur bei Bauteilen zulässig", vbInformation
Exit Sub
End If

Dim odoc As Inventor.PartDocument
Set odoc = oapp.ActiveDocument

If odoc.ComponentDefinition.HasMultipleSolidBodies = False Then
MsgBox "Kein Mehrkörperbauteil geöffnet", vbInformation
Exit Sub
End If

Dim oASM As Inventor.AssemblyDocument
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim oMatrix As Matrix
Set oMatrix = oTG.CreateMatrix
Call oMatrix.SetTranslation(oTG.CreateVector(0, 0, 0))

Set oASM = oapp.Documents.Add(kAssemblyDocumentObject)
Call odoc.Save

For i = 1 To odoc.ComponentDefinition.SurfaceBodies.Count Step 1
' Abfrage auf Export Häckchen raus / Häckchen einfach setzen
'If odoc.ComponentDefinition.SurfaceBodies.Item(i).Exported = True Then
odoc.ComponentDefinition.SurfaceBodies.Item(i).Exported = True

Dim newdoc As Inventor.PartDocument
Dim newfile As String
newfile = Left(odoc.FullFileName, Len(odoc.FullFileName) - 4) & "_" & odoc.ComponentDefinition.SurfaceBodies.Item(i).Name & ".ipt"

Set newdoc = oapp.Documents.Add(kPartDocumentObject)

Dim oDef As DerivedPartUniformScaleDef

Set oDef = newdoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(odoc.FullFileName)
oDef.ExcludeAll
oDef.Solids.Item(i).IncludeEntity = True

Call newdoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDef)
Call newdoc.SaveAs(newfile, False)
newfile = Left(odoc.FullFileName, Len(odoc.FullFileName) - 4) & "_" & odoc.ComponentDefinition.SurfaceBodies.Item(i).Name & ".stp"
Call newdoc.SaveAs(newfile, True)
Call oASM.ComponentDefinition.Occurrences.Add(newdoc.FullFileName, oMatrix)
oASM.ComponentDefinition.Occurrences.Item(i).Grounded = True
Call newdoc.Close(False)

'End If

Next

oASM.Activate
oapp.ActiveView.GoHome
If oASM.ComponentDefinition.Occurrences.Count = 0 Then
oASM.Close (True)
MsgBox "Im Bauteil wurde kein Volumenkörper zum Export ausgewählt!", vbInformation
End If

End Sub

---

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

---

Super! Nach dem Auskommentieren von zwei Zeilen läuft es bei mir unter Inv2010 prima:
'odoc.ComponentDefinition.SurfaceBodies.Item(i).Exported = True

'oapp.ActiveView.GoHome

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