MACRO - vervang het sjabloon van de ene tekening door een andere

Macro
1

Hallo

Ik ben bezig met het maken van een macro waarmee ik het model dat in de ene tekening wordt gebruikt, kan vervangen door een andere, deze code zal worden geïntegreerd in een andere grotere code die bestaat uit het maken van een automatische kopie van een bibliotheekonderdeel om het met één klik om te zetten in een aangepast onderdeel om op te slaan in de hoofdassemblagemap. alles werkt, het onderdeel is goed gekopieerd, wordt goed vervangen in de montage door het nieuwe, het plan is goed gekopieerd, maar het plan behoudt de link naar het oude onderdeel, dus ik moet het referentiedocument wijzigen, dit is waar het blokkeert, ik kan het niet correct gebruiken. ReplaceReferencedDocument( ) of . SetReferencedModelName correct denk ik.

Ik kan niet veel informatie over dit onderwerp vinden in VBA.

Hier is mijn stukje code, newplanpath en oldpartpath zijn de volledige paden van mijn oude en nieuwe deel:

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

Het opent het plan voor mij, maar vervangt helemaal niets... Ik heb andere methoden getest, zoals het doorbladeren van alle weergaven en het vervangen van voor elke weergave het referentiemodel, maar het werkt ook niet...

Bedankt voor je hulp.

2

Ik heb deze macro die een onderdeel indexeert (behalve zoals in een eerdere functie naar de aangegeven functie) en de tekening kopieert, bekijk het en laat me inspireren door dit stukje 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

Bedankt, ik zal dat onderzoeken. Ik zal het je vertellen als ik vragen heb.

1 like
4

Hartelijk dank! Het werkt, ik denk dat mijn swapp slecht gedefinieerd was. Bedankt.

5

Bij voorkeur vbNullString à ""versnelt het de code en vermindert het het gebruik van bronnen (vooral in loops).

1 like
6

Bedankt @Sylk voor het advies!

1 like
7

Een andere best practice, om dezelfde redenen, is om strings (en andere terugkerende waarden) toe te kennen aan een constante en deze constante te gebruiken in de code, in dit geval de bestandsextensie ".SLDDRW" met bijvoorbeeld Const SLDDRW As String = ".SLDDRW"

Dit geeft dit:

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