Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Vereinfachung unter Iprop Namen Speichern

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Vereinfachung unter Iprop Namen Speichern (153 mal gelesen)
Bluejay
Mitglied
Ingenieur


Sehen Sie sich das Profil von Bluejay an!   Senden Sie eine Private Message an Bluejay  Schreiben Sie einen Gästebucheintrag für Bluejay

Beiträge: 175
Registriert: 14.05.2007

Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400
Intel(R) Core(TM)2 Duo CPU
E6750 @2,66 GHz
3,00 GB RAM

erstellt am: 26. Nov. 2020 15:57    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1682
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 26. Nov. 2020 19:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bluejay 10 Unities + Antwort hilfreich

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

bkrüger
Mitglied
Konstrukteur


Sehen Sie sich das Profil von bkrüger an!   Senden Sie eine Private Message an bkrüger  Schreiben Sie einen Gästebucheintrag für bkrüger

Beiträge: 46
Registriert: 14.09.2014

Win10 IV2018 Vault2018-WG

erstellt am: 27. Nov. 2020 00:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bluejay 10 Unities + Antwort hilfreich

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

Bluejay
Mitglied
Ingenieur


Sehen Sie sich das Profil von Bluejay an!   Senden Sie eine Private Message an Bluejay  Schreiben Sie einen Gästebucheintrag für Bluejay

Beiträge: 175
Registriert: 14.05.2007

Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400
Intel(R) Core(TM)2 Duo CPU
E6750 @2,66 GHz
3,00 GB RAM

erstellt am: 27. Nov. 2020 07:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1682
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 27. Nov. 2020 11:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bluejay 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz