---

Hallo Zusammen,
wer kann mich hier kurz Unterstützen- ich möchte gerne:
- Benuterspezifische Iprops aus Baugruppe auslesen
- Vereinfachung wie im Code durchführen
- Step unter Ipropnamen in einen bestimmten Pfad ablegen.

Hier der Code den ich bisher zusammengebastelt habe: Vielen Dank schon mal für alle Hilfestellungen

Sub Modelvereinfachung_Volumen()

    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 <> kAssemblyDocumentObject Then
    MsgBox "Die Funktion ist nur bei Baugruppen zulässig", vbInformation
    Exit Sub
    End If

' Set a reference to the active assembly document
    Dim oDoc As Inventor.AssemblyDocument
    Set oDoc = oApp.ActiveDocument

    Dim oDef As AssemblyComponentDefinition
    Set oDef = oDoc.ComponentDefinition

' Create a new part document that will be the shrinkwrap substitute
    Dim oPartDoc As Inventor.PartDocument
    Set oPartDoc = oApp.Documents.Add(kPartDocumentObject)
   
    Dim oPartDef As PartComponentDefinition
    Set oPartDef = oPartDoc.ComponentDefinition

    Dim oDerivedAssemblyDef As DerivedAssemblyDefinition
    Set oDerivedAssemblyDef = oPartDef.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(oDoc.FullDocumentName)

' Options shrinkwrap_1
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyWithSeams
    oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyNoSeams
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsWorkSurface
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsMultipleBodies
   
    oDerivedAssemblyDef.InclusionOption = kDerivedIncludeAll
 
' Options shrinkwrap_2
    oDerivedAssemblyDef.IncludeAllTopLevelWorkFeatures = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelSketches = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLeveliMateDefinitions = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelParameters = kDerivedExcludeAll
       
' Options shrinkwrap_3
    'oDerivedAssemblyDef.ActiveDesignViewRepresentation = True
    'oDerivedAssemblyDef.ActivePositionalRepresentation = True
   
       
' Options shrinkwrap_4
 
    Call oDerivedAssemblyDef.SetRemoveByVisibilityOptions(kDerivedRemovePartsOnly, 2, False)
   
' Bauteile nach Größe
    Call oDerivedAssemblyDef.SetRemoveBySizeOptions(True, 2)
 
' Lochabdeckung
    'Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchNone)
    Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchRange, 0, 3)
   
' Skalierung
    'Call oDerivedAssemblyDef.ScaleFactor
' Spiegeln
    'Call oDerivedAssemblyDef.MirrorPlane=kDerivedPartMirrorPlaneXY
   
   
' Sonstiges
    oDerivedAssemblyDef.UseColorOverridesFromSource = False
    oDerivedAssemblyDef.ReducedMemoryMode = True
    oDerivedAssemblyDef.IndependentSolidsOnFailedBoolean = True
    oDerivedAssemblyDef.RemoveInternalVoids = True

' Create the shrinkwrap component
    Dim oDerivedAssembly As DerivedAssemblyComponent
    Set oDerivedAssembly = oPartDef.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssemblyDef)
    'oDerivedAssembly.BreakLinkToFile
   
   
' Set a reference to the active part document
    Dim oDoc2 As Inventor.PartDocument
    Set oDoc2 = oApp.ActiveDocument
   
' Get the STEP translator Add-In.
    Dim oSTEPTranslator As TranslatorAddIn
    Set oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")

    If oSTEPTranslator Is Nothing Then
        MsgBox "STEP Translater nicht aufrufbar."
        Exit Sub
    End If

    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
   
        'Set application protocol.
        ' 2 = AP 203 - Configuration Controlled Design
        ' 3 = AP 214 - Automotive Design
        oOptions.Value("ApplicationProtocolType") = 3
   

        oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.filename = "C:\Vereinfachung.stp"

        Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
    End If
   

    'Call oDoc2.Close(True)
    'Call oDoc.Close(True)
        Call ExportToSat
   
    MsgBox "Die Vereinfachung wurde als Step und Sat Format unter -- C: -- gespeichert!!"
End Sub

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

BlueJay

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

---

Hallo

Den Teil der Veinfachung und STEP-Export habe ich jetzt nicht durchprobiert. Der passt bereits oder?
Benutzerspezifische iProps auslesen ginge z.B. so:

Code:

---

Dim oProp As Property
Dim sPropValue As String
           
For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
    If oProp.Name = "z.B. Teilenummer" Then
        sPropValue = oProp.Value
    End If
Next

---

In sPropValue ist der Inhalt des iProps "z.B. Teilnummer" zwischengespeichert. Im einfachsten Fall soll der Inhalt der Dateiname sein und der Speicherpfad fix? Dann einfach die Teile als String aneinanderknoten:

Code:

---

oData.FileName = "C:\Ablageverzeichnis\" & sPropValue & ".stp"

---

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

---

Anmerkung: Bei Erzeugung von Dateinamen immer auf unzulässige Zeichen prüfen und diese ersetzen. 

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

---

Guten Morgen und Danke dir,
ich war sehr nah dran - danke für die Hilfestellung. Hat alles super funktioniert.

Grusss

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

BlueJay

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

---

Moin

Ob die fehlende Prüfung des Dateinamens das Script rettet? Da fehlen vorab schon 20 Plausis. Aber den Dateinamen kann man zumindest um verbotene Zeichen z.B. so "erleichtern".

Code:

---

Function CheckName(sName As String) As String

Dim sErgebnis As String
Dim i As Integer

sErgebnis = ""

'verbotene Zeichen \ / : * ? " < > |  werden gelöscht

For i = 1 To Len(sName)
    Select Case Mid(sName, i, 1)
    Case "\"
    Case """"
    Case "/"
    Case ":"
    Case "*"
    Case "?"
    Case "<"
    Case ">"
    Case "|"
       
    Case Else
        sErgebnis = sErgebnis + Mid(sName, i, 1)
    End Select
   
Next i

CheckName = sErgebnis

End Function

---

Aufruf in der Sub mit:

Code:

---

oData.FileName = Checkname("C:\Ablageverzeichnis\" & sPropValue & ".stp")

---

Die Prüfung ist unvollständig, da z.B. die max. Gesamtlänge (255 Zeichen) nicht geprüft wird, auch nicht ob das erste Zeichen Buchstabe oder Zahl ist (andere Zeichen wären unzulässig) oder ob reservierte Namen (CON, AUX, COM1, COM2, COM3, COM4, LPT1, LPT2, LPT3, PRN, NUL) verwendet wurden.

Weiter kann man prüfen, ob:
- der Pfad überhaupt existiert
- Schreibrechte im Pfad vorhanden sind
- es bereits eine existierende Datei gleichen Namens gibt
- das iProperty für den Dateinamen existiert
- das iProperty auch einen Wert ungleich NULL enthält
- diverse weitere Variablen des Scriptes überhaupt gefüllt sind, bevor man sie weiter verwendet
- usw.

In einem Script für den Eigengebrauch muss man abwägen, wieviel Prüfung und Fehlerbhandlung Sinn ergeben und wann man den Crash für mehr Freizeit billigend in Kauf nehmen kann. 

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

RKW Solutions GmbH
www.RKW-Solutions.com

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