| | | 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
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 12. Feb. 2014 09:41 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 2166 Registriert: 15.11.2006 Windows 10 x64, AIP 2022
|
erstellt am: 12. Feb. 2014 22:33 <-- editieren / zitieren --> Unities abgeben: Nur für st.w
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
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 27. Feb. 2014 10:32 <-- editieren / zitieren --> Unities abgeben:
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 LongPrivate 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
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 28. Feb. 2014 14:56 <-- editieren / zitieren --> Unities abgeben:
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 >>)
|