MACRO : définir le calque par défaut d'une mise en plan sur -Selon la norme-

Salut à tous !

Dans le cadre d’une évolution des normes d’habillage SW dans l’entreprise, je me suis rendu compte que le chargement d’une nouvelle norme d’habillage n’est pas fiable : tous les calques ne sont pas présents et pir encore, les affectations ne sont pas toujours les bonnes.

J’ai donc besoin d’automatiser pas mal de choses :

  1. Vérifier l’existence de chaque calque, sinon créer les manquants (certains ont des couleurs personnalisés → besoin de définir la couleur avec le code RGB

  2. Vérifier les calques affectés pour chaque élément (cotes, label de position, axe de centrage, coupe, etc) dans les propriétés du document

  3. Forcer le calque par défaut du document sur -Selon la norme- (à l’ouverture le calque par défaut est défini sur -Aucun-, et je souhaite le passer sur -Selon la norme-).

  4. Réaffecter les éléments du plan aux bons calques

J’ai commencé avec le dernier point pour lequel j’ai vite trouvé des éléments pour m’aider sur le forum, mais je suis néanmoins bloqué :

Mon code :

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swLayerMgr                  As SldWorks.LayerMgr
Dim vLayerArr                   As Variant
Dim vLayer                      As Variant
Dim swLayer                     As SldWorks.Layer
Dim swDraw                      As SldWorks.DrawingDoc
Dim vSheets                 As Variant
Dim vSheet                  As Variant
Dim swView                      As SldWorks.View               
Dim swAnn                       As SldWorks.Annotation          
Dim swNote                      As SldWorks.Note                
Dim swDispDim                   As SldWorks.DisplayDimension
Dim swGtol                      As SldWorks.Gtol                
Dim swDatum                     As SldWorks.DatumTag           
Dim swAnnSFSymbol               As SldWorks.SFSymbol           
Dim swAnnWeldSymbol             As SldWorks.WeldSymbol          
Dim swCtrMark                   As SldWorks.CenterMark          
Dim swCenterLine                As SldWorks.Centerline          
Dim swTables                As Variant
Dim swTable                 As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub 
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub 
End If

Set swDraw = swModel

vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
    swDraw.ActivateSheet vSheet

    Set swView = swDraw.GetFirstView

    Set swView = swView.GetNextView
    While Not swView Is Nothing

        Set swCtrMark = swView.GetFirstCenterMark
        While Not swCtrMark Is Nothing
            Set swAnn = swCtrMark.GetAnnotation
            swAnn.Layer = "Axes"
            Set swCtrMark = swCtrMark.GetNext
        Wend

        Set swCenterLine = swView.GetFirstCenterLine
        While Not swCenterLine Is Nothing
            Set swAnn = swCenterLine.GetAnnotation
            swAnn.Layer = "Axes"
            Set swCenterLine = swCenterLine.GetNext
        Wend

        Set swDatum = swView.GetFirstDatumTag
        While Not swDatum Is Nothing
            Set swAnn = swDatum.GetAnnotation
            swAnn.Layer = "Références"
            Set swDatum = swDatum.GetNext
        Wend

        Set swGtol = swView.GetFirstGTOL
        While Not swGtol Is Nothing
            Set swAnn = swGtol.GetAnnotation
            swAnn.Layer = "Cotes"
            Set swGtol = swGtol.GetNextGTOL
        Wend

        Set swAnnSFSymbol = swView.GetFirstSFSymbol
        While Not swAnnSFSymbol Is Nothing
            Set swAnn = swAnnSFSymbol.GetAnnotation
            swAnn.Layer = "État de surface"
            Set swAnnSFSymbol = swAnnSFSymbol.GetNext
        Wend

        Set swAnnWeldSymbol = swView.GetFirstWeldSymbol
        While Not swAnnWeldSymbol Is Nothing
            Set swAnn = swAnnWeldSymbol.GetAnnotation
            swAnn.Layer = "Soudures"
            Set swAnnWeldSymbol = swAnnWeldSymbol.GetNext
        Wend

        Set swDispDim = swView.GetFirstDisplayDimension5
        While Not swDispDim Is Nothing
            Set swAnn = swDispDim.GetAnnotation
            swAnn.Layer = "Cotes"
            Set swDispDim = swDispDim.GetNext5
        Wend

  
        Set swView = swView.GetNextView
    Wend
Next
swModel.ClearSelection2 True

Problèmes /4:

  • Set swNote = swView.GetFirstNote me permet de sélectionner les notes attachées aux vues.
    Mais comment sélectionner tour à tour les notes attachées à la feuilles ?

  • Quel API pour sélectionner les labels de position ?

  • Quel(s) API(s) pour sélectionner les traits et labels de coupe ?

Problèmes /3:

  • J’ai essayer avec swDraw.SetCurrentLayer(« -Selon la norme- ») mais -Selon la norme- n’étant pas vraiment un claque… rien ne se passe. je me suis dit qu’il était peut-être affecté au premier index de la liste des calques mais swDraw.SetCurrentLayer(0) ne fonctionne pas non plus.
    Quelqu’un aurait-il une idée ?

Pour les 2 premiers points j’ai pas encore commencer d’y regarder, mais si qqn a des éléments ou peut-être même le code qui permet de les réaliser je suis preneur !

Merci d’avance !

Bonjour;
Pour parcourir l’ensemble des Notes:
https://help.solidworks.com/2021/English/api/sldworksapi/Get_Views_and_Notes_Example_VB.htm

En revanche j’utilise une macro pour les Mises en plan pour recharger la Norme ET le fond de plan qui donne plutôt de bon résultats…

A associer avec une condition:
filetype = swModel.GetType 'Donne le type de document ouvert avec :0=swDocNONE;1=swDocPART;2=swDocASSEMBLY;3=swDocDRAWING
If filetype = 3 Then 'Si le fichier ouvert est une Mise en plan

Dim vSheetProps     As Variant
Dim nErrors         As Long
Dim nTemplatePath   As String
Dim swPaperWidth    As String
Dim swPaperHeight   As String


' Repertoire contenant les modeles des fonds de plans
Const sTemplatePath As String = "W:\Modeles_solidworks\Fonds_de_plans_2023" 'A ADAPTER :EMPLACEMENT DE VOS FOND DE PLAN PERSONNALISE

' Formats des differents fond de plans disponibles dans le Repertoire ci-dessous

Const A0HTemplateName As String = "A0H PERSO 2023.slddrt" 'A ADAPTER : VOTRE FOND DE PLAN PERSONNALISE
Const A1HTemplateName As String = "A1H PERSO 2023.slddrt"
Const A1VTemplateName As String = "A1V PERSO 2023.slddrt"
Const A2HTemplateName As String = "A2H PERSO 2023.slddrt"
Const A2VTemplateName As String = "A2V PERSO 2023.slddrt"
Const A3HTemplateName As String = "A3H PERSO 2023.slddrt"
Const A3VTemplateName As String = "A3V PERSO 2023.slddrt"
Const A4HTemplateName As String = "A4H PERSO 2023.slddrt"
Const A4VTemplateName As String = "A4V PERSO 2023.slddrt"

Sub Formats()

 Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSheet As SldWorks.Sheet
    Dim vSheetProps As Variant
   

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    

        'swModel.ActivateSheet vSheetName
            Set swSheet = swModel.GetCurrentSheet
            vSheetProps = swSheet.GetProperties
            swPaperWidth = vSheetProps(5)
            swPaperHeight = vSheetProps(6)
        Select Case swPaperWidth & swPaperHeight ' Comparaison de la Longueur et de la Largeur du fond de plan present (Unité en Metres)
        
Case "1,189" & "0,841" ' Format A0H
        nTemplatePath = sTemplatePath & "\" & A0HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A0.sldstd")
       
Case "0,841" & "0,594" ' Format A1H
        nTemplatePath = sTemplatePath & "\" & A1HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")
        
Case "0,594" & "0,841" ' Format A1V
        nTemplatePath = sTemplatePath & "\" & A1VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")

Case "0,594" & "0,42" ' Format A2H
        nTemplatePath = sTemplatePath & "\" & A2HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,594" ' Format A2V
        nTemplatePath = sTemplatePath & "\" & A2VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,297" ' Format A3H
        nTemplatePath = sTemplatePath & "\" & A3HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,42" ' Format A3V
        nTemplatePath = sTemplatePath & "\" & A3VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,21" ' Format A4H
        nTemplatePath = sTemplatePath & "\" & A4HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

Case "0,21" & "0,297" ' Format A4V
        nTemplatePath = sTemplatePath & "\" & A4VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

        Case Else
        nTemplatePath = sTemplatePath & "\" & A2HTemplateName 'Format par défaut si le fond de plan present n'est pas dans la liste ci-dessus
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")
        
End Select
        
   'On Supprime le fond de plan initial
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", vSheetProps(5), vSheetProps(6), "Default", True
    
    'On Recharge le nouveau fond de plan
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), vSheetProps(4), nTemplatePath, vSheetProps(5), vSheetProps(6), "Default", True
    
 Call table_rev
        
    swModel.ViewZoomtofit2
    
End Sub

2 « J'aime »

Bonjour,

Même réponse que @Maclane.
Pour répondre clairement,

Pas besoin d’ajouter et de paramétrer les calques, les manquants avec leurs paramètres de couleurs sont importés lors du changement de fond de plan. En revanche, s’il y a des calques de même noms qui ont été modifié au niveau de leur paramètre de couleur, il faudra effectivement paramétrer la couleur.
Autre point, s’il y a des calques en plus dans les anciens plans, faudra également les purger et voir à transférer ce qui serait dessus sur un autre calque avant de supprimer le calque.
En ce qui concerne les labels de vue et traits de coupe ainsi que leurs labels, à partir du moment où l’on modifie la norme d’habillage ça s’applique au document sans avoir à sélectionner les objets.

Pour finir, j’ai un bout de code qui fait un peu tout ça. J’ai aussi un autre bout de code qui permettrait de scanner tous les types d’objet et probablement de récupérer leur calque (je ne m’en sers pas pour ça à la base).
Le code de @Maclane est déjà un bon début.
Dans votre code, pour scanner le fond de plan faut rester dans la première « boucle » liée à :

Set swView = swDraw.GetFirstView

En gros cette ligne de code c’est pour rentrer dans le fond de plan, si vous écrivez juste dernière Set swView = swView.GetNextView, vous passez au scan des vues du plan.
Donc faut déjà boucler dans le fond de plan pour y récupérer tout ce qui s’y trouve et appliquer le traitement souhaité.
Pour appliquer au calque « Selon la norme », je n’ai pas vu de méthode dans l’API et il me semble que sur la 2022 ça bug un poil (autre sujet de mémoire sur le forum en application manuelle Edit: Remettre/ré-activer le calque « Selon la norme » - Plan 2D / Mise en plan - Forum myCAD (visiativ.com)).

2 « J'aime »

Re, code non testé mais devrait faire le job je pense:

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swLayerMgr                  As SldWorks.LayerMgr
Dim vLayerArr                   As Variant
Dim vLayer                      As Variant
Dim swLayer                     As SldWorks.Layer
Dim swDraw                      As SldWorks.DrawingDoc
Dim vSheets                     As Variant
Dim vSheet                      As Variant
Dim swView                      As SldWorks.View
Dim swAnn                       As SldWorks.Annotation
Dim swNote                      As SldWorks.Note
Dim swTables                    As Variant
Dim swTable                     As Variant
Dim vSheetProps                 As Variant
Dim nErrors                     As Long
Dim nTemplatePath               As String
Dim swPaperWidth                As String
Dim swPaperHeight               As String
Dim Count                       As Integer
Dim i                           As Long
Dim j                           As Long

' Repertoire contenant les modeles des fonds de plans
Const sTemplatePath As String = "W:\Modeles_solidworks\Fonds_de_plans_2023" 'A ADAPTER :EMPLACEMENT DE VOS FOND DE PLAN PERSONNALISE

' Formats des differents fond de plans disponibles dans le Repertoire ci-dessous

Const A0HTemplateName As String = "A0H PERSO 2023.slddrt" 'A ADAPTER : VOTRE FOND DE PLAN PERSONNALISE
Const A1HTemplateName As String = "A1H PERSO 2023.slddrt"
Const A1VTemplateName As String = "A1V PERSO 2023.slddrt"
Const A2HTemplateName As String = "A2H PERSO 2023.slddrt"
Const A2VTemplateName As String = "A2V PERSO 2023.slddrt"
Const A3HTemplateName As String = "A3H PERSO 2023.slddrt"
Const A3VTemplateName As String = "A3V PERSO 2023.slddrt"
Const A4HTemplateName As String = "A4H PERSO 2023.slddrt"
Const A4VTemplateName As String = "A4V PERSO 2023.slddrt"

Sub Main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If

Set swDraw = swModel
If swDraw.GetSheetCount > 1 Then
    vSheets = swDraw.GetSheetNames
    For j = 0 To UBound(vSheets)
        boolstatus = swDraw.ActivateSheet(vSheets(j))
        Call ChangeSheetFormat
        ProcessDrawing swApp, swDraw
        Call PurgeCalques
    Next j
    boolstatus = swDraw.ActivateSheet(vSheets(0))
Else
    Call ChangeSheetFormat
    ProcessDrawing swApp, swDraw
    Call PurgeCalques
End If
End Sub

Sub ChangeSheetFormat()
   
Set swSheet = swDraw.GetCurrentSheet
vSheetProps = swSheet.GetProperties
swPaperWidth = vSheetProps(5)
swPaperHeight = vSheetProps(6)
Select Case swPaperWidth & swPaperHeight ' Comparaison de la Longueur et de la Largeur du fond de plan present (Unité en Metres)
       
Case "1,189" & "0,841" ' Format A0H
       nTemplatePath = sTemplatePath & "\" & A0HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A0.sldstd")
      
Case "0,841" & "0,594" ' Format A1H
       nTemplatePath = sTemplatePath & "\" & A1HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")
       
Case "0,594" & "0,841" ' Format A1V
       nTemplatePath = sTemplatePath & "\" & A1VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")

Case "0,594" & "0,42" ' Format A2H
       nTemplatePath = sTemplatePath & "\" & A2HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,594" ' Format A2V
       nTemplatePath = sTemplatePath & "\" & A2VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,297" ' Format A3H
       nTemplatePath = sTemplatePath & "\" & A3HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,42" ' Format A3V
       nTemplatePath = sTemplatePath & "\" & A3VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,21" ' Format A4H
       nTemplatePath = sTemplatePath & "\" & A4HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

Case "0,21" & "0,297" ' Format A4V
       nTemplatePath = sTemplatePath & "\" & A4VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

       Case Else
       nTemplatePath = sTemplatePath & "\" & A2HTemplateName 'Format par défaut si le fond de plan present n'est pas dans la liste ci-dessus
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")
       
End Select
       
  'On Supprime le fond de plan initial
   swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", vSheetProps(5), vSheetProps(6), "Default", True
   
   'On Recharge le nouveau fond de plan
   swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), vSheetProps(4), nTemplatePath, vSheetProps(5), vSheetProps(6), "Default", True
   
swModel.ForceRebuild3 (False)
swModel.ViewZoomtofit2
   
End Sub
Sub ProcessDrawing(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc)

    Set swView = swDraw.GetFirstView
    Do While Not Nothing Is swView
        Set swAnn = swView.GetFirstAnnotation3
        Do While Not Nothing Is swAnn
            ProcessAnnotation swApp, swAnn
            Set swAnn = swAnn.GetNext3
        Loop
        Set swView = swView.GetNextView
    Loop
End Sub
Sub ProcessAnnotation(swApp As SldWorks.SldWorks, swAnn As SldWorks.Annotation)
    Dim swAnnCThread                As SldWorks.CThread
    Dim swAnnDatumTag               As SldWorks.DatumTag
    Dim swAnnDatumTargetSym         As SldWorks.DatumTargetSym
    Dim swAnnDisplayDimension       As SldWorks.DisplayDimension
    Dim swAnnGTol                   As SldWorks.Gtol
    Dim swAnnNote                   As SldWorks.Note
    Dim swAnnSFSymbol               As SldWorks.SFSymbol
    Dim swAnnWeldSymbol             As SldWorks.WeldSymbol
    Dim swAnnCustomSymbol           As SldWorks.CustomSymbol
    Dim swAnnDowelSym               As SldWorks.DowelSymbol
    Dim swAnnLeader                 As SldWorks.MultiJogLeader
    Dim swAnnCenterMarkSym          As SldWorks.CenterMark
    Dim swAnnTable                  As SldWorks.TableAnnotation
    Dim swAnnCenterLine             As SldWorks.Centerline
    Dim swAnnDatumOrigin            As SldWorks.DatumOrigin
    Dim swDim                       As SldWorks.Dimension
    Dim swDimensionTolerance        As SldWorks.DimensionTolerance
    Dim idx                         As Long
    Dim params                      As Variant
    Dim arrSymbols                  As Variant
    Dim nNumCol                     As Long
    Dim nNumRow                     As Long
    Dim sTableText                  As String
    Dim sSurface                    As String
    Dim sIsIndNote                  As String
    Dim j                           As Long
    Dim sGtol                       As String
    Dim sWeldNote                   As String
    Dim TableAnchor                 As TableAnchor
    
   
    Select Case swAnn.GetType
        Case swCenterMarkSym
            Set swAnn = swAnnCenterMarkSym.GetAnnotation
            swAnn.Layer = "Axes"
        Case swCenterLine
            Set swAnn = swAnnCenterLine.GetAnnotation
            swAnn.Layer = "Axes"
        Case swDatumTag
            Set swAnn = swAnnDatumTag.GetAnnotation
            swAnn.Layer = "Références"
        Case swDisplayDimension
            Set swAnn = swDispDim.GetAnnotation
            swAnn.Layer = "Cotes"
        Case swGtol
            Set swAnn = swAnnGTol.GetAnnotation
            swAnn.Layer = "Cotes"
        Case swSFSymbol
            Set swAnn = swAnnSFSymbol.GetAnnotation
            swAnn.Layer = "État de surface"
        Case swWeldSymbol
            Set swAnn = swAnnWeldSymbol.GetAnnotation
            swAnn.Layer = "Soudures"
    End Select
End Sub
Sub PurgeCalques()

Count = swLayerMgr.GetCount
vLayer = swLayerMgr.GetLayerList
For i = 0 To Count - 1
If vLayer(i) = "CARTOUCHE" Or _
vLayer(i) = "TEXTE FIXE CARTOUCHE" Or _
vLayer(i) = "Champs paramétrés" Or _
vLayer(i) = "cotation cartouche" Or _
vLayer(i) = "Consultation" Or _
vLayer(i) = "Cartouche de signature" Or _
vLayer(i) = "Indice()" Then
Else
swLayerMgr.DeleteLayer (vLayer(i))
End If
Next i
End Sub

2 « J'aime »

Merci pour vos réponses. Vos explications m’ont permis de mieux comprendre certaines choses.

Le rechargement en automatique du fond de plan à chaque nouvelle ouverture en édition d’un document de mise en plan est déjà présent depuis longtemps dans l’entreprise (un complément développé par le serv. informatique) mais je ne suis pas fan et les constructeurs non plus : cela réinitialise les points d’ancrage. Et pour une raison que j’ignore, tous les calques du nouveau modèle de document (.drwdot et .slddrt), j’ai toujours un calque qui est oublié, et pas toujours le même ! D’où mon besoin de vérifier l’existance de chaque calques…

Si les objets ont été créé dans le calque « -Aucun- », changer la norme d’habillage n’affecte aucun objet ; c’est pour cette raison que j’ai besoin d’un code pour traiter les objets, et surtout pour pouvoir redéfinir le calque par défaut sur « -Selon la norme » mais pour ce dernier point je n’ai rien trouvé.

J’ai réussi à traiter spécifiquement les labels de position en vérifiant le style de bulle :

        Set swNote = swView.GetFirstNote
        While Not swNote Is Nothing
            Set swAnn = swNote.GetAnnotation
            If swAnn.GetSpecificAnnotation.GetBalloonStyle = swBS_SplitCirc Then swAnn.Layer = "Vues dérivées"                    
            Set swNote = swNote.GetNext
        Wend

Je pense également avoir trouvé comment traiter les lignes de coupe et les lignes de vue interrompues…

1 « J'aime »

Bonjour,

J’ai omis le bout de code qui met à jour les paramètres de coupe…
Je suis en phase de test de perf sur mon poste, dès que je récupère la main je met le bout de code à dispo

Si ça peut aider, une partie des paramètres pour mettre à jour dans le modèle de document:

Sub ParamDraw()

'Paramètres vues en coupe
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLineStyleDisplay, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 0 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLineStyleDisplay, _
    swUserPreferenceOption_e.swDetailingNoOptionSpecified, 0)
End If

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingSectionViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingSectionViewLabels_PerStandard, _
    swUserPreferenceOption_e.swDetailingNoOptionSpecified, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> swDetailingViewLabelsName_none Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsName_none)
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified, 3)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingSectionViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingSectionView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètres vues de détail

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDetailViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingDetailView)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDetailViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingDetailView, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Name, swUserPreferenceOption_e.swDetailingDetailView) <> swDetailingViewLabelsName_custom Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Name, swUserPreferenceOption_e.swDetailingDetailView, swDetailingViewLabelsName_e.swDetailingViewLabelsName_custom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingDetailViewLabels_CustomName, swUserPreferenceOption_e.swDetailingDetailView, "DETAIL")
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Scale, swUserPreferenceOption_e.swDetailingDetailView) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Scale, swUserPreferenceOption_e.swDetailingDetailView, swDetailingViewLabelsScale_e.swDetailingViewLabelsScale_SCALEcustom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingDetailViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingDetailView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètres vues auxiliaires

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAuxViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAuxViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> swDetailingViewLabelsName_custom Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsName_e.swDetailingViewLabelsName_custom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingAuxViewLabels_CustomName, swUserPreferenceOption_e.swDetailingAuxiliaryView, "VIEW")
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsScale_e.swDetailingViewLabelsScale_SCALEcustom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingAuxViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingAuxiliaryView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètre mise à jour auto nomenclature

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoUpdateBOM, swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet = False Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoUpdateBOM, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True)
End If

End Sub

Pour traiter les lignes de coupe j’ai rédiger ce code :

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim vSheets                 As Variant
Dim vSheet                  As Variant
Dim swView                      As SldWorks.View 
Dim swSectionLines            As Variant
Dim swSectionLine             As Variant
Dim swSectionLineAnn              As SldWorks.DrSection

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If

Set swDraw = swModel
vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
    swDraw.ActivateSheet vSheet

    Set swView = swDraw.GetFirstView 
While Not swView Is Nothing
    
If swView.GetSectionLineCount2(1) > 0 Then
    Set swSectionLines = swView.GetSectionLines
        For Each swSectionLine In swSectionLines
            Set swBreakLineAnn = swSectionLine
            swSectionLineAnn.Layer = "Vues dérivées"
        Next
    Else: End If
        Set swView = swView.GetNextView
    Wend
Next
swModel.ClearSelection2 True

Mais ça ne fonctionne pas. J’ai une erreur « Type mismatch » sur

    Set swSectionLines = swView.GetSectionLines

Qqn aurait une idée ?

Pas eu le temps de regarder dans le détail et je doute d’avoir le temps cette semaine mais j’ai l’impression qu’il n’y a pas de possibilité de faire un Set pour modifier le calque sur cette fonction.
Pour le problème d’incompatibilité en lui-même je pense qu’il manque des paramètres ou des fonctions à appeler avant (GetSectionLineInfo par exemple).

1 « J'aime »

Alors, j’ai pu venir à bout des lignes de coupe et des vues de détail.

Mon code :


Function ChangeLayer(TypeElement As Integer)
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swLayerMgr                  As SldWorks.LayerMgr
    Dim vLayerArr                   As Variant
    Dim vLayer                      As Variant
    Dim swLayer                     As SldWorks.Layer
    Dim swDraw                      As SldWorks.DrawingDoc
    Dim vSheets                 As Variant
    Dim vSheet                  As Variant
    Dim MySheet                 As Variant
    Dim swSheet                     As SldWorks.Sheet
    Dim swView                      As SldWorks.View                '//vue de mise en plan//'
    Dim vSectionLines           As Variant
    Dim vSectionLine            As Variant
    Dim swSectionLine              As SldWorks.DrSection
    Dim vDetailCircles            As Variant
    Dim vDetailCircle             As Variant
    Dim swDetailCircle                As SldWorks.DetailCircle
    Dim ret                     As Boolean

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

  
    Set swDraw = swApp.ActiveDoc
    vSheets = swDraw.GetSheetNames
    For Each vSheet In vSheets
        swDraw.ActivateSheet vSheet                                 '//Pour chaque feuille de la mise en plan//'
        Set swView = swDraw.GetFirstView '//la feuille (fond de plan inclu)//'
        Set swView = swView.GetNextView '//la première vue//'

                    '//Traitement des vues de détail//'
                    vDetailCircles = swView.GetDetailCircles
                    If Not IsEmpty(vDetailCircles) Then
                        For Each vDetailCircle In vDetailCircles
                            Set swDetailCircle = vDetailCircle
                            swDetailCircle.Layer = "VUE DÉRIVÉE"
                        Next
                    End If

                    '//Traitement des vues en coupe//'
                    vSectionLines = swView.GetSectionLines
                    If Not IsEmpty(vSectionLines) Then
                        For Each vSectionLine In vSectionLines
                            Set swSectionLine = vSectionLine
                            swSectionLine.Layer = "COUPE"
                        Next
                    End If
                    '//Reconstruit affichage de la vue//'
                    ret = swDraw.Rebuild(swRebuildOptions_e.swCurrentSheetDisp)
 Set swView = swView.GetNextView
            Wend
    Next
    swModel.ClearSelection2 True
    swModel.ViewZoomtofit2          '//zoom au mieux sur la feuille//'
    
End Function

Et j’ai malheureusement eu confirmation qu’il n’est pas possible de définir le calque par défaut d’un document sur -Selon la norme- car pas d’API dispo. - Je vais faire avec !

Mon soucis maintenant c’est que j’ai plusieurs normes d’habillage à gérer, et que j’ai besoin d’identifier laquelle est chargée pour affecter ou non un calque aux différents éléments.

Si qqn a déjà ce bout de code qqpart, je suis preneur !

Bonjour,
Il faut ce bout de code:

Dim vDSNames                As Variant
Dim swModelDocExt           As ModelDocExtension

Set swModelDocExt = swModel.Extension
vDSNames = swModelDocExt.GetDraftingStandardNames

VDSNames va contenir toutes les normes d’habillage disponibles dans le menu déroulant.
Pour connaître celui appliqué:

Dim sNorm as String
sNorm = swModelDocExt.GetUserPreferenceString(SwConst.swDetailingDimensionStandardName, SwConst.swDetailingNoOptionSpecified)

Et enfin pour appliquer un nouveau modèle:

bRet = swModelDocExt.LoadDraftingStandard("xxx") 'Mettre le nom de la norme d'habillage souhaitée
2 « J'aime »

Un grand merci à vous @Cyril.f et @Maclane !
Avec votre aide j’arrive au bout de ce que j’ai besoin de faire.

Au top !

2 « J'aime »