| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: .idw inkl. .ipt kopieren und Referenzen ändern (4340 mal gelesen)
|
Enduro Mitglied Wirtschaftsinformatik Studentin
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 16. Okt. 2012 10:31 <-- editieren / zitieren --> Unities abgeben:
Hallo Forum, ich möchte per Makro eine Zeichnung und Modell kopieren. Zu dem gleichen Thema habe ich hier im Forum viele alte Beiträge gefunden aber leider keine hilfreiche für mich. Das Problem: Referenz auf .ipt wird nicht mitkopiert(mitgenommen) und muss immer manuell zugewiesen werden. Was ich bisher schon habe ist, ein Code, dass die dazugehörige .idw für ipt aus gleichem Ordner aufmacht, die dann kopiert und auch ipt kopiert. Was ich noch brauche ist, ein Hinweis, wie ich Referenz richtig setzen kann, so dass ich neue(kopierte) Zeichnung öffne und diese kopierte Zeichnung automatisch auf die neue kopierte .ipt referenziert. Hier der Code: Code: Public Sub OpenIDW() Dim oDoc As Document Dim fs As Object Dim odocname As String Dim Pfad As String Dim DateiName As String Set oDoc = ThisApplication.ActiveDocument odocname = oDoc.FullFileName If odocname = "" Then MsgBox "Bitte Modell erst speichern!" Exit Sub End If Pfad = Left(oDoc.FullFileName, InStrRev(odocname, "\")) DateiName = Mid(odocname, InStrRev(odocname, "\") + 1) DateiName = Left(DateiName, Len(DateiName) - 4) DateiName = Pfad & DateiName & ".idw" Set fs = CreateObject("Scripting.FileSystemObject") If fs.fileexists(DateiName) = True Then ThisApplication.Documents.Open (DateiName) Dim ddoc As DrawingDocument Set ddoc = ThisApplication.ActiveDocument End If ' Create a new FileDialog object. Dim oFileDlg As FileDialog Call ThisApplication.CreateFileDialog(oFileDlg) ' Define the filter to select part and assembly files or any file. oFileDlg.Filter = "Inventor Files (*.idw)|*.idw|All Files (*.*)|*.*" ' Define the part and assembly files filter to be the default filter. oFileDlg.FilterIndex = 1 ' Set the title for the dialog. oFileDlg.DialogTitle = "Zeichnung Speichern unter..." ' Set the initial directory that will be displayed in the dialog. oFileDlg.InitialDirectory = oFileDlg.FileName oFileDlg.FileName = DateiName ' Set the flag so an error will be raised if the user clicks the Cancel button. oFileDlg.CancelError = True ' Show the Save dialog. On Error Resume Next oFileDlg.ShowSave 'If an error was raised, the user clicked cancel, otherwise display the filename. If Err Then Exit Sub ElseIf oFileDlg.FileName <> "" Then Dim sFilePath As String sFilePath = oFileDlg.FileName ' Save and close the part. Call ddoc.SaveAs(sFilePath, True) 'ddoc.Close 'oPartDoc.Close ' outFile = oFileDlg.FileName ' odoc.SaveAs outFile, True ' End If oDoc.Activate 'referenz ändern 'Dialog reinfügen ' Create a new FileDialog object. Dim refFileDlg As FileDialog Call ThisApplication.CreateFileDialog(refFileDlg) ' Define the filter to select part and assembly files or any file. refFileDlg.Filter = "Inventor Files (*.ipt)|*.ipt|All Files (*.*)|*.*" ' Define the part and assembly files filter to be the default filter. refFileDlg.FilterIndex = 1 ' Set the title for the dialog. refFileDlg.DialogTitle = "Modell Speichern unter..." ' Set the initial directory that will be displayed in the dialog. refFileDlg.InitialDirectory = refFileDlg.FileName refFileDlg.FileName = odocname ' Set the flag so an error will be raised if the user clicks the Cancel button. refFileDlg.CancelError = True ' Show the Save dialog. On Error Resume Next refFileDlg.ShowSave 'MsgBox dateiname 'If an error was raised, the user clicked cancel, otherwise display the filename. If Err Then Exit Sub 'MsgBox "User cancelled out of dialog" ElseIf refFileDlg.FileName <> "" Then Dim refFilePath As String refFilePath = refFileDlg.FileName ' Save and close the part. Call oDoc.SaveAs(refFilePath, True) FileSaveAs.ExecuteSave outFile = refFileDlg.FileName oDoc.SaveAs outFile, True oDoc.Close ddoc.Close 'hier soll die kopierte .idw Datei aufgehen Dim neuDrawDoc As Object Set neuDrawDoc = ThisApplication.Documents.Open(sFilePath) End If End Sub
Hat jemand eine Ahnung wie ich die zwei neue Dateien vor dem open Funktion miteinander verknüpfen kann? Wäre super nett von Euch! Vielen Dank im Voraus!
------------------ ---------------- Viele Grüße Endu 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: 16. Okt. 2012 12:57 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
Hallo Im Drawing mit Code: Dim oFD As FileDescriptor oFD = oDrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor.ReplaceReference("FullNew3DDocumentName As String")
die Referenz zum Part tauschen. ------------------ MfG Ralf Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enduro Mitglied Wirtschaftsinformatik Studentin
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 16. Okt. 2012 15:02 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, vielen Dank für deine Hilfe Code: Dim oFD As FileDescriptor Dim oDrawDoc As DrawingDocument Set oDrawDoc = ThisApplication.ActiveDocument oFD = oDrawDoc.ReferencedFileDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor.ReplaceReference(neuiptDoc.FullFileName)
oDrawDoc soll ja die kopierte Zeichnung sein oder? das gibt Compile error, "Type mismatch" und zeigt auf dem "ReplaceReference" Satz. ich habe auch schon einfachen Pfad als String versucht. In API Hilfe steht ja FullFileName als Variable dafür, wieso funkt es nicht? ------------------ ---------------- Viele Grüße Endu Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enduro Mitglied Wirtschaftsinformatik Studentin
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 16. Okt. 2012 15:14 <-- editieren / zitieren --> Unities abgeben:
ich habs... Code:
Set oDrawDoc = ThisApplication.ActiveDocument Dim oFile As File Set oFile = oDoc.FileDim oFD As FileDescriptor Set oFD = oFile.ReferencedFileDescriptors.Item(1) Call oFD.ReplaceReference("C:\Users....ipt")
komischerweise funktioniert es sorum vielen Dankt für deine Hilfe! ------------------ ---------------- Viele Grüße Endu Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RolandD Mitglied
Beiträge: 533 Registriert: 07.01.2005 i7-9700k 32GB DDR4-RAM Nvidia RTX 2060 SSD 970 m.2 Win10-64 (21H2) AIP 2020.3 Dell U3417W
|
erstellt am: 20. Okt. 2012 13:17 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
Hallo Ralf & Endu Da ich häufig Dateien mit IDW im Designassistent kopiere und dann ersetze, würde ich gern Euer Makro mit folgender Funktion nutzen: Aufruf aus einer IAM oder IPT 1. speichern unter.. der zugehörigen IDW 2. speichern unter dem gleichen Namen der IPT bzw. IAM 3. schließen der beiden ursprünglichen Dateien ohne speichern 4. öffnen der neuen IDW -- bis hier fuktioniert auch alles 5. ersetzen der Referenz auf neue IPT bzw. IAM -- neue Referenz steh richtig in "new3DName" wird aber nicht ersetzt Code: Public Sub SafeAS_IDW_IPT_IAM() Dim oDoc As Document Dim fs As Object Dim oDocName As String Dim Pfad As String Dim DateiName As String Dim newPfad As String Dim new3DName As String Dim NewIDWName As String Dim newDateiExtension As String Dim test As String Set oDoc = ThisApplication.ActiveDocument oDocName = oDoc.FullFileName If oDoc.DocumentType = kDrawingDocumentObject Then Exit Sub 'nicht in IDW ausführen If oDoc.DocumentType = kPartDocumentObject Then newDateiExtension = ".ipt" End If If oDoc.DocumentType = kAssemblyDocumentObject Then newDateiExtension = ".iam" End If If oDocName = "" Then MsgBox "Bitte Modell erst speichern!" Exit Sub End If ' 1. zugehörige Quell-IDW öffnen (aus Dateiname der IPT bzw IAM) Pfad = Left(oDoc.FullFileName, InStrRev(oDocName, "\")) DateiName = Mid(oDocName, InStrRev(oDocName, "\") + 1) DateiName = Left(DateiName, Len(DateiName) - 4) DateiName = Pfad & DateiName & ".idw" Set fs = CreateObject("Scripting.FileSystemObject") If fs.fileexists(DateiName) = True Then ThisApplication.Documents.Open (DateiName) Dim dDoc As DrawingDocument Set dDoc = ThisApplication.ActiveDocument End If ' Create a new FileDialog object. Dim oFileDlg As FileDialog Call ThisApplication.CreateFileDialog(oFileDlg) ' Define the filter to select part and assembly files or any file. oFileDlg.Filter = "Inventor Files (*.idw)|*.idw|All Files (*.*)|*.*" ' Define the part and assembly files filter to be the default filter. oFileDlg.FilterIndex = 1 ' Set the title for the dialog. oFileDlg.DialogTitle = "Zeichnung Speichern unter..." ' Set the initial directory that will be displayed in the dialog. oFileDlg.InitialDirectory = oFileDlg.FileName oFileDlg.FileName = DateiName ' Set the flag so an error will be raised if the user clicks the Cancel button. oFileDlg.CancelError = True ' Show the Save dialog. On Error Resume Next oFileDlg.ShowSave 'If an error was raised, the user clicked cancel, otherwise display the filename. If Err Then Exit Sub ElseIf oFileDlg.FileName <> "" Then Dim sFilePath As String sFilePath = oFileDlg.FileName ' Save and close the part. Call dDoc.SaveAs(sFilePath, True) End If oDoc.Activate ' 2. Quell-IPT bzw IAM speichern unter gleichem Dateiname wie IDW ' Create a new FileDialog object. Dim refFileDlg As FileDialog Call ThisApplication.CreateFileDialog(refFileDlg) ' Define the filter to select part and assembly files or any file. refFileDlg.Filter = "Inventor Files (*.ipt)|*.ipt|All Files (*.*)|*.*" ' Define the part and assembly files filter to be the default filter. refFileDlg.FilterIndex = 1 ' Set the title for the dialog. refFileDlg.DialogTitle = "Modell Speichern unter..." ' Set the initial directory that will be displayed in the dialog. refFileDlg.InitialDirectory = oFileDlg.FileName ' refFileDlg.FileName ' Dateiname der IDW mit Extension der Ursprungsdatei (IPT bzw. IAM) DateiName = Left(oFileDlg.FileName, Len(oFileDlg.FileName) - 4) NewIDWName = DateiName & ".idw" DateiName = DateiName & newDateiExtension new3DName = DateiName refFileDlg.FileName = new3DName ' Set the flag so an error will be raised if the user clicks the Cancel button. refFileDlg.CancelError = True ' Show the Save dialog. On Error Resume Next refFileDlg.ShowSave 'MsgBox new3DName 'If an error was raised, the user clicked cancel, otherwise display the filename. If Err Then Exit Sub 'MsgBox "User cancelled out of dialog" ElseIf refFileDlg.FileName <> "" Then Dim refFilePath As String refFilePath = refFileDlg.FileName ' Save and close the part. Call oDoc.SaveAs(new3DName, True) 'refFilePath FileSaveAs.ExecuteSave outfile = refFileDlg.FileName oDoc.SaveAs outfile, True ' 3. Quell-Dateien schließen ohne speichern oDoc.Close (True) ' Quell-IPT bzw. IAM schließen ohne speichern dDoc.Close (True) ' Quell-IDW schließen ohne speichern ' 4. neue IDW öffnen und Referenz ersetzen Dim NewIDWDocument As DrawingDocument Set NewIDWDocument = ThisApplication.Documents.Open(NewIDWName, True) ' bis hierher alle ok ' 5. Referenz in der .idw austauschen *** wird nicht ausgetauscht!! Set oDrawDoc = ThisApplication.ActiveDocument Dim oFile As File Set oFile = oDoc.File Dim oFD As FileDescriptor Set oFD = oFile.ReferencedFileDescriptors.Item(1) Call oFD.ReplaceReference(new3DName) End If End Sub
------------------ Gruß Roland[Diese Nachricht wurde von RolandD am 20. Okt. 2012 editiert.] 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: 20. Okt. 2012 15:47 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
|
RolandD Mitglied
Beiträge: 533 Registriert: 07.01.2005 i7-9700k 32GB DDR4-RAM Nvidia RTX 2060 SSD 970 m.2 Win10-64 (21H2) AIP 2020.3 Dell U3417W
|
erstellt am: 20. Okt. 2012 16:08 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
|
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2166 Registriert: 15.11.2006 Windows 10 x64, AIP 2022
|
erstellt am: 20. Okt. 2012 16:46 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
Hallo Also bei mir geht's. Es dauert manchmal 2-3 Sekunden bevor Inventor den Teilebrowser aktualisiert. Wenn du oFD im Debugger beobachtest und schrittweise durch den letzten Teil läufst, wirst du sehen wie die Referenz umspringt. ------------------ MfG Ralf Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |