CAD Forum

A place FOR CAD users BY CAD users
https://cadforum.net/

Macro to create layer and set it to active state

https://cadforum.net/viewtopic.php?t=3087

Page 1 of 1

Macro to create layer and set it to active state

Posted: Thu Nov 02, 2023 11:40 am
by jeremyrz
Hye,

I'm expected to create a Macro that could create a Layer, and set it in an active state, before adding a BOM in this layer, in my assembly drawing.
I've search on site like, Codestacks or cadCoder, but nothing that i can really use to do this.

A have allready find a macro to add a BOM, i just nead the part with Layer.

If someone could help me.
Thanks a lot.

Re: Macro to create layer and set it to active state

Posted: Thu Nov 02, 2023 3:26 pm
by SPerman
Do either of these links help?

https://help.solidworks.com/2023/englis ... Redirect=1

https://help.solidworks.com/2023/Englis ... Redirect=1

Re: Macro to create layer and set it to active state

Posted: Fri Nov 03, 2023 6:37 am
by jeremyrz
Hye SPerman,

Thanks you for the links.
I've allready seen this kind of help on solidworks, but i don't know how to use it.
Especially for the "Declaration" field. Where i put that in my VBA macro ?
What mean the "_" at the end of each line ?
VBA
VBA
looking forward to hearing from you

Re: Macro to create layer and set it to active state

Posted: Sun Nov 05, 2023 11:45 pm
by zwei
Example macro below:

Code: Select all

'==================== Preamble ===================='
Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc



Dim boolstatus          As Boolean
Dim lErrors             As Long
Dim lWarnings           As Long


'=================================================='

'==================== MainCode ===================='
Sub main()

    Set swApp = Application.SldWorks
    
    'Get active document
    Set swModel = swApp.ActiveDoc
    
    'Display message and terminate if not drawing
    If Not swModel.GetType() = swDocDRAWING Then
        'If not drawing
        MsgBox "Macro only work on drawing file.", vbCritical, "ERROR"
        End
    End If
    Set swDraw = swModel
    
    'Create Layer
    boolstatus = swDraw.CreateLayer("TestLayer", "TestDescription", 255, swLineCONTINUOUS, swLW_THICK, True)
    
    'Activate Layer
    boolstatus = swDraw.SetCurrentLayer("TestLayer")
    
    Set swModel = Nothing
End Sub
'=================================================='
You will need to change the two line below manually:
'Create Layer
boolstatus = swDraw.CreateLayer("TestLayer", "TestDescription", 255, swLineCONTINUOUS, swLW_THICK, True)

'Activate Layer
boolstatus = swDraw.SetCurrentLayer("TestLayer")

Re: Macro to create layer and set it to active state

Posted: Mon Nov 06, 2023 4:40 am
by Tera
jeremyrz wrote: ↑Fri Nov 03, 2023 6:37 am What mean the "_" at the end of each line ?
In VBA, When a line of code is too long, you can divide it to several lines by adding a "_ " at the end of the code.

So if you have a line like :

Code: Select all

If swFeat.GetTypeName = "SolidBodyFolder" Or swFeat.GetTypeName = "CutListFolder" Or swFeat.GetTypeName = "SubWeldFolder" Then
You can add an _ to the end and continue in the next line.
Sometimes it makes your code much better readable.

Code: Select all

If swFeat.GetTypeName = "SolidBodyFolder" Or _
        swFeat.GetTypeName = "CutListFolder" Or _
        swFeat.GetTypeName = "SubWeldFolder" Then

Re: Macro to create layer and set it to active state

Posted: Tue Nov 07, 2023 6:24 am
by jeremyrz
Tanks you Tera.

And thank you Zwei, you helped me find a solution.
However, some problems remain:

- The BOM, which in the VBA program is generated after layer creation, is not created with the active layer, but in another layer "0".
The new layer becomes active in SW, but the BOM does not take it into account. Nor is the BOM created with the layer
defined in Options/Document properties/Tables/BOM.
You can see the Vba lines below to test it.

What could be the solution ?

Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopRight
Const BOM_TYPE As Integer = swBomType_e.swBomType_PartsOnly
Const TABLE_TEMPLATE_SIMPLE As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\Nomenclatures-Qte-CodeSAP.sldbomtbt"
Const TABLE_TEMPLATE_STD As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_FR As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_FR.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_EN As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_EN.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_AL As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_AL.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_ES As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_ES.sldbomtbt"
Const INDENTED_NUMBERING_TYPE As Integer = swNumberingType_e.swNumberingType_Flat
Const DETAILED_CUT_LIST As Boolean = False
Const FOLLOW_ASSEMBLY_ORDER As Boolean = True
Const ALL_SHEETS As Boolean = False


Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc


Sub main()

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc

'Get active document
Set swModel = swApp.ActiveDoc

Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long



'Display message and terminate if not drawing
If Not swModel.GetType() = swDocDRAWING Then
'If not drawing
MsgBox "Macro only work on drawing file.", vbCritical, "ERROR"
End
End If
Set swDraw = swModel

'Création calque BOM_SIMPLE
boolstatus = swDraw.CreateLayer("BOM_SIMPLE", "Nomenclature Ss Description", 255, swLineCONTINUOUS, swLW_THICK, True)

'Active calque BOM_SIMPLE
boolstatus = swDraw.SetCurrentLayer("BOM_SIMPLE")

Set swModel = Nothing

'If ALL_SHEETS Then

'Dim vSheetNames As Variant
'vSheetNames = swDraw.GetSheetNames

'Dim activeSheetName As String
' activeSheetName = swDraw.GetCurrentSheet().GetName

'Dim i As Integer

'For i = 0 To UBound(vSheetNames)
'Dim swSheet As SldWorks.sheet
' Set swSheet = swDraw.sheet(CStr(vSheetNames(i)))
'InsertBomTable swDraw, swSheet
'Next

'swDraw.ActivateSheet activeSheetName

'Else
InsertBomTable swDraw, swDraw.GetCurrentSheet
'End If

End Sub

Sub InsertBomTable(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)

If False = draw.ActivateSheet(sheet.GetName()) Then
Err.Raise vbError, "", "Failed to activate sheet " & sheet.GetName
End If

Dim vViews As Variant
vViews = sheet.GetViews

Dim swView As SldWorks.View

Set swView = vViews(0)

Dim swBomTableAnn As SldWorks.BomTableAnnotation

Set swBomTableAnn = swView.InsertBomTable4(True, 0, 0, ANCHOR_TYPE, BOM_TYPE, "", TABLE_TEMPLATE_SIMPLE, False, INDENTED_NUMBERING_TYPE, DETAILED_CUT_LIST)

If Not swBomTableAnn Is Nothing Then
swBomTableAnn.BomFeature.FollowAssemblyOrder2 = FOLLOW_ASSEMBLY_ORDER
Else
Err.Raise vbError, "", "Failed to insert BOM table into " & swView.Name
End If

End Sub

- Is it possible, once the BOM has been created with the new layer, to hide this layer?

Thanks you so much. :D

Re: Macro to create layer and set it to active state

Posted: Wed Nov 08, 2023 8:16 pm
by zwei
jeremyrz wrote: ↑Tue Nov 07, 2023 6:24 am - The BOM, which in the VBA program is generated after layer creation, is not created with the active layer, but in another layer "0".
The new layer becomes active in SW, but the BOM does not take it into account. Nor is the BOM created with the layer
defined in Options/Document properties/Tables/BOM.
You can see the Vba lines below to test it.

What could be the solution ?
InsertBOM does not set the layer, you will need to set the layer after you insert the code

Code: Select all

Set swTable = swBomTableAnn
swTable.GetAnnotation.Layer = "BOM_SIMPLE"
- Is it possible, once the BOM has been created with the new layer, to hide this layer?

Thanks you so much. :D
If you mean turning off the layer visibility, then yes. You can even do it before inserting the bom if you want...

Code: Select all

'Turn layer visibility off
    Set swLayerMgr = swModel.GetLayerManager
    Set swLayer = swLayerMgr.GetLayer("BOM_SIMPLE")
    swLayer.Visible = False

