Macro Insertion Revision Table + Solidworks Revision

Out of category
1

Hi all

I'm looking for a macro to add the revision table in the solidworks drawing.

The array to be added is not the basic one, it is in a specific path. 

In addition, once the table is created, I would like to insert an automatic revision (always the same).

 

 

Thank you in advance for your help

2

Hello Mcjones,

First of all, best wishes, ...

If you have Mycadtool, in this application there is a macro that does all this, coupled with the integration module, I don't master macros but it works very well.

As soon as I have my hand on my pc, I take a screenshot.

@+.

AR.

1 Like
3

Hello A.R,

 

Thank you best wishes to you too !

Okay, I'll look into that.

Thank you for your answer!

4

Hello;

Here is an example of inserting a "Personal" revision table with a choice of Insertion Layer: (Here "Annotation")

-> "Set mytablerev" line: Enter the full path of the revision table location (*.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

 

Regards.

2 Likes
5

Or else look at this macro to modify according to your needs and your knowledge:

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 Likes
6

Thank you all for your quick response! I'll look at what I can do better! Thank you all!