Première routine VBA

[jms]

Salut,

Comme le titre l'indique, je tente d'approcher le VBA, avec un premier succès...mitigé !

La routine que j'ai rédigée doit simplement rendre courant le layer "0", activer tous les layers, dégeler tous les layers et es geler tous sauf certains.

Aucun message d'erreur, mais pas moyen de rendre les layers actifs.

Quelqu'un voit-il pourquoi ?

 

Sub Layers()

'Rend courant le layer "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Dégeler tous les layers du dessin:
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" Then Layer.Freeze = False
Next

'Activer tous les layers du dessin:
For Each Layer In ThisDrawing.Layers
LayerOn = True
Next Layer

'Geler tous les layers sauf certains :
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" And Layer.Name <> "AR_TXT_M2" And Layer.Name <> "AR_TXT_NOMS" And Layer.Name <> "CARTOUCHE" And Layer.Name <> "CLOISONS" And Layer.Name <> "FD" And Layer.Name <> "FD_FENETRES" And Layer.Name <> "FD_HACHURES" And Layer.Name <> "FD_MOBILIER" And Layer.Name <> "FD_PORTES" And Layer.Name <> "FD_SANITAIRES" And Layer.Name <> "FN" And Layer.Name <> "FN$" And Layer.Name <> "TXT" Then
If Layer.Name <> "0" Then Layer.Freeze = True
End If
Next

ThisDrawing.Regen acActiveViewport

End Sub

[didier]

Bonjour @jms

Voici un code fonctionnel :

 Sub Layers()
'Rend courant le calque "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Activer et geler tous les calques du dessin:
For Each objLayer In ThisDrawing.Layers
    If objLayer.Name <> "0" Then
        objLayer.LayerOn = True
        objLayer.Freeze = True
    End If
Next

'Dégeler certains calques :
For Each Layer In ThisDrawing.Layers
If Layer.Name = "AR_TXT_M2" Then Layer.Freeze = False
If Layer.Name = "AR_TXT_NOMS" Then Layer.Freeze = False
If Layer.Name = "CARTOUCHE" Then Layer.Freeze = False
If Layer.Name = "CLOISONS" Then Layer.Freeze = False
If Layer.Name = "FD" Then Layer.Freeze = False
If Layer.Name = "FD_FENETRES" Then Layer.Freeze = False
If Layer.Name = "FD_HACHURES" Then Layer.Freeze = False
If Layer.Name = "FD_MOBILIER" Then Layer.Freeze = False
If Layer.Name = "FD_PORTES" Then Layer.Freeze = False
If Layer.Name = "FD_SANITAIRES" Then Layer.Freeze = False
If Layer.Name = "FN" Then Layer.Freeze = False
If Layer.Name = "FN$" Then Layer.Freeze = False
If Layer.Name = "TXT" Then Layer.Freeze = False
Next

ThisDrawing.Regen acActiveViewport

End Sub

Amicalement

[jms]

Solution apportée par un collègue, qui mange du VBA depuis plus de 20 ans 🙂 : je n'avais pas mentionné l'objet du "LayerOn = True". Que je devais donc écrire "Layer.LayerOn = True"

En définitive, j'ai inversé des lignes, rendant le layer "0" courant seulement APRÈS m'être assuré que tous les layers sont bien actifs et dégelès.

Ce qui donne :

 

Sub Etat_De_Layer()

'Dégeler et activer tous les layers du dessin:
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" Then Layer.Freeze = False
Layer.LayerOn = True
Next

'Rend courant le layer "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Geler tous les layers sauf certains :
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" And Layer.Name <> "AR_TXT_M2" And Layer.Name <> "AR_TXT_NOMS" And Layer.Name <> "CARTOUCHE" And Layer.Name <> "CLOISONS" And Layer.Name <> "FD" And Layer.Name <> "FD_CLOISONS" And Layer.Name <> "FD_FENETRES" And Layer.Name <> "FD_HACHURES" And Layer.Name <> "FD_MOBILIER" And Layer.Name <> "FD_PORTES" And Layer.Name <> "FD_SANITAIRES" And Layer.Name <> "FN" And Layer.Name <> "FN$" And Layer.Name <> "TXT" Then
If Layer.Name <> "0" Then Layer.Freeze = True
End If
Next

ThisDrawing.Regen acActiveViewport

End Sub

 

[jms]

il y a 1 minute, didier a dit :

Bonjour @jms

Voici un code fonctionnel :

 Sub Layers()
'Rend courant le calque "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Activer et geler tous les calques du dessin:
For Each objLayer In ThisDrawing.Layers
    If objLayer.Name <> "0" Then
        objLayer.LayerOn = True
        objLayer.Freeze = True
    End If
Next

'Dégeler certains calques :
For Each Layer In ThisDrawing.Layers
If Layer.Name = "AR_TXT_M2" Then Layer.Freeze = False
If Layer.Name = "AR_TXT_NOMS" Then Layer.Freeze = False
If Layer.Name = "CARTOUCHE" Then Layer.Freeze = False
If Layer.Name = "CLOISONS" Then Layer.Freeze = False
If Layer.Name = "FD" Then Layer.Freeze = False
If Layer.Name = "FD_FENETRES" Then Layer.Freeze = False
If Layer.Name = "FD_HACHURES" Then Layer.Freeze = False
If Layer.Name = "FD_MOBILIER" Then Layer.Freeze = False
If Layer.Name = "FD_PORTES" Then Layer.Freeze = False
If Layer.Name = "FD_SANITAIRES" Then Layer.Freeze = False
If Layer.Name = "FN" Then Layer.Freeze = False
If Layer.Name = "FN$" Then Layer.Freeze = False
If Layer.Name = "TXT" Then Layer.Freeze = False
Next

ThisDrawing.Regen acActiveViewport

End Sub

Amicalement

nos réponses viennent de se croiser 🙂

[jms]

il y a 4 minutes, didier a dit :

Bonjour @jms

Voici un code fonctionnel :

 Sub Layers()
'Rend courant le calque "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Activer et geler tous les calques du dessin:
For Each objLayer In ThisDrawing.Layers
    If objLayer.Name <> "0" Then
        objLayer.LayerOn = True
        objLayer.Freeze = True
    End If
Next

'Dégeler certains calques :
For Each Layer In ThisDrawing.Layers
If Layer.Name = "AR_TXT_M2" Then Layer.Freeze = False
If Layer.Name = "AR_TXT_NOMS" Then Layer.Freeze = False
If Layer.Name = "CARTOUCHE" Then Layer.Freeze = False
If Layer.Name = "CLOISONS" Then Layer.Freeze = False
If Layer.Name = "FD" Then Layer.Freeze = False
If Layer.Name = "FD_FENETRES" Then Layer.Freeze = False
If Layer.Name = "FD_HACHURES" Then Layer.Freeze = False
If Layer.Name = "FD_MOBILIER" Then Layer.Freeze = False
If Layer.Name = "FD_PORTES" Then Layer.Freeze = False
If Layer.Name = "FD_SANITAIRES" Then Layer.Freeze = False
If Layer.Name = "FN" Then Layer.Freeze = False
If Layer.Name = "FN$" Then Layer.Freeze = False
If Layer.Name = "TXT" Then Layer.Freeze = False
Next

ThisDrawing.Regen acActiveViewport

End Sub

Amicalement

Merci Didier !

Le tien a l'avantage de présenter les layer à dégeler en plus de lignes que dans mon vba mais avec plus de facilité pour insèrer ou supprimer un layer. Maintenant le mien fonctionne correctement mais je vais tester le tien.