je suis en train de réaliser une macro qui me permettrait de remplacer le modèle utilisé dans une mise en plan par un autre, ce code s’intègrera dans un autre code plus important qui consiste à faire une copie automatique d’une pièce de bibliothèque pour la transformer en un clic en pièce sur mesure enregistrer dans le dossier de l’assemblage principal. tout fonctionne la part se copie bien, se remplace bien dans ll’assemblage par la nouvelle, le plan est bien copié mais le plan conserve le lien vers l’ancienne pièce je dois donc modifier le document de référence est c’est la que ça bloque je n’arrive pas à utiliser correctement .ReplaceReferencedDocument( ) ou .SetReferencedModelName correctement je pense.
je ne trouve pas beaucoup d’infos sur ce sujet en vba.
Voici mon bout de code, newplanpath et oldpartpath sont les chemins complets de mon ancienne et nouvelle pièce :
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
cela m’ouvre bien le plan mais ne remplace rien du tout…j’ai tester d’autre methodes comme parcourir toute les vues et remplacer pour chaque vue le modèle de référece mais cela ne fonctionne pas non plus…
J’ai cette macro qui indice une pièce (enregistrer sous dans une fonction précédente à celle indiqué) et copie sa mise en plan regarde le et inspire toi de ce bout de 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
Une autre bonne pratique, pour les mêmes raisons, est d’assigner des strings (et autres valeurs récurrentes) à une constante et d’utiliser cette constante dans le code, ici l’extension du fichier ".SLDDRW" avec par exemple Const SLDDRW As String = ".SLDDRW"
Ce qui donne ceci :
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