MACRO: set the default layer of a drawing to -According to the standard-

Hi everyone!

As part of an evolution of SW skin standards in the company, I realized that loading a new skin standard is not reliable: not all layers are present and even worse, the assignments are not always the right ones.

So I need to automate a lot of things:

  1. Check the existence of each layer, otherwise create the missing ones (some have custom colors → need to set the color with the RGB code

  2. Check the layers assigned for each element (dimensions, position label, center axis, cross-section, etc.) in the document properties

  3. Force the default layer of the document to -According to the standard- (when opening the default layer is set to -None-, and I want to change it to -According to the standard-).

  4. Reassign clip elements to the correct layers

I started with the last point for which I quickly found elements to help me on the forum, but I'm nevertheless stuck:

My 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

Problems /4:

  • Set swNote = swView.GetFirstNote allows me to select the notes attached to the views.
    But how do you select the notes attached to the sheet in turn?

  • Which API to select position labels?

  • Which API(s) to select the lines and cut labels?

Problems /3:

  • I tried with swDraw.SetCurrentLayer("-According to the standard-") but -According to the standard- not really being a slap in the face... nothing happens. I figured maybe it was assigned to the first index in the layer list, but swDraw.SetCurrentLayer(0) doesn't work either.
    Does anyone have an idea?

For the first 2 points I haven't started to look at them yet, but if anyone has elements or maybe even the code that allows you to make them I'm interested!

Thanks in advance!

Hello;
To browse all the Notes:
https://help.solidworks.com/2021/English/api/sldworksapi/Get_Views_and_Notes_Example_VB.htm

On the other hand, I use a macro for Drawings to reload the Standard AND the basemap which gives pretty good results...

To be associated with a condition:
filetype = swModel.GetType ' Gives the type of document opened with:0=swDocNONE; 1=swDocPART; 2=swDocASSEMBLY; 3=swDocDRAWING
If filetype = 3 Then' If the open file is a Drawing

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 Likes

Hello

Same answer as @Maclane.
To answer clearly,

No need to add and set layers, missing ones with their color settings are imported when changing the background. On the other hand, if there are layers with the same names that have been changed in their color setting, you will have to set the color.
Another point, if there are more layers in the old layers, you will also have to purge them and see to transfer what would be on them to another layer before deleting the layer.
As far as view labels and crop lines are concerned, as soon as you change the wrapping standard, it applies to the document without having to select the objects.

Finally, I have a piece of code that does a little bit of all this. I also have another piece of code that would allow you to scan all types of objects and probably retrieve their layer (I don't use it for that in the first place).
The @Maclane code is already a good start.
In your code, to scan the basemap you have to stay in the first " loop " related to:

Set swView = swDraw.GetFirstView

Basically, this line of code is to enter the background of the plan, if you write just last Set swView = swView.GetNextView, you go to the scan of the views of the plan.
So you have to loop in the basemap to recover everything that is there and apply the desired treatment.
To apply to the " According to the standard " layer, I haven't seen a method in the API and it seems to me that on the 2022 it bugs a bit (another memory topic on the forum in manual application Edit: Putting back /re-activating the layer " According to the standard " - 2D plan / Drawing - myCAD forum (visiativ.com)).

2 Likes

Re, untested code but should do the job I think:

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 Likes

Thank you for your answers. Your explanations have helped me understand a few things better.

The automatic reloading of the basemap each time a drawing document is opened in editing has already been present for a long time in the company (an add-on developed by the IT service) but I'm not a fan and neither are the manufacturers: it resets the anchor points. And for some reason, all the layers in the new document template (.drwdot and .slddrt), I always have a layer that's forgotten, and not always the same one! Hence my need to check the existence of each layer...

If the objects were created in the " -None- " layer, changing the wrapping standard does not affect any objects; that's why I need a code to process the objects, and especially to be able to redefine the default layer to " -According to the standard " but for this last point I couldn't find anything.

I managed to deal specifically with the position labels by checking the bubble style:

        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

I also think I've figured out how to deal with cut lines and interrupted sight lines...

1 Like

Hello

I omitted the snippet of code that updates the cutting settings...
I'm in the performance test phase on my workstation, as soon as I get my hand back I make the snippet of code available

If it helps, some of the settings to update in the document template:

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

To process the cut lines I wrote this 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

But it doesn't work. I have a "Type mismatch" error on

    Set swSectionLines = swView.GetSectionLines

Who has an idea?

I didn't have time to look in detail and I doubt I'll have time this week but I have the impression that there is no possibility to make a Set to modify the layer on this function.
For the incompatibility problem itself, I think that there are missing parameters or functions to call before (GetSectionLineInfo for example).

1 Like

So, I was able to get through the cut lines and detail views.

My 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

And I unfortunately had confirmation that it is not possible to set the default layer of a document to -According to the standard- because no API available. - I'll deal with it!

My problem now is that I have several skin standards to manage, and I need to identify which one is loaded to assign or not a layer to the different elements.

If someone already has this piece of code, I'm all for it!

Hello
You need this piece of code:

Dim vDSNames                As Variant
Dim swModelDocExt           As ModelDocExtension

Set swModelDocExt = swModel.Extension
vDSNames = swModelDocExt.GetDraftingStandardNames

VDSNames will contain all the skin standards available in the drop-down menu.
To find out which one is applied:

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

And finally to apply a new model:

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

A big thank you to you @Cyril.f and @Maclane !
With your help I am getting to the end of what I need to do.

At the top!

2 Likes