---

Hallo zusammen,

wie kann ich in einer Zeichnung, per Makro, VBA, das Modell ersetzten?

Mein Ziel ist es Ein Teil mit Zeichnung zu kopieren und dann ín einer Baugruppe zu ersetzen.

Mein erster Ansatz ist jetzt erstmal ein geöffnetes Teil zu kopieren:

1. Teil kopieren      (funktioniert)
2. Zeichnung kopieren (funktioniert)
3. Referenz des Teils in der Zeichnung, mit der des kopierten Teil ersetzen (Funktioniert nicht, da kein Ansatz)

… usw.

Habt Ihr da eine Idee oder bin ich da schon zu umständlich unterwegs?

Danke für eure Hilfe.

Gruß Pete

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

---

Das geht auch ohne Makro:

Baugruppe, Zeichnung und Teil öffnen. Jetzt Teil "speichern unter..." und obersten Eintrag wählen.

Erst jetzt die Zeichnung, auch mit "Speichern unter..." abspeichern. Da diese im Hintergrund geöffnet war, referenziert sie bereits auf das neue Teil.

Zum Schluß noch die Baugruppe speichern.

------------------
Cheers,
    Jochen

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

---

Hallo,

danke für die schnelle Antwort.

es muss halt leider über ein Makro umgesetzt werden.

ich hab jetzt mal ReplaceReferencedDocument ausprobiert.... das war leider auch nicht von Erfolg gekrönt...

Gruß Peter

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

---

jetzt hat es funktioniert.

Die Zeichnung in der das Teil ausgetauscht wird darf nicht geöffnet sein.

Gruß Pete

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

---

Ich habe das mit der DocumentMgr-API erledigt, allerdings muss hierfür die Zeichnung nicht in SolidWorks geöffnet sein. Dafür dann Massentauglich.

Interface:ISwDMDocument21
Function: GetAllExternalReferences5

In der Hilfe sind auch Beispiele.

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

---

Hi,

die Optionen wie von Hand gehen nicht wenn man es mit Makro macht?
Hätte erwartet, dass auch da die richtigen Option und die richtige Reihenfolge schon für das gewünschte Ergebnis sorgen könnte.

von Hand gibt es auch noch "Modell in Ansicht ersetzen". Im Prinzip wie Referenzen der Datei ersetzen, aber doch anders - dabei ist die Datei offen.
... weiß jetzt aber nicht, wie der Befehl per api heisst, oder ob es ihn gibt ... 

Gruß, Christian

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

---

Hallo zusammen,

bei einem Einzelteil funktioniert das jetzt mit Referenzen ersetzen super.

jetzt möchte ich dies über eine Baugruppe laufen lassen...

mit der Methode

swApp.ReplaceReferencedDocument(Bauruppe, Komponente_alt, Komponente_neu)

passiert in der Baugruppe nichts, da die geschlossen sein sollte.

Wie kann ich denn die Referenzen am einfachsten ersetzen?

Mein momentaner Ablauf ist für jedes Teil in der BG:

Code:

---

Function Zeilmitzeichnungkopieren(newdocname As String, Zielverzeichnis As String)

Dim Swapp As Object
Dim Tiefe, Breite, Hoehe As String
Dim SwDoc As Object
Dim Vorlage As String
Dim Vorlagenpfad, Kopierverzeichnis As String
Dim DateitypASM, DateinameNeu As String
Dim DateitypPRT, DateitypDRW As String
Dim newASMPathname As String
Dim longstatus As Long
Dim Fileerror As Long
Dim Filewarning As Long

Dim DraW As SldWorks.ModelDoc2
Dim Part As SldWorks.ModelDoc2

Dim PfadPRTASM As String
Dim PfadDRW As String
Dim DRWken As String
Dim docType As Variant
Dim NewDrawPath, NewDocPath As String
Dim Folder As String
Dim Dateiendnung As String
Dim Bret As Boolean

Set Swapp = Application.SldWorks
Set SwDoc = Swapp.ActiveDoc

PfadPRTASM = SwDoc.GetPathName
PfadDRW = Left(PfadPRTASM, Len(PfadPRTASM) - 7) & ".SLDDRW"

If Dir(PfadDRW) <> "" Then
DRWken = 1
Else
DRWken = 0
End If

docType = SwDoc.GetType

If docType = 1 Then
Dateiendnung = ".SLDPRT"
ElseIf docType = 2 Then
Dateiendnung = ".SLDASM"
ElseIf docType = 3 Then

MsgBox "Datei darf keine Drawing sein"
Dateiendnung = ".SLDDRW"
Else
MsgBox "dateiendung kann nicht vergeben werden"

End If

NewDocPath = Zielverzeichnis & newdocname & Dateiendnung

If DRWken = 1 Then

longstatus = SwDoc.SaveAs3(NewDocPath, 0, 2)

Set SwDoc = Swapp.ActiveDoc
    Set SwDoc = Swapp.OpenDoc6(PfadDRW, 3, 0, "", Fileerror, Filewarning)
        Swapp.ActivateDoc SwDoc.GetPathName
        NewDrawPath = Zielverzeichnis & newdocname & ".SLDDRW"
longstatus = SwDoc.SaveAs3(NewDrawPath, 0, 2)
Swapp.CloseDoc SwDoc.GetPathName

'Set SwDoc = swApp.OpenDoc6(NewDrawPath, 3, 0, "", Fileerror, Filewarning)
'swApp.ActivateDoc SwDoc.GetPathName

Bret = Swapp.ReplaceReferencedDocument(NewDrawPath, PfadPRTASM, NewDocPath)
    Debug.Assert Bret

'Set SwDoc = swApp.OpenDoc6(NewDrawPath, 3, 0, "", Fileerror, Filewarning)
'swApp.ActivateDoc SwDoc.GetPathName

Else

longstatus = SwDoc.SaveAs3(NewDocPath, 0, 2)
Swapp.CloseDoc SwDoc.GetPathName

End If

End Function

---

Jetzt sin die neuen Teile abgelegt und ich sollte die jetzt ja noch ersetzen. wenn ich nach der Funktion die Teile ersetzen will, geht das nicht, da die Baugruppe aus der die Teile kopiert werden ja noch geöffnet ist.

Mein Ansatz wäre die Pfade "Altesteil" und "neuesTeil" in ein Array oder ein ExcelFile zu schreiben und im Nachgang, wenn alles geschlossen ist zu ersetzen.

Array und Excel bekomm ich aber iwie nicht hin... 

Ich hab auch noch den Fall, dass mehrere Teile aus der Baugruppe auf eine Zeichnung referenziert werden. Wie kann ich das ersetzen?

Habt ihr eine Idee wie das einfacher geht?

Vielen Dank schonmal

Gruß Pete

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

---

Um ein Array mit Dateipfaden zu bekommen, würde ich kein Excel nutzen:

Code:

---

Function getArrayOfFiles(ByVal strDateipfad As String) As String()

Dim objFileSystem As FileSystemObject
Dim objVerzeichnis As Folder
Dim cFiles As Files
Dim objDatei As File
Dim i As Long
 
Set objFileSystem = New FileSystemObject '  CreateObject("Scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder(strDateipfad)

Dim FileList() As String
ReDim FileList(objVerzeichnis.Files.Count - 1)
Dim sFile As File
i = 0
For Each sFile In objVerzeichnis.Files
    FileList(i) = sFile.Path
    i = i + 1
Next sFile
getArrayOfFiles = FileList
End Function

Sub test()
Dim Liste() As String
Liste = getArrayOfFiles("c:\tmp")
End Sub

---

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