I had updated your code as shown below:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc

Dim swTable As SldWorks.TableAnnotation
Dim swLayerMgr As SldWorks.LayerMgr
Dim swLayer As SldWorks.Layer

Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopRight
Const BOM_TYPE As Integer = swBomType_e.swBomType_PartsOnly
Const TABLE_TEMPLATE_SIMPLE As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\Nomenclatures-Qte-CodeSAP.sldbomtbt"
Const TABLE_TEMPLATE_STD As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_FR As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_FR.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_EN As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_EN.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_AL As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_AL.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_ES As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_ES.sldbomtbt"
Const INDENTED_NUMBERING_TYPE As Integer = swNumberingType_e.swNumberingType_Flat
Const DETAILED_CUT_LIST As Boolean = False
Const FOLLOW_ASSEMBLY_ORDER As Boolean = True
Const ALL_SHEETS As Boolean = False


Sub main()

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc

'Get active document
Set swModel = swApp.ActiveDoc

'Display message and terminate if not drawing
If Not swModel.GetType() = swDocDRAWING Then
'If not drawing
MsgBox "Macro only work on drawing file.", vbCritical, "ERROR"
End
End If
Set swDraw = swModel

'Création calque BOM_SIMPLE
boolstatus = swDraw.CreateLayer("BOM_SIMPLE", "Nomenclature Ss Description", 255, swLineCONTINUOUS, swLW_THICK, True)

'Active calque BOM_SIMPLE
boolstatus = swDraw.SetCurrentLayer("BOM_SIMPLE")



'If ALL_SHEETS Then

'Dim vSheetNames As Variant
'vSheetNames = swDraw.GetSheetNames

'Dim activeSheetName As String
' activeSheetName = swDraw.GetCurrentSheet().GetName

'Dim i As Integer

'For i = 0 To UBound(vSheetNames)
'Dim swSheet As SldWorks.sheet
' Set swSheet = swDraw.sheet(CStr(vSheetNames(i)))
'InsertBomTable swDraw, swSheet
'Next

'swDraw.ActivateSheet activeSheetName

'Else
InsertBomTable swDraw, swDraw.GetCurrentSheet
'End If

'Set BOM Layer
Set swTable = swBomTableAnn
swTable.GetAnnotation.Layer = "BOM_SIMPLE"

'Set turn off layer visibility
Set swLayerMgr = swModel.GetLayerManager
Set swLayer = swLayerMgr.GetLayer("BOM_SIMPLE")
swLayer.Visible = False


Set swModel = Nothing

End Sub

Sub InsertBomTable(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)

If False = draw.ActivateSheet(sheet.GetName()) Then
Err.Raise vbError, "", "Failed to activate sheet " & sheet.GetName
End If

Dim vViews As Variant
vViews = sheet.GetViews

Dim swView As SldWorks.View

Set swView = vViews(0)

Dim swBomTableAnn As SldWorks.BomTableAnnotation

Set swBomTableAnn = swView.InsertBomTable4(True, 0, 0, ANCHOR_TYPE, BOM_TYPE, "", TABLE_TEMPLATE_SIMPLE, False, INDENTED_NUMBERING_TYPE, DETAILED_CUT_LIST)

If Not swBomTableAnn Is Nothing Then
swBomTableAnn.BomFeature.FollowAssemblyOrder2 = FOLLOW_ASSEMBLY_ORDER
Else
Err.Raise vbError, "", "Failed to insert BOM table into " & swView.Name
End If

End Sub

Re: Macro to create layer and set it to active state

Posted: Thu Nov 09, 2023 6:27 am
by jeremyrz
Hello Zwei,

Image
It seems that the modifications you made generate a compilation error when I run the macro.
And since I'm not a VBA specialist at all, I can't find the solution to this error.
Could you please test it at home to see if you get the same thing?

Thanks a lot!

Re: Macro to create layer and set it to active state

Posted: Thu Nov 09, 2023 7:34 am
by SPerman
The problem (for me at least) occurs here:

Set swTable = swBomTableAnn

swBomTableAnn is defined in the subroutine, but not in the main function.

