---

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

---

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

---

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

---

ich habs... 

Code:

---

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("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

---

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

---

Hi

Statt

Code:

---

Set oFile = oDoc.File

---

vielleicht

Code:

---

Set oFile = oDrawDoc.File

---

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

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

---

Hallo Ralf,

Danke für den Hinweis.
jetzt funktioniert der Austausch der Referenz

------------------
Gruß Roland

[Diese Nachricht wurde von RolandD am 20. Okt. 2012 editiert.]

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

---

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