Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Abgeleitete Komponente automatisieren

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
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Abgeleitete Komponente automatisieren (2063 mal gelesen)
st.w
Mitglied



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

Beiträge: 59
Registriert: 08.11.2011

erstellt am: 12. Feb. 2014 09:41    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 vba'ler,

wir arbeiten ja immer noch mit IV2008.... 

Von da her möchte ich gerne das Erstellen einer abgeleiteten Komponente automatisieren.

Mein übliches Arbeiten ist, dass ich ein wie auch immer geartetes Lieferantenmodell (stp/iges...) zum Importieren doppelklicke, woraufhin sich eine iam oder ipt zeigt.

Wenn das Modell 'gut' aussieht, dann will ich per Makro:

1) diese unter Modell.iam bzw Modell.ipt speichern
2) neue leere ipt öffnen, automatisch geöffnete Skizze beenden
3) Abgeleitete Komponente Modell.iam bzw Modell.ipt einfügen
4) 'Verknüpfung mit Basisbaugruppe lösen' bzw 'Verknüpfung mit Basisbauteil auflösen' ausführen
5) Speichern unter UnsereArtikelnummer.ipt

Also bitte helft mir, diesen Ablauf in vba abzubilden - Danke!

Viele Grüße,
Stefan

------------------
IV2008

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: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 12. Feb. 2014 22:33    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 st.w 10 Unities + Antwort hilfreich

Hallo

Hoffentlich kennt Inventor2008 alle genutzten API-Teile. Probier's mal aus.

Code:
Private Sub stepsave()

Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
Call oDoc.Save
Dim oFS As New FileSystemObject
Dim oFile As Object
Set oFile = oFS.GetFile(oDoc.FullFileName)
Dim sPath As String
sPath = oFile.Path
Dim oNewDoc As PartDocument
Set oNewDoc = ThisApplication.Documents.Add(kPartDocumentObject, ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
If oNewDoc.SketchActive = True Then
    oNewDoc.ComponentDefinition.Sketches.Item(1).ExitEdit
End If
Dim oDerivedPartDef As DerivedPartUniformScaleDef
Dim oDerivedAssyDef As DerivedAssemblyDefinition
If TypeOf oDoc Is PartDocument Then
    Set oDerivedPartDef = oNewDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(oDoc.FullFileName)
    Call oNewDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
    Call oNewDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Item(1).BreakLinkToFile
ElseIf TypeOf oDoc Is AssemblyDocument Then
    Set oDerivedAssyDef = oNewDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(oDoc.FullFileName)
    Call oNewDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssyDef)
    Call oNewDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Item(1).BreakLinkToFile
Else
    Exit Sub
End If
Dim oFileDlg As FileDialog
Call ThisApplication.CreateFileDialog(oFileDlg)
oFileDlg.Filter = "Inventor Bauteil (*.ipt)|*.ipt|All Files (*.*)|*.*"
oFileDlg.FilterIndex = 1
oFileDlg.DialogTitle = "Save File"
oFileDlg.InitialDirectory = sPath
oFileDlg.ShowSave

End Sub


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

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

st.w
Mitglied



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

Beiträge: 59
Registriert: 08.11.2011

erstellt am: 27. Feb. 2014 10:32    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


Gelenkkopf.jpg

 
Hallo Ralf,

Danke, danke für Deine Codezeilen.

Wie Du siehst, habe ich noch etwas aussenrum getüftet und speichere jetzt eine Volumen-ipt ab, die sehr klein und super schnell geladen ist und auch noch passend heißt.

Zwei Kleinigkeiten wären noch klasse:

Zum einen möchte ich gerne

1. den Translationsbericht löschen und

2. das Volumenelement umbenennen.

Wie kann das noch gehen    

Danke für Tipps,
und noch manchem Anderen viel Spaß mit dem smarten Volumenmodellen.

Gruß
Stefan


Code:

Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal lOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub VolumenIPT()
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    Dim sOriginalDateiname As String, sKonvertierungspfad As String, sKonvertierungsDateiname As String, sSpeicherpfad As String, sKonvertierungsFullFilename As String, sName As String
   
    sOriginalDateiname = oDoc.FullFileName
    sKonvertierungspfad = "W:\INVENTOR\Projekte\Test\"
    sKonvertierungsDateiname = "xxxx"
    sSpeicherpfad = "W:\INVENTOR\3D-Inhalte\"
    sKonvertierungsFullFilename = sKonvertierungspfad & sKonvertierungsDateiname & Right(sOriginalDateiname, 4)
   
    Call oDoc.SaveAs(sKonvertierungspfad & sKonvertierungsDateiname & Right(sOriginalDateiname, 4), True)
   
    Dim oKonversionDoc As PartDocument
    Set oKonversionDoc = ThisApplication.Documents.Add(kPartDocumentObject)
    If oKonversionDoc.SketchActive = True Then
        oKonversionDoc.ComponentDefinition.Sketches.Item(1).ExitEdit
    End If
   
    Dim oDerivedPartDef As DerivedPartUniformScaleDef
    Dim oDerivedAssyDef As DerivedAssemblyDefinition
    If TypeOf oDoc Is PartDocument Then
        Set oDerivedPartDef = oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(sKonvertierungsFullFilename)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Item(1).BreakLinkToFile
    ElseIf TypeOf oDoc Is AssemblyDocument Then
        Set oDerivedAssyDef = oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(sKonvertierungsFullFilename)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssyDef)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Item(1).BreakLinkToFile
    Else
        Exit Sub
    End If
    If ExportToIGES(sKonvertierungspfad & sKonvertierungsDateiname & ".igs") Then
        Dim lRet As Long
        Dim DeskWin As Long
       
        DeskWin = GetDesktopWindow()
        lRet = ShellExecute(DeskWin, "open", sKonvertierungspfad & sKonvertierungsDateiname & ".igs", vbNullString, vbNullString, vbNormalFocus)
       
        Dim iI As Integer
        Dim oNewDoc As PartDocument
        Set oNewDoc = ThisApplication.ActiveDocument
        While oNewDoc.ComponentDefinition.Sketches.count > 0
            oNewDoc.ComponentDefinition.Sketches.Item(1).Delete
        Wend
       
        Dim oFileDlg As FileDialog
        Call ThisApplication.CreateFileDialog(oFileDlg)
        oFileDlg.Filter = "Inventor Bauteil (*.ipt)|*.ipt|All Files (*.*)|*.*"
        oFileDlg.FilterIndex = 1
        oFileDlg.DialogTitle = "Bauteil abspeichern"
        oFileDlg.InitialDirectory = sSpeicherpfad
        oFileDlg.ShowSave
           
        sName = oFileDlg.filename
        sName = Mid(sName, InStrRev(sName, "\") + 1)
        sName = Left(sName, Len(sName) - 4)
           
        oNewDoc.DisplayName = sName
        oNewDoc.Update
       
        Call oNewDoc.SaveAs(oFileDlg.filename, True)
        Call oNewDoc.Close(True)
        Call oKonversionDoc.Close(True) ' skip
        Kill sKonvertierungsFullFilename
        Kill sKonvertierungspfad & sKonvertierungsDateiname & ".igs"
    End If
End Sub

Private Function ExportToIGES(sIGESFullFilename As String) As Boolean
    ExportToIGES = False ' ExportToIGES nicht erfolgt
    On Error GoTo ErrorExportToIGES
   
    Dim oIGESTranslator As TranslatorAddIn  ' Get the IGES translator Add-In.
    Set oIGESTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F44-0C01-11D5-8E83-0010B541CD80}")

    If oIGESTranslator Is Nothing Then
        MsgBox "Could not access IGES translator."
        Exit Function
    End If

    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    If oIGESTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
        ' Set geometry type for wireframe.
        ' 0 = Surfaces, 1 = Solids, 2 = Wireframe
        oOptions.Value("GeometryType") = 1

        ' To set other translator values:
        ' oOptions.Value("SolidFaceType") = n
        ' 0 = NURBS, 1 = Analytic

        ' oOptions.Value("SurfaceType") = n
        ' 0 = 143(Bounded), 1 = 144(Trimmed)

        oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.filename = sIGESFullFilename

        Call oIGESTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
        ExportToIGES = True
        Exit Function
    End If
    On Error GoTo 0
ErrorExportToIGES:
End Function


------------------
IV2008

[Diese Nachricht wurde von st.w am 27. Feb. 2014 editiert.]

[Diese Nachricht wurde von st.w am 27. Feb. 2014 editiert.]

[Diese Nachricht wurde von st.w am 27. Feb. 2014 editiert.]

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

st.w
Mitglied



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

Beiträge: 59
Registriert: 08.11.2011

erstellt am: 28. Feb. 2014 14:56    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,

nachdem ich weiter und weiter probiert habe, habe ich ein SaveAs als SAT als schnelles und gutes Ergebnis herausgefunden:

Kein Translationsbericht, sauberes Modell, dass auch als idw sauber aussieht, was will ich mehr.

Anbei für alle der Code.

Wer den smarter srogrammieren kann möge es bitte posten... Hilft mir ja auch weiter    - Danke!

Gruß Stefan

Code:

Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal lOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long


Private Sub VolumenIPTviaSAT()
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    Dim sOriginalDateiname As String, sKonvertierungspfad As String, sKonvertierungsDateiname As String, sSpeicherpfad As String, sKonvertierungsFullFilename As String, sName As String
   
    sOriginalDateiname = oDoc.FullFileName
    sKonvertierungspfad = "W:\INVENTOR\Projekte\Test\"
    sKonvertierungsDateiname = "xxxx"
    sSpeicherpfad = "W:\INVENTOR\3D-Inhalte\"
    sKonvertierungsFullFilename = sKonvertierungspfad & sKonvertierungsDateiname & Right(sOriginalDateiname, 4)
   
    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg)
    oFileDlg.Filter = "Inventor Bauteil (*.ipt)|*.ipt|All Files (*.*)|*.*"
    oFileDlg.FilterIndex = 1
    oFileDlg.DialogTitle = "Bauteil abspeichern"
    oFileDlg.InitialDirectory = "W:\INVENTOR\3D-Inhalte"
    sName = Mid(sOriginalDateiname, InStrRev(sName, "\") + 1)
    sName = Left(sName, Len(sName) - 4)
    oFileDlg.filename = sName
    oFileDlg.ShowSave
   
    Call oDoc.SaveAs(sKonvertierungsFullFilename, True)
   
    Dim oKonversionDoc As PartDocument
    Set oKonversionDoc = ThisApplication.Documents.Add(kPartDocumentObject)
    If oKonversionDoc.SketchActive = True Then
        oKonversionDoc.ComponentDefinition.Sketches.Item(1).ExitEdit
    End If
   
    Dim oDerivedPartDef As DerivedPartUniformScaleDef
    Dim oDerivedAssyDef As DerivedAssemblyDefinition
    If TypeOf oDoc Is PartDocument Then
        Set oDerivedPartDef = oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(sKonvertierungsFullFilename)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Item(1).BreakLinkToFile
    ElseIf TypeOf oDoc Is AssemblyDocument Then
        Set oDerivedAssyDef = oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(sKonvertierungsFullFilename)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssyDef)
        Call oKonversionDoc.ComponentDefinition.ReferenceComponents.DerivedAssemblyComponents.Item(1).BreakLinkToFile
    Else
        Exit Sub
    End If
    Call oKonversionDoc.SaveAs(sKonvertierungspfad & sKonvertierungsDateiname & ".sat", True)
   
    Dim lRet As Long
    Dim DeskWin As Long
   
    DeskWin = GetDesktopWindow()
    lRet = ShellExecute(DeskWin, "open", sKonvertierungspfad & sKonvertierungsDateiname & ".sat", vbNullString, vbNullString, vbNormalFocus)
   
    Dim iI As Integer
    Dim oNewDoc As PartDocument
    Set oNewDoc = ThisApplication.ActiveDocument
    While oNewDoc.ComponentDefinition.Sketches.count > 0
        oNewDoc.ComponentDefinition.Sketches.Item(1).Delete
    Wend
   
    sName = oFileDlg.filename
    sName = Mid(sName, InStrRev(sName, "\") + 1)
    sName = Left(sName, Len(sName) - 4)
    oNewDoc.DisplayName = sName
    oNewDoc.Update
   
    Call oNewDoc.SaveAs(oFileDlg.filename, True)
   
    Call oNewDoc.Close(True)
    Call oKonversionDoc.Close(True) ' skip
    Kill sKonvertierungsFullFilename
    Kill sKonvertierungspfad & sKonvertierungsDateiname & ".sat"
End Sub


------------------
IV2008

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)2023 CAD.de | Impressum | Datenschutz