MACRO - replace the template of one drawing with another

Macro
1

Hello

I'm in the process of making a macro that would allow me to replace the model used in one drawing with another, this code will be integrated into another larger code which consists of making an automatic copy of a library part to transform it in one click into a custom part to save in the main assembly folder. everything works the part is copied well, is replaced well in the assembly by the new one, the plan is well copied but the plan keeps the link to the old part so I have to modify the reference document is this is where it blocks I can't use correctly. ReplaceReferencedDocument( ) or . SetReferencedModelName correctly I think.

I can't find much information on this subject in VBA.

Here's my snippet of code, newplanpath and oldpartpath are the complete paths of my old and new part:

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

it opens up the plan for me but doesn't replace anything at all... I have tested other methods such as browsing all the views and replacing for each view the reference model but it doesn't work either...

Thank you for your help.

2

I have this macro that indexes a part (save as in a previous function to the one indicated) and copies its drawing, look at it and get inspired by this piece of code:

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 Likes
3

Thank you, I'll look into that. I'll tell you if I have any questions.

1 Like
4

Thank you very much! It works, I think my swapp was poorly defined. Thank you.

5

Prefer, vbNullString à ""it speeds up the code and reduces the resources used (especially in loops).

1 Like
6

Thank you @Sylk for the advice!

1 Like
7

Another best practice, for the same reasons, is to assign strings (and other recurring values) to a constant and to use this constant in the code, in this case the file ".SLDDRW" extension with for example Const SLDDRW As String = ".SLDDRW"

This gives this:

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