Re: Macro to create layer and set it to active state

Posted: Thu Nov 09, 2023 8:09 am
by zwei
Sperman is correct, i missed out the sub routine, move the code that set the table layer to the subroutine should fix the issue
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc

Dim swTable As SldWorks.TableAnnotation
Dim swLayerMgr As SldWorks.LayerMgr
Dim swLayer As SldWorks.Layer

Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopRight
Const BOM_TYPE As Integer = swBomType_e.swBomType_PartsOnly
Const TABLE_TEMPLATE_SIMPLE As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\Nomenclatures-Qte-CodeSAP.sldbomtbt"
Const TABLE_TEMPLATE_STD As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_FR As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_FR.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_EN As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_EN.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_AL As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_AL.sldbomtbt"
'Const TABLE_TEMPLATE_BASE_ES As String = "\\vmisw2022\DataSolidWorks\ModelesVMI\Tables\NomenclaturesSAP_SIMP_ES.sldbomtbt"
Const INDENTED_NUMBERING_TYPE As Integer = swNumberingType_e.swNumberingType_Flat
Const DETAILED_CUT_LIST As Boolean = False
Const FOLLOW_ASSEMBLY_ORDER As Boolean = True
Const ALL_SHEETS As Boolean = False


Sub main()

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc

'Get active document
Set swModel = swApp.ActiveDoc

'Display message and terminate if not drawing
If Not swModel.GetType() = swDocDRAWING Then
'If not drawing
MsgBox "Macro only work on drawing file.", vbCritical, "ERROR"
End
End If
Set swDraw = swModel

'Création calque BOM_SIMPLE
boolstatus = swDraw.CreateLayer("BOM_SIMPLE", "Nomenclature Ss Description", 255, swLineCONTINUOUS, swLW_THICK, True)

'Active calque BOM_SIMPLE
boolstatus = swDraw.SetCurrentLayer("BOM_SIMPLE")



'If ALL_SHEETS Then

'Dim vSheetNames As Variant
'vSheetNames = swDraw.GetSheetNames

'Dim activeSheetName As String
' activeSheetName = swDraw.GetCurrentSheet().GetName

'Dim i As Integer

'For i = 0 To UBound(vSheetNames)
'Dim swSheet As SldWorks.sheet
' Set swSheet = swDraw.sheet(CStr(vSheetNames(i)))
'InsertBomTable swDraw, swSheet
'Next

'swDraw.ActivateSheet activeSheetName

'Else
InsertBomTable swDraw, swDraw.GetCurrentSheet
'End If



'Set turn off layer visibility
Set swLayerMgr = swModel.GetLayerManager
Set swLayer = swLayerMgr.GetLayer("BOM_SIMPLE")
swLayer.Visible = False


Set swModel = Nothing

End Sub

Sub InsertBomTable(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)

If False = draw.ActivateSheet(sheet.GetName()) Then
Err.Raise vbError, "", "Failed to activate sheet " & sheet.GetName
End If

Dim vViews As Variant
vViews = sheet.GetViews

Dim swView As SldWorks.View

Set swView = vViews(0)

Dim swBomTableAnn As SldWorks.BomTableAnnotation

Set swBomTableAnn = swView.InsertBomTable4(True, 0, 0, ANCHOR_TYPE, BOM_TYPE, "", TABLE_TEMPLATE_SIMPLE, False, INDENTED_NUMBERING_TYPE, DETAILED_CUT_LIST)

If Not swBomTableAnn Is Nothing Then
swBomTableAnn.BomFeature.FollowAssemblyOrder2 = FOLLOW_ASSEMBLY_ORDER

'Set BOM Layer
Set swTable = swBomTableAnn
swTable.GetAnnotation.Layer = "BOM_SIMPLE"

Else
Err.Raise vbError, "", "Failed to insert BOM table into " & swView.Name
End If



End Sub

Re: Macro to create layer and set it to active state

Posted: Tue Nov 14, 2023 8:05 am
by jeremyrz
Hello Zwei and Superman

Thanks for your help, it works very well.
UU
All times are UTC-05:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited