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
