Macro opening plan according to config

Out of category
1

Hello 

New question, I would like to automate my plan creation. Let me explain, I have a part with, let's say, 15 different configurations. I'd like to make a macro to open a drawing with a sheet by configuration by naming it from the config no. I have a little idea of the code but I don't know the functions for opening a plan and creating new sheets.

Here is a piece of my code to complete the different configs:

 ConfCount = UBound(vConfigNameArr)

    If ConfCount = 0 Then Exit Sub

    If ConfCount > 0 Then
       
       i = 1
        'We wrap up
        For Each vConfigName In vConfigNameArr
                      
            We display the configuration
            swModel.ShowConfiguration2 vConfigName
        
            swModel.ShowNamedView2 "*Isometric", -1
            swModel.ViewZoomtofit2
        
            'We force reconstruction
            swModel.ForceRebuild3 False

            We open a new drawing 

            The new leaves are created

If anyone has an idea, I'm all ears.

Kind regards

 

Edit: I'm looking to do a copy and paste, I make my first plan and then I launch the macro to copy/paste my first sheet as many times as the number of configs. By naming the sheets in the name of the config.

2

To create a new sheet I have this piece of code:

(swmodel.getpathname must of course point to your configured part or assembly model)

                
Set swDraw = swApp.NewDocument(sDrTemplateLaser, 0, 0, 0)
Dim swSheet  As SldWorks.Sheet
Set swSheet = swDraw.GetCurrentSheet
bRet = swSheet.SetScale(1, 1, True, False)
Debug.Print "Modèle:" & swModel.GetPathName
Set swView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName, "", 0.105, 0.184, 0#, False, False)
Dim swDrawModel As SldWorks.ModelDoc2
Set swDrawModel = swDraw
swDrawModel.ForceRebuild3 False
swDrawModel.Extension.SaveAs file, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0

