Hallo allemaal,
We gebruiken de revisietabellen in de MEP's om de revisieindex te verhogen en de aangebrachte wijzigingen te noteren.
Dus bevindt de revisie-eigenschap zich in het MEP-bestand.
Is het mogelijk om deze eigenschap van de MEP-revisie-index te koppelen aan een eigenschap in het onderdeel of de assemblage, om deze bijvoorbeeld aan de stukstukken toe te voegen?
Alvast bedankt.
Fijne dag
Hallo @remrem, het is een tijd geleden... 
Als je toegang hebt tot de MyCadTools-suite, kun je met de Smartproperties-tool dit doen:
Maar ik raad het helemaal niet aan, deze functie heeft geen concept van " Automatische Update".
=> Als de tekening wordt bijgewerkt met een nieuwe index, moet je de Smartproperties op deze tekening opnieuw starten en vervolgens de bijbehorende 3D openen en de Smartproperties opnieuw starten... Dit is een enorme kans op fouten.
Hallo remrem,
Ik denk dat het niet aan te raden is om 3D te indexeren. Zoals alleen de 3D al zei.
Wat we doen om een 3D via een WWTP naar klanten te sturen door het te hernoemen met de index en de datum van aanmaak van de WWTP.
Gebruik anders een PLM om dit allemaal te beheren...
Het is aan jou.
@+.
AR.
Ja. Inderdaad. Ik ben terug. 
Ik heb de MyCadTools-suite niet...
Het doel is inderdaad om fouten te beperken.
Ik begrijp je antwoord eigenlijk niet.
Als 3D een leuke tijd is, waarom zou je dan niet 3D indexeren?
Er is dan een risico op fouten.
dus ik raad je aan om een hernoemde WWTP te maken met de index en de datum van voltooiing.
Daar ga je...
@+.
AR.
Hallo,
In ons land (zelfs als we Solidworks PDM hebben) is het de 3D die de index in zijn eigenschappen bevat.
De informatie wordt in de tekeningseigenschappen gedupliceerd, hetzij via macro of via de kluis.
Dan hebben we ook macro's die de informatie uit de indexeigenschap ophalen om exportnamen te formatteren (STEP, IGES, STL...)
Bedankt voor je antwoord, je gebruikt geen revisietabellen?
Nee, nooit geïmplementeerd
Daarom staat mijn herziening in de MEP.
Wanneer een nieuwe rij in de tabel wordt aangemaakt, wordt de eigenschap " Revisie " automatisch verhoogd. Maar het staat in het Europarlement.
Hallo
Maar wat als de fout uit het plan komt, maar niet uit de 3D?
Thuis is het ingewikkeld geworden 
Er is een kamerindex en een plattegrondindex.
We geven op de algemene plattegronden in de nomenclatuur de index van het stuk aan. En ook in de detailfoto's.
Deze informatie is onafhankelijk van elkaar.
Als het 3D-gedeelte verandert, evolueert het 3D en gaat het plan onvermijdelijk ook omhoog.
Als het plan evolueert (bijvoorbeeld een nota of iets dergelijks), gaat het plan dan omhoog per index maar niet per stuk?
Je kunt het subscript van het plan en de kamer koppelen, je moet een aangepaste property chain recreëren met een term die anders is dan het subscript van het plan. Dat gezegd hebbende, zal de planindex blijven bestaan. Je moet tekst die gekoppeld is aan een eigenschap opnieuw aanmaken in het titelblok en in de revisiebalk.
Hallo,
Bij ons is het net als @Cyril_f : het is de 3D die de aanwijzing draagt (wat daardoor makkelijk te vinden is in de 2D).
NB: in de praktijk hebben de twee een index die parallel gemonteerd is, maar de belangrijkste blijft die van 3D.
Om @FRED78's vraag te beantwoorden, plaatsen we een hint op de 3D, zelfs als de aanpassing alleen in de praktijk op de 2D wordt gedaan (zoals het toevoegen van een nota), omdat een klein nootje een grote impact op het onderdeel kan hebben (zelfs als de 3D-geometrie niet verandert).
Wat is de string om deze eigenschap te binden?
Misschien voor het verkeerde doel gebruikt, ik dacht aan een keten van 3D naar MEP, onderdeel - assemblage, montage - plan. En om een link (de aanwijzing) van 3D naar 2D door te sturen.
Maar waarschijnlijk heb ik mezelf slecht uitgedrukt
Hier is een macro die de eigenschap " Revisie" van het onderdeel of de assemblage vervangt door de eigenschap "Revisie " van de MEP.
Option Explicit
Dim PrtPath As String
Dim AsmPath As String
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swDrawModel As SldWorks.ModelDoc2
Dim swDrawModelDocExt As ModelDocExtension
Dim swDrawCustProp As CustomPropertyManager
Dim swDrawDoc As SldWorks.DrawingDoc
Dim swDrawView As SldWorks.View
Dim DrawVal As String
Dim DrawRevision As String
Dim DrawBool As Boolean
Dim swRefModel As SldWorks.ModelDoc2
Dim swRefPath As String
Dim swRefModelDocExt As ModelDocExtension
Dim swRefCustProp As CustomPropertyManager
Dim RefReturn As Integer
Dim RefBool As Boolean
Dim RefVal As String
Dim RefRevision As String
Dim RefDocType As swDocumentTypes_e
Dim FileError As Long
Dim FileWarning As Long
Set swApp = Application.SldWorks
Set swDrawModel = swApp.ActiveDoc
If swDrawModel Is Nothing Then
swApp.SendMsgToUser2 "Ouvrir un fichier mise en plan", swMbWarning, swMbOk
Exit Sub
End If
If swDrawModel.GetType <> swDocDRAWING Then 'swDocASSEMBLY, swDocPART
swApp.SendMsgToUser2 "Ouvrir un fichier mise en plan", swMbWarning, swMbOk
Exit Sub
Else
RefDocType = RefDocTypeSearch(swDrawModel.GetPathName)
Select Case RefDocType
Case swDocPART
Set swRefModel = swApp.OpenDoc6(PrtPath, swDocPART, swOpenDocOptions_Silent, "", FileError, FileWarning)
Debug.Print "PrtPath = " & PrtPath
Debug.Print "FileError = " & FileError
Debug.Print "FileWarning = " & FileWarning
Case swDocASSEMBLY
Set swRefModel = swApp.OpenDoc6(AsmPath, swDocASSEMBLY, swOpenDocOptions_Silent, "", FileError, FileWarning)
Debug.Print "AsmPath = " & AsmPath
Debug.Print "FileError = " & FileError
Debug.Print "FileWarning = " & FileWarning
End Select
If Not swRefModel Is Nothing Then
swRefPath = swRefModel.GetPathName
If IsFileExist(swRefModel.GetPathName) Then
Set swDrawModelDocExt = swDrawModel.Extension
Set swDrawCustProp = swDrawModelDocExt.CustomPropertyManager("")
DrawBool = swDrawCustProp.Get4("Révision", False, DrawVal, DrawRevision)
Debug.Print "DrawBool = " & DrawBool
Debug.Print "DrawRevision = " & DrawRevision
Set swRefModelDocExt = swRefModel.Extension
Set swRefCustProp = swRefModelDocExt.CustomPropertyManager("")
RefReturn = swRefCustProp.Set("Révision", DrawRevision)
Debug.Print "RefReturn = " & RefReturn
RefBool = swRefCustProp.Get4("Révision", False, RefVal, RefRevision)
Debug.Print "RefModelPath = " & swRefModel.GetPathName
Debug.Print "RefBool = " & RefBool
Debug.Print "RefRevision = " & RefRevision
End If
End If
End If
End Sub
Function RefDocTypeSearch(DrawPath As String) As swDocumentTypes_e
Dim DrawPathLow As String
DrawPathLow = LCase(DrawPath)
Debug.Print "DrawPath = " & DrawPath
Debug.Print "DrawPathLow = " & DrawPathLow
PrtPath = Replace(DrawPathLow, "slddrw", "sldprt")
AsmPath = Replace(DrawPathLow, "slddrw", "sldasm")
If IsFileExist(PrtPath) Then
RefDocTypeSearch = swDocPART
Exit Function
End If
If IsFileExist(AsmPath) Then
RefDocTypeSearch = swDocASSEMBLY
End If
End Function
Function IsFileExist(FullName As String) As Boolean
' Vérifie l'existence d'un fichier
IsFileExist = Dir(FullName) <> ""
End Function
Assembly-, part- en MEp-bestanden moeten in dezelfde map liggen
Gefeliciteerd met je verjaardag van Forum @remrem 
!
Bedankt voor het delen van de macro. (Het belangrijkste is om te onthouden het regelmatig te lanceren).
Wees voorzichtig voor degenen die " Revisie " gebruiken (zonder accent), het zal nodig zijn de code licht aan te passen...
Dank je.
Ik schreef me in 2013 in en had al wit haar 
Gefeliciteerd met je verjaardag op het forum, een van de zeer zeldzame, veel oudere dan ik!
En voor mij nog steeds heel weinig wit haar! 
@remrem heb ik de vrijheid genomen om bij jouw macro te beginnen en het iets meer " universeel " te maken (geef mij niet de schuld).
De veranderingen richten zich voornamelijk op dubbel lezen
" Revisie" versus " Revisie ".
Ik gebruikte ook de " Perplexity " AI om tekstreacties toe te voegen (AI's zijn hier nog steeds alleen goed in, maar het is nog steeds heel praktisch).
In theorie is de compatibiliteit met de Solidworks > versie van 2022 ook verhoogd. (maar ik kan het niet testen!).
Tip:
Voor degenen die de " Mycad " Suite bezitten, zou deze versie compatibel moeten zijn met het gebruik ervan in Smartproperties (en dus automatisch te automatiseren bij het sluiten van het Smartproperties-venster (voor het geval je revisies met deze tool worden gegenereerd).
Dit zou het risico op slechte revisie tussen 3D en tekeningen aanzienlijk moeten verminderen...
Voorbeeld:
Option Explicit
' =====================================================
' DÉCLARATIONS GLOBALES
' =====================================================
' Ces variables globales stockent les chemins des fichiers pièce (.sldprt) et assemblage (.sldasm)
' détectés automatiquement à partir du chemin de la mise en plan (.slddrw).
' Pourquoi globales ? Pour qu'elles soient accessibles par toutes les fonctions de la macro.
Dim PrtPath As String ' Chemin complet vers la pièce référencée
Dim AsmPath As String ' Chemin complet vers l'assemblage référencé
' =====================================================
' PROCÉDURE PRINCIPALE : main()
' =====================================================
' BUT : Synchroniser la propriété "Révision/Revision" de la mise en plan vers son modèle référencé
' (pièce ou assemblage). Fonctionne avec SolidWorks 2022 et ses spécificités API.
Sub main()
On Error GoTo GestionErreur ' Gestion centralisée des erreurs
' =====================================================
' DÉCLARATION DES OBJETS SOLIDWORKS
' =====================================================
' swApp : Instance principale de SolidWorks (toujours accessible via Application.SldWorks)
Dim swApp As SldWorks.SldWorks
' swDrawModel : Document actif (la mise en plan)
Dim swDrawModel As SldWorks.ModelDoc2
' Extensions et gestionnaires de propriétés personnalisées
Dim swDrawModelDocExt As ModelDocExtension
Dim swDrawCustProp As CustomPropertyManager
' Modèle référencé (pièce ou assemblage à synchroniser)
Dim swRefModel As SldWorks.ModelDoc2
Dim swRefModelDocExt As ModelDocExtension
Dim swRefCustProp As CustomPropertyManager
Dim RefDocType As swDocumentTypes_e ' Type du document référencé
' =====================================================
' VARIABLES UTILITAIRES
' =====================================================
Dim DrawRevision As String ' Valeur de révision dans la mise en plan
Dim RefRevision As String ' Valeur de révision dans le modèle
Dim PropName As String ' Nom exact de la propriété (ex: "Revision" ou "Révision")
Dim FileError As Long ' Code d'erreur ouverture fichier
Dim FileWarning As Long ' Code d'avertissement ouverture fichier
Dim Msg As String ' Message informatif
Dim addRes As Long ' Résultat de l'ajout de propriété
' =====================================================
' ÉTAPE 1 : CONNEXION À SOLIDWORKS ET VÉRIFICATIONS
' =====================================================
Set swApp = Application.SldWorks ' Récupère l'instance SolidWorks courante
Set swDrawModel = swApp.ActiveDoc ' Document actif = mise en plan
' Vérification : un document doit être actif
If swDrawModel Is Nothing Then
swApp.SendMsgToUser2 "Aucun document actif. Ouvrez une mise en plan.", swMbWarning, swMbOk
Exit Sub
End If
' Vérification : le document actif DOIT être une mise en plan (.slddrw)
If swDrawModel.GetType <> swDocDRAWING Then
swApp.SendMsgToUser2 "Le document actif n'est pas une mise en plan.", swMbWarning, swMbOk
Exit Sub
End If
' =====================================================
' ÉTAPE 2 : DÉTECTION DU MODÈLE RÉFÉRENCÉ
' =====================================================
' Recherche automatique du fichier .sldprt ou .sldasm correspondant au .slddrw
RefDocType = RefDocTypeSearch(swDrawModel.GetPathName)
If RefDocType = 0 Then
swApp.SendMsgToUser2 "Aucun modèle référencé trouvé (.sldprt ou .sldasm).", swMbWarning, swMbOk
Exit Sub
End If
' =====================================================
' ÉTAPE 3 : OUVERTURE SILENCIEUSE DU MODÈLE
' =====================================================
' Ouverture sans interface utilisateur (swOpenDocOptions_Silent)
Select Case RefDocType
Case swDocPART ' Pièce
Set swRefModel = swApp.OpenDoc6(PrtPath, swDocPART, swOpenDocOptions_Silent, "", FileError, FileWarning)
Case swDocASSEMBLY ' Assemblage
Set swRefModel = swApp.OpenDoc6(AsmPath, swDocASSEMBLY, swOpenDocOptions_Silent, "", FileError, FileWarning)
End Select
' Vérification ouverture réussie
If swRefModel Is Nothing Or FileError <> 0 Then
swApp.SendMsgToUser2 "Échec ouverture modèle.", swMbStop, swMbOk
Exit Sub
End If
' =====================================================
' ÉTAPE 4 : LECTURE PROPRIÉTÉS M ISE EN PLAN
' =====================================================
Set swDrawModelDocExt = swDrawModel.Extension
Set swDrawCustProp = swDrawModelDocExt.CustomPropertyManager("") ' Propriétés document ("" = niveau document)
' DÉTECTION INTELLIGENTE du nom exact de la propriété révision
PropName = DetectRevisionPropertyFixed(swDrawCustProp)
Debug.Print "=== PROPNAME FINAL : '" & PropName & "' ===" ' Debug pour développeur
If PropName = "" Then
swApp.SendMsgToUser2 "Aucune propriété Révision/Revision trouvée.", swMbStop, swMbOk
GoTo NettoyageSimple
End If
' Lecture de la valeur (avec fallback si vide)
If Not GetCustomPropValue(swDrawCustProp, PropName, DrawRevision) Then
DrawRevision = "NON_RENSEIGNÉ" ' Valeur par défaut
Debug.Print "Valeur mise en plan vide ? fallback"
End If
Debug.Print "Valeur À SYNCHRONISER : '" & DrawRevision & "'"
' =====================================================
' ÉTAPE 5 : ACCÈS PROPRIÉTÉS MODÈLE RÉFÉRENCÉ
' =====================================================
Set swRefModelDocExt = swRefModel.Extension
Set swRefCustProp = swRefModelDocExt.CustomPropertyManager("") ' Propriétés du modèle
' =====================================================
' ÉTAPE 6 : SYNCHRONISATION (CRU DE LA MACRO)
' =====================================================
Debug.Print "--- DÉBUT SYNCHRO ---"
' ? IMPORTANT SolidWorks 2022 : Force la reconstruction pour rafraîchir les propriétés
swRefModel.ForceRebuild3 False ' False = ne pas afficher les messages
' Test 1 : La propriété existe-t-elle déjà dans le modèle ?
If GetCustomPropValue(swRefCustProp, PropName, RefRevision) Then
Debug.Print " ? Propriété existe : '" & RefRevision & "'"
If RefRevision <> DrawRevision Then
Debug.Print " ? MISE À JOUR nécessaire"
' Mise à jour de la valeur existante
Dim setRes As Long
setRes = swRefCustProp.Set2(PropName, DrawRevision) ' Set2 = mise à jour
Debug.Print " ? Set2 retour : " & setRes
If setRes = 0 Then
Msg = "? " & PropName & " mise à jour : " & DrawRevision
Else
Msg = "? Échec mise à jour " & PropName
End If
Else
Msg = "? Déjà OK : " & PropName & " = " & DrawRevision
End If
Else
Debug.Print " ? CRÉATION propriété manquante"
' Création avec Add2 (stable sur SolidWorks 2022)
addRes = swRefCustProp.Add2(PropName, swCustomInfoText, DrawRevision)
Debug.Print " ? Add2 retour : " & addRes
If addRes = 0 Or addRes = 2 Then ' 0=OK, 2=existe déjà
Msg = "? " & PropName & " créée : " & DrawRevision
Else
' Fallback Add3 si Add2 échoue
addRes = swRefCustProp.Add3(PropName, swCustomInfoText, DrawRevision, 0)
Debug.Print " ? Add3 fallback retour : " & addRes
If addRes = 0 Or addRes = 2 Then
Msg = "? " & PropName & " créée (Add3) : " & DrawRevision
Else
Msg = "? ÉCHEC création " & PropName & " (Add2=" & addRes & ", Add3=" & addRes & ")"
End If
End If
End If
' Debug.Print "--- SYNCHRO TERMINÉE : " & Msg & " ---"
' swApp.SendMsgToUser2 Msg, swMbInformation, swMbOk ' Décommentez pour voir le résultat
' =====================================================
' NETTOYAGE : FERMETURE MODÈLE
' =====================================================
NettoyageSimple:
If Not swRefModel Is Nothing Then
On Error Resume Next ' Ignore erreurs de fermeture
swApp.CloseDoc swRefModel.GetPathName ' Ferme sans sauvegarde
On Error GoTo 0 ' Restaure gestion erreurs normale
End If
Exit Sub
' =====================================================
' GESTION D'ERREUR CENTRALE
' =====================================================
GestionErreur:
swApp.SendMsgToUser2 "Erreur : " & Err.Description, swMbStop, swMbOk
Debug.Print "ERREUR # " & Err.Number & " : " & Err.Description
Resume NettoyageSimple ' Nettoyage avant sortie
End Sub
' =====================================================
' FONCTION : DetectRevisionPropertyFixed()
' =====================================================
' BUT : Détecte intelligemment le nom exact de la propriété révision
' Teste d'abord "Revision" ? "Révision" ? scan complet des propriétés
Function DetectRevisionPropertyFixed(CustMgr As CustomPropertyManager) As String
Dim propNames As Variant
Dim i As Long
Dim PropName As String
Dim propVal As String
Debug.Print "=== SCAN COMPLET ==="
' 1?? PRIORITÉ 1 : Test direct "Revision" (standard anglais)
If CustMgr.Get4("Revision", False, "", propVal) Then
DetectRevisionPropertyFixed = "Revision"
Debug.Print "? DIRECT : Revision"
Exit Function
End If
' 2?? PRIORITÉ 2 : Test "Révision" (standard français)
If CustMgr.Get4("Révision", False, "", propVal) Then
DetectRevisionPropertyFixed = "Révision"
Debug.Print "? DIRECT : Révision"
Exit Function
End If
' 3?? PRIORITÉ 3 : Scan complet de TOUTES les propriétés
propNames = CustMgr.GetNames ' Tableau des noms de propriétés
Debug.Print "Nb props: " & IIf(IsEmpty(propNames), 0, UBound(propNames) + 1)
If Not IsEmpty(propNames) Then
For i = 0 To UBound(propNames)
PropName = CStr(propNames(i))
Debug.Print "Prop " & i & ": '" & PropName & "'"
' Recherche insensible à la casse contenant "revision"
If InStr(LCase(PropName), "revision") > 0 Then
DetectRevisionPropertyFixed = PropName
Debug.Print "? TROUVÉ : '" & PropName & "'"
Exit Function
End If
Next i
End If
Debug.Print "? RIEN TROUVÉ"
DetectRevisionPropertyFixed = "" ' Aucune propriété trouvée
End Function
' =====================================================
' FONCTION : GetCustomPropValue()
' =====================================================
' BUT : Lit une propriété personnalisée avec gestion des valeurs vides
' RETOUR : True si propriété existe, False sinon
Function GetCustomPropValue(CustMgr As CustomPropertyManager, PropName As String, ByRef PropValue As String) As Boolean
Dim res As Boolean
Dim valOut As String, valEval As String ' valEval = valeur évaluée (résolue)
On Error Resume Next ' Ignore erreurs Get4
res = CustMgr.Get4(PropName, False, valOut, valEval) ' Lecture propriété
On Error GoTo 0 ' Restaure gestion erreurs
Debug.Print " Get4('" & PropName & "') ? res=" & res & " | val='" & valEval & "'"
If res Then
PropValue = IIf(valEval = "", "VIDE", valEval) ' Gère les valeurs vides
GetCustomPropValue = True
Else
PropValue = ""
GetCustomPropValue = False
End If
End Function
' =====================================================
' FONCTION : RefDocTypeSearch()
' =====================================================
' BUT : Détecte si le chemin .slddrw pointe vers .sldprt OU .sldasm
' Remplit les variables globales PrtPath/AsmPath
Function RefDocTypeSearch(DrawPath As String) As swDocumentTypes_e
Dim DrawPathLow As String
DrawPathLow = LCase(DrawPath) ' Minuscules pour comparaison
' Conversion automatique des noms de fichiers
PrtPath = Replace(DrawPathLow, "slddrw", "sldprt") ' Mise en plan ? Pièce
AsmPath = Replace(DrawPathLow, "slddrw", "sldasm") ' Mise en plan ? Assemblage
Debug.Print "Test pièce : " & PrtPath & " ? " & IIf(IsFileExist(PrtPath), "OK", "KO")
Debug.Print "Test assem : " & AsmPath & " ? " & IIf(IsFileExist(AsmPath), "OK", "KO")
If IsFileExist(PrtPath) Then
RefDocTypeSearch = swDocPART
Exit Function
End If
If IsFileExist(AsmPath) Then
RefDocTypeSearch = swDocASSEMBLY
End If ' Retourne 0 si aucun fichier trouvé
End Function
' =====================================================
' FONCTION UTILITAIRE : IsFileExist()
' =====================================================
' BUT : Teste l'existence d'un fichier sur disque
Function IsFileExist(FullName As String) As Boolean
IsFileExist = (Dir(FullName) <> "") ' VBA standard : Dir retourne "" si fichier inexistant
End Function
Ik geef je geen ongelijk.
AI is goed, maar begrijp je wat het doet?
De reacties bevatten soms vragen omdat ze niet alles begrijpt en sommige dingen prikken in mijn ogen, zoals de " On error ", die vermeden moet worden omdat het niet mogelijk is de defecten te lokaliseren.
Mijn code is zeker niet uitputtend, maar het foutbeheer door het beheren ervan stelt me in staat (het wordt verwacht) om de gebruiker te waarschuwen op basis van de fouten.