MAKRO - zamień szablon jednego rysunku na inny

Macro
1

Witam

Jestem w trakcie tworzenia makra, które pozwoliłoby mi zastąpić model używany w jednym rysunku innym, ten kod zostanie zintegrowany z innym większym kodem, który polega na wykonaniu automatycznej kopii części bibliotecznej, aby jednym kliknięciem przekształcić ją w część niestandardową do zapisania w głównym folderze zespołu. wszystko działa, część jest dobrze skopiowana, jest dobrze zastąpiona w zespole nową, plan jest dobrze skopiowany, ale plan zachowuje link do starej części, więc muszę zmodyfikować dokument referencyjny, to jest miejsce, w którym blokuje się, których nie mogę poprawnie użyć. ReplaceReferencedDocument( ) lub . Myślę, że SetReferencedModelName poprawnie.

Nie mogę znaleźć zbyt wielu informacji na ten temat w VBA.

Oto mój fragment kodu, newplanpath i oldpartpath to kompletne ścieżki mojej starej i nowej części:

Dim referencesUpdated As Boolean

If fso.FileExists(newPlanPath) Then
    ' Ouvrir le plan
    Set swDraw = swApp.OpenDoc6(newPlanPath, swDocDRAWING, swOpenDocOptions_Silent, "", 0, 0)
    
    If Not swDraw Is Nothing Then
        ' Modifier la référence du fichier
        referencesUpdated = swDraw.ReplaceReferencedDocument(oldPartPath, newPartPath)

        ' Sauvegarde et fermeture du plan
        swDraw.Save
        swApp.CloseDoc newPlanPath

Otwiera przede mną plan, ale niczego nie zastępuje... Przetestowałem inne metody, takie jak przeglądanie wszystkich widoków i zastępowanie dla każdego widoku modelu referencyjnego, ale to też nie działa...

Dziękuję za pomoc.

2

Mam takie makro, które indeksuje część (zapisuje jak w poprzedniej funkcji do wskazanej) i kopiuje jej rysunek, spójrz na niego i zainspiruj się tym fragmentem kodu:

Function incrementationIndicePlan()
    Debug.Print "   Function incrementationIndicePlan lancé"
   'on vérifie si un indice est existant et on sauvegarde l'ancien
    OldIndice = Indice
    Debug.Print "OldIndice:" & OldIndice
    'Maj 2023-06-12 Si Indice = " " on force l'Indice pour avoir la valeur A
    If Indice = "" Or Indice = " " Then
        Indice = "A"
        Debug.Print "Indice non existant- Indice passe à:" + Indice
        Debug.Print "OldIndice:" & OldIndice
        Else
        Indice = Chr$(Asc(Indice) + 1)
        Debug.Print "Indice:" + Indice
        Debug.Print "OldIndice:" & OldIndice
    End If
    
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    path = Filepath + Compteur + Indice + Extension
    Debug.Print "Path:"; path
    'On vérifie que l'indice que l'on veux créer n'existe pas déjà
     If Dir(path) <> "" Then
     MsgBox "Le fichier " & path & " existe déjà. Création de cet Indice refusé."
     End
     End If
    
    'on modifie les propriétées Indice et Nom_Fichier
    Set swCustProp = swModel.Extension.CustomPropertyManager("")
    bRet = swCustProp.Add3("Indice", swCustomInfoType_e.swCustomInfoText, Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
    Debug.Print "Propriété Indice:" & Indice
    bRet = swCustProp.Add3("Nom_Fichier", swCustomInfoType_e.swCustomInfoText, Compteur + Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
    'Debug.Print "Propriété Nom_Fichier:" & Compteur + Indice
    
    'On enregistre la nouvelle pièce ou assemblage
    swModel.SaveAs3 "" & path & "", 0, 0
    
    'On vérifie l'existance de la MEP associé
    PathMep = Filepath + Compteur
    Debug.Print Filepath + Compteur & OldIndice; ".SLDDRW"
    If Dir(PathMep & OldIndice & ".SLDDRW") <> "" Then
        Call fso.CopyFile(PathMep & OldIndice & ".SLDDRW", PathMep & Indice & ".SLDDRW")
        Set swApp = Application.SldWorks
        'On change la référence du nouveau plan par la pièce ou assemblage avec le nouvel Indice
        Call swApp.ReplaceReferencedDocument(PathMep & Indice & ".SLDDRW", PathMep & OldIndice & Extension, PathMep & Indice & Extension)
    Else
    Debug.Print "Pas de Mep"
    End If
   
    
End Function
2 polubienia
3

Dziękuję, zajmę się tym. Powiem Ci, jeśli będę miał jakieś pytania.

1 polubienie
4

Dziękuję bardzo! To działa, myślę, że mój swapp był źle zdefiniowany. Dziękuję.

5

Preferuje, vbNullString à ""przyspiesza kod i zmniejsza używane zasoby (szczególnie w pętlach).

1 polubienie
6

Dziękuję @Sylk za radę!

1 polubienie
7

Innym najlepszym rozwiązaniem, z tych samych powodów, jest przypisanie ciągów (i innych powtarzających się wartości) do stałej i użycie tej stałej w kodzie, w tym przypadku rozszerzenia pliku ".SLDDRW" z na przykład Const SLDDRW As String = ".SLDDRW"

Daje to to:

Const SLDDRW As String = ".SLDDRW"

Function incrementationIndicePlan()
    Debug.Print "   Function incrementationIndicePlan lancé"
    'on vérifie si un indice est existant et on sauvegarde l'ancien
    OldIndice = Indice
    Debug.Print "OldIndice:" & OldIndice
    'Maj 2023-06-12 Si Indice = " " on force l'Indice pour avoir la valeur A
    If Indice = vbNullString Or Indice = " " Then
        Indice = "A"
        Debug.Print "Indice non existant- Indice passe à:" + Indice
        Debug.Print "OldIndice:" & OldIndice
        Else
        Indice = Chr$(Asc(Indice) + 1)
        Debug.Print "Indice:" + Indice
        Debug.Print "OldIndice:" & OldIndice
    End If
    
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    path = Filepath + Compteur + Indice + Extension
    Debug.Print "Path:"; path
    'On vérifie que l'indice que l'on veux créer n'existe pas déjà
     If Dir(path) <> vbNullString Then
     MsgBox "Le fichier " & path & " existe déjà. Création de cet Indice refusé."
     End
     End If
    
    'on modifie les propriétées Indice et Nom_Fichier
    Set swCustProp = swModel.Extension.CustomPropertyManager(vbNullString)
    bRet = swCustProp.Add3("Indice", swCustomInfoType_e.swCustomInfoText, Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
    Debug.Print "Propriété Indice:" & Indice
    bRet = swCustProp.Add3("Nom_Fichier", swCustomInfoType_e.swCustomInfoText, Compteur + Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
    'Debug.Print "Propriété Nom_Fichier:" & Compteur + Indice
    
    'On enregistre la nouvelle pièce ou assemblage
    swModel.SaveAs3 vbNullString & path & vbNullString, 0, 0
    
    'On vérifie l'existance de la MEP associé
    PathMep = Filepath + Compteur
    Debug.Print Filepath + Compteur & OldIndice; SLDDRW
    If Dir(PathMep & OldIndice & SLDDRW) <> vbNullString Then
        Call fso.CopyFile(PathMep & OldIndice & SLDDRW, PathMep & Indice & SLDDRW)
        Set swApp = Application.SldWorks
        'On change la référence du nouveau plan par la pièce ou assemblage avec le nouvel Indice
        Call swApp.ReplaceReferencedDocument(PathMep & Indice & SLDDRW, PathMep & OldIndice & Extension, PathMep & Indice & Extension)
    Else
    Debug.Print "Pas de Mep"
    End If
   
    
End Function