Makro "Automatisch planen"

Hallo

Ich erstelle gerade ein Makro in VBA (ich bin neu im Programmieren), das aus einem geöffneten Dokument eine neue Seite mit einem bestimmten Titel erstellt, " rev " umbenennt und eine Ansicht in die Mitte der Zeichnung setzt. Aber ich kann keine bestimmte Konfiguration angeben, genauer gesagt die erste (unabhängig vom Dokument). Hier ist der Code:


Dimmen swApp als Objekt
Teil als IDrawingDoc dimmen
Dim nomdoc As String
Dim boolstatus als boolescher Wert
Myview als SldWorks.View dimmen
Dim swSketchMgr Als Objekt
Dim swSkizze als Objekt
Sub main()
Set swApp = CreateObject(" SldWorks.Application ")
Set Part = swApp.ActiveDoc
docname = Teil.GetPfadName
Wenn docname = "  " Dann
MsgBox "Dokument speichern"
Ende, wenn
docname = Ersetzen(docname, ".  SLDDRW ", "  ")
docname = docname & " .sldprt "
boolstatus = Teil.NewSheet3(" REV ", 12, 12, 1, 1, Wahr, " DIAGER RVT2.slddrt ", 0.42, 0.297, " Standard ")

Teil.ViewZoomtofit2
Part.ClearSelection2 Wahr
Set myview = Part.CreateDrawViewFromModelView3(docname, " *Gesicht ", 0.42 / 2, 0.297 / 2, 0)
Teil.ForceRebuild
Set myview = Part.GetFirstView
boolstatus = Part.ChangeRefConfigurationOfFlatPatternView(docname, " <Standard(01)> ")
Teil.ForceRebuild
Ende Sub


Wechsel von einer Konfiguration wie dieser:

dazu:

außer dass nichts getan wird, wenn ich das Makro starte (kein Fehler und keine Änderung in der Ansicht) und mein letzter boolstatus true ist.
Haben Sie eine Idee?

Vielen Dank im Voraus
Yohann

Sie verwenden einen Blickwechsel für ein Flatpattern, was offensichtlich nicht der Fall ist.
Um die Konfiguration einer Ansicht zu ändern, verwende ich:
swView.ReferencedConfiguration = vConfs(saveJ)

Hier ist der vollständige Code, falls erforderlich:

Option Explicit
Option Compare Text 'ignore la casse lors des comparaisons de texte Ex "aaa" =" AAA"
'MAJ17/01/2023 SD Modification avec supression de la vérif fraisage et symétrisation systématique de la vue dépli pour les feuilles sym
'MAJ 22/09/2022 SD
'MAJ 2022-09-30 Ajout de la laison de la vue avec la nomenclature: voir -> On récupère le nom de la dernière nomenclature pour les feuilles SYM
'Const iDrwTempSize  As Long = swDwgPaperSizes_e.swDwgPaperA0size
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()
sDrTemplateLaser = "U:\Entreprise\Service BE\1-Commun service\Solidworks\Configuration\Modèle de documents\Modèle SW 2020\Fond de plan C\A4-DECOUPE-c.DRWDOT"
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
'On vide la sélection de feuille en cours
 swModel.ClearSelection2 True
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
            
        'Suppression de la partie inversion de la vue par symétrisation systématique de la vue
        '    'On vérifie si la feuille contient un ou plusieur fraisage -> <HOLE-SINK>
        '
        '        Debug.Print "  View = " & swView.Name
        '        Dim swDispDim                   As SldWorks.DisplayDimension
        '        Dim swDim                       As SldWorks.Dimension
                Dim swAnn                       As SldWorks.Annotation
        '        Dim threadPrefix                As String
        '        Set swDispDim = swView.GetFirstDisplayDimension5
        '        Do While Not swDispDim Is Nothing

        '            Set swAnn = swDispDim.GetAnnotation
        '            Set swDim = swDispDim.GetDimension
        '            threadPrefix = CStr(swDispDim.GetText(swDimensionTextPrefix))
        '            Debug.Print threadPrefix
        '            Set swDispDim = swDispDim.GetNext3
        '            'Si le  suffixe de la côte est fraisée -> <HOLE-SINK>
        '            Dim fraisage As String
        '            fraisage = "Non"
        '            If Left(threadPrefix, 11) = "<HOLE-SINK>" Then
        '            Debug.Print "Fraisage"
        '            fraisage = "Oui"
        '            Else
        '            Debug.Print "Pas de fraisage"
        '            fraisage = "Non"
        '            End If
        '        Loop
            

            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*" And Not confName Like "Sym*Flat*" 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
            Debug.Print "Nom de la feuille active: " & swDraw.GetCurrentSheet.GetName
             
            'On récupère le nom de la dernière nomenclature pour les feuilles SYM
            Dim swFeat      As SldWorks.Feature
            Dim swBomFeat   As SldWorks.BomFeature
            Dim BomName As String
            Set swFeat = swDraw.FirstFeature
            Do While Not swFeat Is Nothing
                If (swFeat.GetTypeName = "BomFeat") Then
                    Debug.Print "******************************"
                    Debug.Print "Feature Name = " & swFeat.Name
                    BomName = swFeat.Name
                End If
                Set swFeat = swFeat.GetNextFeature
            Loop


            
            '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)
                    'On lie la vue à la nomenclature
                    If BomName <> vbNullString Then
                        bRet = swView.SetKeepLinkedToBOM(True, BomName)
                    End If
                    
                Else
                    'Modif code symétrisation systématique de la vue déplié
                    'On retourne la vue si pas pièce pas fraisée
                    'If fraisage = "Non" Then
                    '    'Debug.Print "On retourne la vue"
                    '    If swView.FlipView = False Then
                    '        swView.FlipView = True
                    '    Else
                    '        swView.FlipView = False
                    '    End If
                    'Else 'Fraisage="Oui"
                    
                    'Cocher Symétrie de la vue horizontal
                    Dim mirrored As Boolean
                    Dim orientation As Long
                    swView.SetMirrorViewOrientation True, swMirrorViewPositions_e.swMirrorViewPosition_Horizontal
                    swView.GetMirrorViewOrientation mirrored, orientation
                    Debug.Print "Mirrored? " & mirrored
                    Debug.Print "Orientation (0 = horizontal)? " & orientation

                    'End If
                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




2 „Gefällt mir“

Hallo

Vielen Dank für Ihre Hilfe, ich habe es geschafft, an etwas herumzubasteln.
Herzliche Grüße
Igitt.

Wenn gelöst, wählen Sie bitte die beste Antwort aus und fügen Sie möglicherweise Ihre endgültige Lösung hinzu (wenn möglich mit vorformatiertem Text für den Codeteil), es könnte in Zukunft jemandem helfen.
image

Vielen Dank.
Ps: Danke @Maclane für das Bild, ich liebe es! :crazy_face: