Hello fellows,

I've been trying to write a VBA macro to assign layers to a big drawing (i.e. many section views) of a relatively big assembly. It does work, except that it takes a fair amount of time to finish the process. For every "child" assembly it assigns a layer to it takes around 5 minutes, which is a lot, let alone the fact that the computer gets unbearably slow.

To assign all the layers I need it takes several hours, so it is impractical.

Can anyone help me to speed things up?

Here's the code:

Dim swApp As Object
Dim swDwg As SldWorks.DrawingDoc
Dim sheet1 As Sheet
Dim swLayerMgr As SldWorks.LayerMgr
Dim swSelMgr As SldWorks.SelectionMgr
Dim BA As Integer
Dim AnelPressao As Integer
Dim Bandagem As Integer
Dim Calco As Integer
Dim supLat As Integer
Dim Travessa As Integer
Dim contador As Integer
Dim swView As SldWorks.View
Dim swSubView As SldWorks.View
Dim dwgView As Feature
Dim swDrawComp As SldWorks.DrawingComponent
Dim pecas As Variant
Dim peca As Variant

'Dim peca As SldWorks.Entity

Sub main()

Set swApp = Application.SldWorks

Set swDwg = swApp.ActiveDoc

Set swLayerMgr = swDwg.GetLayerManager

IModelView:: EnableGraphicsUpdate = False

swDwg.Visible = False

BA = swLayerMgr.AddLayer("BARRA DE APERTO", "", RGB(0, 255, 255), 0, 0)

AnelPressao = swLayerMgr.AddLayer("ANEL DE PRESSÃO", "", RGB(0, 255, 0), 0, 0)

Bandagem = swLayerMgr.AddLayer("BANDAGEM", "", RGB(128, 0, 255), 0, 0)

Calco = swLayerMgr.AddLayer("CALÇO", "", RGB(128, 128, 0), 0, 0)

supLat = swLayerMgr.AddLayer("SUPORTE LATERAL", "", RGB(255, 0, 0), 0, 0)

Travessa = swLayerMgr.AddLayer("TRAVESSA", "", RGB(0, 128, 128), 0, 0)

If Not swDwg Is Nothing Then

Set sheet1 = swDwg.Sheet("Folha1")

Set swView = swDwg.GetFirstView
Set swSubView = swView.GetNextView


Do While Not swSubView Is Nothing

DoEvents
Debug.Print swSubView.Name
On Error Resume Next
Set swDrawComp = swSubView.RootDrawingComponent
pecas = swDrawComp.GetChildren


'For i = 0 To 2





For Each peca In pecas

'MsgBox peca.Name
DoEvents
Debug.Print peca.Name

For j = 1 To 10

If peca.Name = "CORE_AND_COIL-" & j & "/CLAMP_ASSEMBLY-1" Then

peca.Layer = "BARRA DE APERTO"

End If

If peca.Name = "CORE_AND_COIL-" & j & "/YOKE_BANDAGE-1" Then

peca.Layer = "BANDAGEM"

End If

If peca.Name = "CORE_AND_COIL-" & j & "/CLAMP_RING_UPPER-1" Then

peca.Layer = "ANEL DE PRESSÃO"

End If

If peca.Name = "CORE_AND_COIL-" & j & "/CLAMP_RING_LOWER-1" Then

peca.Layer = "ANEL DE PRESSÃO"

End If


If peca.Name = "CORE_AND_COIL-" & j & "/UPPER_SUPPORTS_ASSEMBLY-1" Then

peca.Layer = "CALÇO"

End If

If peca.Name = "CORE_AND_COIL-" & j & "/LOWER_SUPPORTS_ASSEMBLY-1" Then

peca.Layer = "CALÇO"

End If

Dim numLetra As String
numLetra = j

If ((InStr(peca.Name, "BUMPER") > 0) And (InStr(peca.Name, numLetra) > 0)) Then

peca.Layer = "SUPORTE LATERAL"

End If

If ((InStr(peca.Name, "CROSSBAR") > 0) And (InStr(peca.Name, numLetra) > 0)) Then

peca.Layer = "TRAVESSA"

End If


'Debug.Print j

Next

Next

' If swSelObj.Name = "UPPER_CLAMP_PLATE_BT-1" Then
'
' swSelObj.Layer = "BARRA DE APERTO"
'
' End If

Set swSubView = swSubView.GetNextView
Loop


End If
'For Each peca In swDwg
'
' If peca.ModelName = "UPPER_CLAMP_PLATE_BT" Then
' peca.Layer = "BANDAGEM"
' End If
'
'Next

swDwg.Visible = True

Debug.Print "END"

End Sub