---

Test.zip.txt

Hallo zusammen,

Habe folgendes Problem

ich möchte eine Step Datei in Inventor importieren sie dann per Makro
neu abspeichern mit einem neunen Name und dann durch das Makro erneut öffnen und dabei die Bauteile durch die neu abgespeicherten  Bauteile ersetzen. Das Abspeichern in einen Temp Ordner funktioniert soweit nur das ersetzen klappt nicht
Mein Ansatz:

Dim TempName As String
        For Each oc In asmDoc1.ComponentDefinition.Occurrences
          Debug.Print "OC  " & oc.Definition.Document.PropertySets("Design Tracking Properties").Item("Part Number").value
          Debug.Print "TEMP  " & TempName
           
          If oc.Definition.Document.PropertySets("Design Tracking Properties").Item("Part Number").value = TempName Then
                Call oc.Replace("D:\Temp\" & zt & " T0" & i & " " & Bezeichnung.text & ".ipt", True)
          End If
           
            Next
           
        Next
       
        Debug.Print oc.Definition.Document.PropertySet("Design Tracking Property").Item("Part Number")

Hat jemand von euch so etwas schon einmal gemacht?
Bin für jede Hilfe dankbar

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

---

Hi,

ich benutze diesen Code (eigentlich um die Referenz einer AK zu ersetzen, funktioniert aber auch in Bgr.). Da ist einiges für Dich wohl überflüssig, es soll ja auch nur die Richtung weisen.

Code:

---

Sub Referenz_ersetzen()
   
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    Dim oRefFile As FileDescriptor
    Dim oOrigRefName
   
   
    'aktuell ref. Dok. melden
    Dim sTmp As String
    sTmp = "aktuell referenzierte Dateien (Anzahl: " _
        & oDoc.file.ReferencedFileDescriptors.Count & "): " & vbCrLf
    For Each oRefFile In oDoc.file.ReferencedFileDescriptors
        sTmp = sTmp & oRefFile.FullFileName & vbCrLf
    Next
    MsgBox sTmp, vbInformation, "Makro Referenz_ersetzen"
   
   
    'alle Referenzen ersetzen
    For Each oRefFile In oDoc.file.ReferencedFileDescriptors
        'get the full file path to the original internal references
        oOrigRefName = oRefFile.FullFileName
       
       
        'present a File Selection dialog
        Dim oFileDlg As Inventor.FileDialog
        Call ThisApplication.CreateFileDialog(oFileDlg)
        oFileDlg.InitialDirectory = oOrigRefName    'das klappt nicht (weil Pfad inkl. Dateiname?)
        oFileDlg.CancelError = True
        On Error Resume Next
        oFileDlg.ShowOpen
        If Err.Number <> 0 Then
            ThisApplication.StatusBarText = ""
            MsgBox "Aktion abgebrochen", vbOKOnly, "nichts passiert"
            Exit Sub
        ElseIf oFileDlg.filename <> "" Then
            selectedfile = oFileDlg.filename
        End If
       
        'Replace the reference
        oRefFile.ReplaceReference (selectedfile)

    Next
End Sub

---

Entstanden ist das übrigens hieraus: http://ww3.cad.de/foren/ubb/Forum50/HTML/036869.shtml

------------------
Gruß KraBBy

[Edit: wann lerne ich mal, wie man Links beim ersten mal richtig einfügt]

[Diese Nachricht wurde von KraBBy am 05. Apr. 2017 editiert.]

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

---

Hall KraBBy

ich probiers mal aus und streich das was ich nicht benötige weg
Aber trotzdem Danke für den Tipp

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