Otherwise to copy a sheet and rename it and then change the references (configurations) I have this piece of code (I'll have to shoot but not too much time to do it)

Option Explicit

Const suffixFeuille As String = "-SYM"
Const suffixNomFichier As String = "-SYM"

Dim swApp               As SldWorks.SldWorks
Dim swDraw              As DrawingDoc
Dim swModel             As ModelDoc2
Dim swModel2            As ModelDoc2
Dim bRet                As Boolean
Dim swView              As SldWorks.View
Dim swRefModel          As SldWorks.ModelDoc2
Dim longstatus          As Long
Dim longwarnings        As Long


Sub copyDrawingSheetSYM()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel


If (swDraw Is Nothing) Then
    MsgBox "ouvrir une MEP"
    End
End If
Dim sheetCount As Integer
sheetCount = swDraw.GetSheetCount
Dim vSheetName As Variant
'vSheet = swDraw.GetSheetNames
Dim sheetName As String
Dim i As Integer

'1-) PARTIE SUPPRESSION FEUILLES SYM EXISTANTE
Debug.Print "1-) PARTIE SUPPRESSION FEUILLES SYM EXISTANTE"
Dim selection As Boolean
selection = False
'swModel.Extension.ClearSelection2 False
vSheetName = swDraw.GetSheetNames
'On boucle sur les feuilles
For i = 0 To UBound(vSheetName)
        sheetName = vSheetName(i)
        'Debug.Print "Nom de feuille:" & sheetName
        If sheetName Like "*" & suffixFeuille & "*" Then
            'Debug.Print "On entre dans la partie suppression"
            selection = True
            'Sélection des feuilles Sym
            bRet = swModel.Extension.SelectByID2(sheetName, "SHEET", 0, 0, 0, True, 0, Nothing, 0)
        End If
Next i


If selection = True Then
    'On demande si on supprime la feuille
    If MsgBox("Voulez vous supprimer les feuilles Sym?", vbYesNo + vbDefaultButton1, "Basculer la vue de découpe?") = vbYes Then 'Si le bouton Oui est cliqué
        'Suppression des feuilles
        bRet = swModel.Extension.DeleteSelection2(0)
        'Debug.Print "Feuilles supprimées"
    Else
        MsgBox "On quitte la macro"
        Exit Sub
    End If
End If



'2-) PARTIE CREATION FEUILLES SYM
Debug.Print "2-) PARTIE CREATION FEUILLES SYM"
sheetCount = swDraw.GetSheetCount
vSheetName = swDraw.GetSheetNames
'On boucle sur les feuilles
For i = 1 To sheetCount
       sheetName = vSheetName(i - 1)
        'Debug.Print "Nom de feuille:" & sheetName
       
        If i = 1 Then
            Set swView = swDraw.GetFirstView().GetNextView
            Set swRefModel = swView.ReferencedDocument
            Dim sModelName  As String
            sModelName = swView.GetReferencedModelName
            Debug.Print "File                      = " & swModel.GetPathName
            Debug.Print "  View                    = " & swView.Name
            Debug.Print "    Referenced model name = " & sModelName
            Debug.Print "    Model path            = " & swDraw.GetPathName
            Dim vConfs As Variant
            vConfs = swRefModel.GetConfigurationNames
            Dim confSymName As String
            confSymName = ""
            Dim j As Integer
            'On boucle sur les config
            For j = 0 To UBound(vConfs)
                Dim confName As String
                confName = vConfs(j)
                If confName Like "*Sym*" And Not confName Like "*Sym*Sym*" Then
                confSymName = confName
                Dim saveJ As String
                saveJ = j
                End If
                
                'Debug.Print confName
                swModel.ForceRebuild3 False
            Next j
            
        End If
        If confSymName <> "" Then
            'On lance la macro pour ajouter le suffix au model auquel la MEP fait référence
            'On active le model
            Debug.Print sModelName
            Set swModel2 = swApp.OpenDoc6(sModelName, 3, 0, "", longstatus, longwarnings)
            'ici rendre le model actif
            Set swModel2 = swApp.ActivateDoc3(sModelName, swRebuildOnActivation_e.swDontRebuildActiveDoc = 1, 0, 0)
            
            
            'On lance le code pour modifier la propriété du modèle référencé
            zSmartCat_SYM1.smartCat_SYM
            
            'On active la mise en plan
            Set swModel = swApp.OpenDoc6(swDraw.GetPathName, 3, 0, "", longstatus, longwarnings)
            Set swModel = swApp.ActivateDoc3(swDraw.GetPathName, swRebuildOnActivation_e.swDontRebuildActiveDoc = 1, 0, 0)
            'Set swDraw = swModel
            swDraw.ActivateSheet sheetName
            'Debug.Print "Feuille active:" & sheetName
            bRet = swDraw.Extension.SelectByID2(sheetName, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
            swModel.EditCopy
            bRet = swDraw.PasteSheet(swInsertOption_AfterSelectedSheet, swRenameOption_No)
            swDraw.GetCurrentSheet.SetName sheetName & suffixFeuille
            
            'On parcourt toute les vue de la feuille et on change la config
            Set swView = swDraw.GetFirstView.GetNextView
            Do While Not swView Is Nothing
                'Debug.Print "  Drawing view = " + swView.Name
                'Debug.Print "    Referenced model name = " & swView.GetReferencedModelName
                'Debug.Print "    Referenced configuration name = " & swView.ReferencedConfiguration
                'Debug.Print "    Referenced configuration persistent reference ID = " & swView.ReferencedConfigurationID
                
                'Changement de configuration (Symétrique) si la vue d'est pas une vue déplié (Flat-Pattern)
                If Not swView.ReferencedConfiguration Like "*PATTERN*" Then
                    'Debug.Print "On change la config"
                    swView.ReferencedConfiguration = vConfs(saveJ)
                Else
                    'On retourne la vue
                    'Debug.Print "On retourne la vue"
                    swView.FlipView = True
                End If
                'Get next drawing view
                Set swView = swView.GetNextView
            Loop
        End If
Next

'3-) PARTIE CREATION ANNOTATION AJOUT DU SUFFIX NOM DE FICHIER POUR SYM
Debug.Print "3-) PARTIE CREATION FEUILLES SYM"

sheetCount = swDraw.GetSheetCount
vSheetName = swDraw.GetSheetNames
'On boucle sur les feuilles
For i = 1 To sheetCount
       sheetName = vSheetName(i - 1)
       Debug.Print i & "-Nom de feuille:" & sheetName
       If sheetName Like "*" & suffixFeuille & "*" Then
         swDraw.ActivateSheet sheetName
             Set swView = swDraw.GetFirstView()
             'On boucle sur les notes
             Dim swNote          As Note
             Dim swAnn           As SldWorks.Annotation
             Dim sValue          As String
             Set swNote = swView.GetFirstNote
                 swModel.ClearSelection2 (True)
                 Do While Not swNote Is Nothing
                     Set swAnn = swNote.GetAnnotation
                     sValue = "$PRP:""SW-Nom de fichier(File Name)""" 'Mettre le nom de la propriété recherchée
                     Debug.Print swNote.PropertyLinkedText
                     If swNote.PropertyLinkedText = sValue Then
                             Debug.Print "Propriété trouvé"
                             swNote.PropertyLinkedText = sValue & suffixNomFichier
                             Exit Do
                     End If
                     swModel.ClearSelection2 (True)
                     Set swNote = swNote.GetNext
                 Loop
        End If
Next i
zBomMaterials.bomMaterials
'swModel.EditRebuild3
'swModel.Save

Set swApp = Nothing
Set swModel = Nothing
Set swDraw = Nothing
Set swRefModel = Nothing
End Sub

The purpose of this 2nd macro is to copy all the sheets of a MEp (example: sheet1 and sheet2)

Add -SYM to the new sheets (example: Sheet1-SYM, Sheet2-SYM) and then change the references of all the views for the symmetrical configuration.

This code should answer some of your questions to change configurations. It's up to you to look and sort.

3

Perfect, it's great, thank you. However, zSmartCat_SYM1 and zBomMaterials are not defined. How should I define them?  

Kind regards

4

For zSmartCat_SYM it's a module that retrieves the name of the configurations:

Sub smartCat_SYM()
Const suffixNomFichier      As String = "-SYM"
Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swConfig                As SldWorks.Configuration
Dim swCustPropMgr           As SldWorks.CustomPropertyManager
Dim configNames             As Variant
Dim configName              As Variant
Dim lRetVal                 As Long
Dim PathName                As String
Dim bRet                    As Boolean
Dim errorsSave              As Long
Dim warnings                As Long
Dim lectureSeule            As Boolean
Dim configSym               As Boolean
Dim fichierNotSave          As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

lectureSeule = False
configSym = False

'On vérifie si la propriété existe déjà si oui on sort de la macro
    'Pour toutes les configurations du modèle 3D
    configNames = swModel.GetConfigurationNames
        For Each configName In configNames
        Debug.Print "2-Nom de config:" & configName
        Set swConfig = swModel.GetConfigurationByName(configName)
        Set swCustPropMgr = swConfig.CustomPropertyManager
    
        If configName Like "*Sym*" Then
                If configName Like "*Sym*Sym*" Then
                    MsgBox "Attention Symétrie de Symétrie merci de corriger votre assemblage et supprimer cette configuration: " & configName
                End If
                'Dim cfg As String
                'cfg = swModel.GetActiveConfiguration.Name
                If swModel.GetCustomInfoValue(configName, "Symetrie") <> "" Then
                    Exit Sub
                End If
            End If
        Next

For zBomMaterials, this deals with some changes on the BOM table (change of config and resizing of one or 2 columns:

Dim swApp As SldWorks.SldWorks
Dim swDraw As SldWorks.DrawingDoc

Sub bomMaterials()

    Set swApp = Application.SldWorks
    
    Set swDraw = swApp.ActiveDoc
    
    Dim vSheetNames As Variant
    
    vSheetNames = swDraw.GetSheetNames
    
    Dim i As Integer
        
    For i = 0 To UBound(vSheetNames)
        
        Dim swSheet As SldWorks.Sheet
        Set swSheet = swDraw.Sheet(vSheetNames(i))
        Debug.Print "Feuille:" & vSheetNames(i)
        Dim swView As SldWorks.View
        Set swView = GetPropertiesView(swSheet)
        
        Dim vBomFeatures As Variant
        vBomFeatures = GetBomFeatures(swSheet)
        ProcessView swView, vBomFeatures
        'On relance pour redimensionner les colonnes
        vBomFeatures = GetBomFeatures(swSheet)
    Next
    
End Sub

Sub ProcessView(swView As SldWorks.View, vBomFeatures As Variant)
    
    If Not IsEmpty(vBomFeatures) Then
        
        Dim i As Integer
        
        For i = 0 To UBound(vBomFeatures)
            
            Dim swBomFeat As SldWorks.BomFeature
            
            Set swBomFeat = vBomFeatures(i)
            
            Dim vConfVis As Variant
            Dim vConfNames As Variant
            vConfNames = swBomFeat.GetConfigurations(False, vConfVis)

            Dim visConfIndex As Integer
            
            Dim j As Integer
            
            For j = 0 To UBound(vConfNames)
                
                vConfVis(j) = UCase(vConfNames(j)) = UCase(swView.ReferencedConfiguration)
                           Debug.Print "vConfNames=" & vConfNames(j)
            Next
            'On change la configuration
            swBomFeat.SetConfigurations False, vConfVis, vConfNames
            
        Next
        
    End If
    
End Sub

Function GetBomFeatures(swSheet As SldWorks.Sheet) As Variant
    
    Dim vSheets As Variant
    vSheets = swDraw.GetViews()
    
    Dim i As Integer
    
    For i = 0 To UBound(vSheets)
    
        Dim vViews As Variant
        vViews = vSheets(i)
        
        Dim swSheetView As SldWorks.View
        Set swSheetView = vViews(0)
        
        If UCase(swSheetView.Name) = UCase(swSheet.GetName()) Then
            
            Dim swBomFeatures() As SldWorks.BomFeature
            
            Dim vTables As Variant
            vTables = swSheetView.GetTableAnnotations()
            
            Dim j As Integer
            Dim isArrInit As Boolean
            If IsEmpty(vTables) Then
            'If vTables = "" Then
            Debug.Print "On sort de la macro"
            Exit Function
            End If
            
            For j = 0 To UBound(vTables)
                
                Dim swTableAnn As SldWorks.TableAnnotation
                Set swTableAnn = vTables(j)
                
                If swTableAnn.Type = swTableAnnotationType_e.swTableAnnotation_BillOfMaterials Then
                    If False = isArrInit Then
                        isArrInit = True
                        ReDim swBomFeatures(0)

                    Else
                        ReDim Preserve swBomFeatures(UBound(swBomFeatures) + 1)

                    End If
                    
                    Dim swBomTableAnn As SldWorks.BomTableAnnotation
                    Set swBomTableAnn = swTableAnn
                    
                    Set swBomFeatures(UBound(swBomFeatures)) = swBomTableAnn.BomFeature
                        'Ajout SD redim colonne
                        SetColumnWith swTableAnn
                        'Fin ajout SD redim colonne
                End If
                
            Next
            
            GetBomFeatures = swBomFeatures

            Exit Function
        End If
        
    Next
    
End Function

Function GetPropertiesView(swSheet As SldWorks.Sheet) As SldWorks.View
    
    Dim vViews As Variant
    
    vViews = swSheet.GetViews
    
    If Not IsEmpty(vViews) Then
        
        Dim i As Integer
        
        For i = 0 To UBound(vViews)
            
            Dim swView As SldWorks.View
            Set swView = vViews(i)
            
            If UCase(swView.Name) = UCase(swSheet.CustomPropertyView) Then
                Set GetPropertiesView = swView
                Exit Function
            End If
            
        Next
        
        Set GetPropertiesView = vViews(0) 'use first one
        
    End If
    
End Function
Sub SetColumnWith(swTable As TableAnnotation)
    Dim index As Integer
    Dim swAnnotation As Annotation
    Dim swDislplayData As DisplayData
    Dim i As Integer
    Dim UserPref As Integer
    Dim UserPrefOption As Integer
    Dim swTextFormat As SldWorks.TextFormat
     
    Set swAnnotation = swTable.GetAnnotation
    Set swDislplayData = swAnnotation.GetDisplayData
    'On dimensionne la taille de la police de document pour les nomenclatures
    Set swTextFormat = swAnnotation.GetTextFormat(1)
        swTextFormat.CharHeightInPts = "10"
        swTextFormat.TypeFaceName = "Arial"
        swTextFormat.Bold = False
        swTextFormat.Italic = False
        'on modifie la propriété font du document pour les nomenclature
        bRet = swDraw.Extension.SetUserPreferenceTextFormat(swUserPreferenceTextFormat_e.swDetailingBillOfMaterialTextFormat, swDetailingBillOfMaterial, swTextFormat)
  
        For i = 0 To swTable.ColumnCount - 1
            Dim ColumnWidth As Double
            ColumnWidth = swTable.GetColumnWidth(i)
            'Debug.Print i & ":" & ColumnWidth * 1000
            'Debug.Print "Title" & swTable.GetColumnTitle(i)
            If i = 0 Then bRet = swTable.SetColumnWidth(i, 0.005, 0)
            If i = 1 Then bRet = swTable.SetColumnWidth(i, 0.0135, 0)
            If i = 2 Then bRet = swTable.SetColumnWidth(i, 0.0295, 0)
            If i = 3 Then bRet = swTable.SetColumnWidth(i, 0.098, 0)
            If i = 4 Then bRet = swTable.SetColumnWidth(i, 0.02, 0)
            If i = 5 Then bRet = swTable.SetColumnWidth(i, 0.024, 0)
        Next
    End Sub

The entire macro as an attachment if needed


mep_decoupe__symetrie.swp
5

Thank you, it's great.

Have a nice day

Kind regards