Macro insertion table de révision + révision solidworks

Out of category
1

Bonjour à tous,

Je recherche une macro pour ajouter le tableau de révision dans la mise en plan solidworks.

Le tableau à ajouter n'est pas celui de base il est dans un chemin spécifique. 

De plus une fois le tableau créer je voudrait lui insérer un révision en automatique (toujours la même).

 

 

Par avance merci de votre aide

2

Bonjour Mcjones,

Tout d'abord meilleurs vœux, ...

Si vous avez Mycadtool, dans cette application il y a une macro qui fait tout ça, coupler au module intégration, je ne maitrise pas les macros mais ça fonctionne très bien.

Dés que j'ai la main sur mon pc, je fais une capture d'écran.

@+.

AR.

1 « J'aime »
3

Bonjour A.R,

 

Merci meilleurs voeux a vous aussi  !

D'accord je vais regarder ça.

Merci pour ta réponse !

4

Bonjour;

Voici un exemple d'insertion de table de révision "Perso" avec choix de Calque d'insertion: (Ici "Annotation")

-> Ligne "Set mytablerev" : Entrez le chemin complet de l'emplacement de la table de révision (*.sldrevtbt).

Public swApp As SldWorks.SldWorks
Public swDoc As SldWorks.ModelDoc2
Public SwSheet As SldWorks.DrawingDoc
Public swview As SldWorks.View
Public SwTableRev As TableAnnotation
Public swAnn As SldWorks.Annotation

Public currentsheet As Object
Public mytablerev As Object


Dim LayerMgr As SldWorks.LayerMgr
Dim draw As SldWorks.ModelDoc2


Sub Ajout_table_rev()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set SwSheet = swDoc

'insertion table
'attention changer le chemin pour la table de revision
' si "mytablerev" 'true' alors la table se met sur le point d'ancrage sinon sur coordonné 0,0

Set currentsheet = SwSheet.GetCurrentSheet
Set mytablerev = currentsheet.InsertRevisionTable(True, 0, 0, 3, "W:\Modeles_solidworks\table_de_revision\revision.sldrevtbt")
Set myRevisionTable = currentsheet.RevisionTable
longstatus = myRevisionTable.AddRevision("")

'Deplace la table sur le calque "Annotation"
myRevisionTable.GetAnnotation.Layer = "Annotation"

Dim Revis As String
Revis = myRevisionTable.CurrentRevision

'Ajoute la valeur de "revision" sur la table
Dim Valeur As String
Set swModel = swApp.ActiveDoc
Valeur = swModel.DeleteCustomInfo("Revision")
Valeur = swModel.AddCustomInfo3("", "Revision", swCustomInfoText, Revis)

'force la reconstruction
Dim bRet As String
bRet = swModel.Rebuild(swRebuildOptions_e.swForceRebuildAll)

End Sub

 

Salutations.

2 « J'aime »
5

Ou sinon regarder cette macro à modifier suivant ton besoin et tes connaissances:

Sub tableRevision()
Const TABLE_TEMPLATE As String = "U:\Entreprise\Service BE\1-Commun service\Solidworks\SOLIDWORKS Data 2018\lang\french\standard revision block.sldrevtbt"
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swSheet             As SldWorks.Sheet
Dim vViews              As Variant
Dim swView              As SldWorks.View
Dim swAnn               As SldWorks.Annotation
Dim swRevTable          As SldWorks.RevisionTableAnnotation
Dim i                   As Integer
Dim UserName            As String
Dim DescriptionRev      As String
Dim fileerror           As Long
Dim filewarning         As Long
Dim sName               As String
Dim longstatus          As Long, longwarnings As Long
Dim swDocSpecification  As SldWorks.DocumentSpecification

Debug.Print "Indice:" & Indice


Set swApp = Application.SldWorks
Debug.Print "Chemin MEP:" & PathMep & Indice & ".slddrw"
Set swDocSpecification = swApp.GetOpenDocSpec(PathMep & Indice & ".slddrw")
sName = swDocSpecification.Filename
swDocSpecification.DocumentType = swDocDRAWING
swDocSpecification.ReadOnly = False
swDocSpecification.Silent = False
Set swModel = swApp.OpenDoc7(swDocSpecification)
longstatus = swDocSpecification.Error
longwarnings = swDocSpecification.Warning
    
    
    
'Set swModel = swApp.ActiveDoc
Set swDraw = swModel

    If Not swDraw Is Nothing Then
    
        Set swSheet = swDraw.GetCurrentSheet
        
        Set swRevTable = swSheet.RevisionTable
        
        If swRevTable Is Nothing Then
            
            'On ajoute une table de révision
            Debug.Print "Pas de table de révision existante-> création"
            Set swRevTable = swSheet.InsertRevisionTable(True, Empty, Empty, swBOMConfigurationAnchor_TopRight, TABLE_TEMPLATE)
        
            If swRevTable Is Nothing Then
                swApp.SendMsgToUser "L'insertion de la table à échoué."
            End
            End If

        End If
        'On récupère les infos sur le nom de session windows
        UserName = Environ("USERNAME")
        UserName = Replace(UserName, ".", " ")
        UserName = StrConv(UserName, vbProperCase)
        Debug.Print "Nom de session windows:" & UserName
        
        'On demande la valeur de la description du nouveau indice
        DescriptionRev = InputBox("Taper la description de la révision:", "Ajout de Révision")
        If DescriptionRev = "" Then
        DescriptionRev = " A définir"
        End If

        'On ajoute la ligne de révision
        Debug.Print "On ajoute une ligne à la table de révision"
        AddRevision swRevTable, Indice, Array("A définir", "", DescriptionRev, "", UserName)
    
    Else
        MsgBox "Merci d'ouvrir un plan"
    End If



End Sub


Sub AddRevision(swRevTable As SldWorks.RevisionTableAnnotation, revName As String, rowData As Variant)
    
    Dim i As Integer
    Dim swTableAnn As SldWorks.TableAnnotation
    
    Set swTableAnn = swRevTable
    
    swRevTable.AddRevision revName
            
    For i = 0 To UBound(rowData)
                
        If rowData(i) <> "" Then
            
            swTableAnn.Text(swTableAnn.RowCount - 1, i) = rowData(i)
        
        End If
                
    Next
    
End Sub

 

2 « J'aime »
6

Merci à vous tous pour vos reponse rapide ! Je vais regarder ce que je peux faire de mieux ! Merci à tous !