Cześć wszystkim,
Używamy tabel rewizji w europosłach, aby zwiększyć indeks rewizji i notować wprowadzone zmiany.
W ten sposób właściwość rewizji znajduje się w pliku MEP.
Czy możliwe jest powiązanie tej właściwości indeksu rewizji MEP z właściwością w części lub zespole, aby dodać ją na przykład do dokumentów?
Z góry dziękuję.
Miłego dnia
Cześć @remrem, dawno się nie widzieliśmy... 
Jeśli masz dostęp do pakietu MyCadTools, narzędzie Smartproperties pozwala na to:
Ale wcale tego nie polecam, ta funkcja nie ma pojęcia " Automatycznej Aktualizacji".
=> Jeśli rysunek zostanie zaktualizowany o nowy indeks, będziesz musiał ponownie uruchomić Smartproperties na tym rysunku, a następnie otworzyć powiązane 3D i ponownie uruchomić Smartproperties... To ogromne ryzyko błędu.
Cześć Remrem,
Uważam, że indeksowanie 3D nie byłoby wskazane. Jak mówi tylko 3D.
Co robimy, aby wysłać 3D klientom przez WWTP, zmieniając nazwę na indeks i datę powstania WWTP.
W przeciwnym razie użyj PLM, żeby to wszystko zarządzać...
To zależy od ciebie.
@+.
AR.
Tak. Rzeczywiście. Wróciłem. 
Nie mam pakietu MyCadTools...
Celem jest ograniczenie błędów.
Nie do końca rozumiem twoją odpowiedź.
Jeśli 3D to dobra zabawa, to dlaczego nie zindeksować 3D?
Cóż, istnieje ryzyko błędów.
dlatego radzę zrobić przemianowany WWTP z indeksem i datą zakończenia.
Proszę bardzo...
@+.
AR.
Cześć,
W naszym kraju (nawet jeśli mamy Solidworks PDM) to 3D niesie indeks w swoich właściwościach.
Informacje są powielane w właściwościach rysunku albo za pomocą makra, albo przez vault.
Mamy też makra, które pobierają informacje z właściwości indeksu, aby sformatować nazwy eksportu (STEP, IGES, STL...)
Dziękuję za odpowiedź, nie używasz tabel rewizji?
Nie, nigdy nie wdrożono
Dlatego moja poprawka jest w MEP.
Gdy w tabeli zostanie utworzony nowy wiersz, właściwość " Revizja " jest automatycznie zwiększana. Ale jest w MEP.
Cześć
Ale co jeśli błąd wynika z planu, a nie z 3D?
W domu stało się to skomplikowane 
Jest indeks pokoi i indeks planów.
Na ogólnych planach w nazewnictwie wskazujemy indeks dzieła. I w szczegółowych ujęciach też.
Te informacje są od siebie niezależne.
Jeśli część 3D się zmieni, 3D ewoluuje, a plan nieuchronnie również rośnie.
Jeśli plan ewoluuje (np. nota lub inny), plan rośnie według indeksu, ale nie figura?
Możesz połączyć indeks dolny planu z pokojem, musisz odtworzyć niestandardowy łańcuch nieruchomości z terminem innym niż indeks w planie. Mimo to indeks planów będzie nadal istnieć. Musisz odtworzyć tekst powiązany z właściwością w bloku tytułowym i w pasku rewizji.
Cześć,
U nas jest dokładnie tak jak @Cyril_f : to 3D niesie wskazówkę (którą łatwo odczytać w 2D).
Uwaga: w praktyce oba mają indeks zamontowany równolegle, ale główny pozostaje indeksem 3D.
Aby odpowiedzieć na pytanie @FRED78 , montujemy wskazówkę na 3D, nawet jeśli modyfikacja jest wykonywana tylko w praktyce na 2D (np. dodanie noty), ponieważ mała nota może mieć duży wpływ na element (nawet jeśli geometria 3D się nie zmienia).
Jaki jest ciąg znaków wiążących tę właściwość?
Może użyte do niewłaściwego celu, myślałem o łańcuchu z 3D do MEP, część - montaż, montaż - plan. I przekażę link (wskazówkę) z 3D do 2D.
Ale pewnie źle się wyraziłam
Oto makro, które zastępuje właściwość " Revision" części lub zespołu właściwością "Revision " 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
Pliki asemblera, części i MEp muszą znajdować się w tym samym folderze
Wszystkiego najlepszego z Forum @remrem 
!
Dzięki za podzielenie się makra. (Kluczowe jest, by pamiętać o regularnym uruchamianiu jej na rynku).
Uważajcie na tych, którzy używają " Poprawek " (bez akcentu), będzie konieczne niewielkie zmodyfikowanie kodu...
Dziękuję.
Zapisałem się w 2013 roku i już miałem siwe włosy 
Forum wszystkiego najlepszego – jedno z bardzo rzadkich, dużo starszych ode mnie!
A dla mnie wciąż bardzo mało siwych włosów! 
@remrem pozwoliłem sobie zacząć od twojego makro, żeby uczynić go trochę bardziej "uniwersalnym" (nie obwiniaj mnie).
Zmiany skupiają się głównie na podwójnym czytaniu
" Rewizja " kontra " Rewizja ".
Użyłem też AI " Perplexity " do dodawania komentarzy tekstowych (AI nadal są w tym dobre, ale jest to bardzo praktyczne).
Teoretycznie zwiększana jest także kompatybilność z wersją Solidworks > 2022. (ale nie mogę testować!).
Wskazówka:
Dla posiadaczy pakietu " Mycad ", ta wersja powinna być kompatybilna z jego użyciem w Smartproperties (a więc automatyczna przy zamykaniu okna Smartproperties (jeśli twoje poprawki są generowane za pomocą tego narzędzia).
To powinno znacznie zmniejszyć ryzyko złych korekt między 3D a rysunkami...
Przykład:
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
Nie dziwię się ci.
AI jest dobre, ale czy rozumiesz, co robi?
Komentarze czasem zawierają pytania, bo nie rozumie wszystkiego, a niektóre elementy drażnią mnie w oczy, jak " On error ", którego należy unikać, bo nie pozwala na zlokalizowanie wad.
Mój kod na pewno nie jest wyczerpujący, ale zarządzanie błędami poprzez jego zarządzanie pozwoli mi (co jest oczekiwane) ostrzegać użytkownika na podstawie błędów.