jms Posté(e) le 20 mars Partager Posté(e) le 20 mars 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 Lien vers le commentaire Partager sur d’autres sites More sharing options...
didier Posté(e) le 20 mars Partager Posté(e) le 20 mars 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 Éternel débutant... Mon site perso : Programmer dans AutoCAD Lien vers le commentaire Partager sur d’autres sites More sharing options...
jms Posté(e) le 20 mars Auteur Partager Posté(e) le 20 mars 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 Lien vers le commentaire Partager sur d’autres sites More sharing options...
jms Posté(e) le 20 mars Auteur Partager Posté(e) le 20 mars 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 🙂 Lien vers le commentaire Partager sur d’autres sites More sharing options...
jms Posté(e) le 20 mars Auteur Partager Posté(e) le 20 mars 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. Lien vers le commentaire Partager sur d’autres sites More sharing options...
Messages recommandés
Créer un compte ou se connecter pour commenter
Vous devez être membre afin de pouvoir déposer un commentaire
Créer un compte
Créez un compte sur notre communauté. C’est facile !
Créer un nouveau compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant