LAYERS

[sechanbask]

moi ça plante dès le début

 

ThisDrawing.Linetypes.Load linetypeHidden, "acad.lin"

 

mais je ne sais pas pourquoi... pour l'instant.

[formula1]

en fait, je pense que ça viends des 2 autres type de ligne (CENTER2 ET PHANTOM2) car tans que j'avais juste hidden, la macro fonctionnais tres bien

[(gile)]

Regarde du côté de la variable système MEASUREMENT, elle détermine quels fichiers sont utilisés pour les types de ligne et les hachures.

 

Extrait de l'aide :

 

Détermine si le dessin courant utilise des fichiers de type de ligne et des motifs de hachure métrique ou anglo-saxons..

 

0

Système anglo-saxon ; utilise les fichiers de motifs de hachures et de type de ligne désignés par les paramètres de registre ANSIHatch et ANSILinetype.

 

1

Système métrique ; utilise les fichiers de motifs de hachures et de type de ligne désignés par les paramètres de registre ISOHatch et ISOLinetype.

 

 

Peut être est il prudent de faire un test sur sa valeur :

 

MEASUREMENT = 0 -> acad.lin et AutoCAD.pat

 

MEASUREMENT = 1 -> acadiso.lin et acadiso.pat

 

[Edité le 29/6/2007 par (gile)]

[formula1]

Gile, tu pourrais etre un peus plus précis car je suis débutant en VBA, alors je n'ai pas tres bien compris ta réponse

[(gile)]

Je ne connais pas le VBA, je suis plutôt lispeur.

 

Je voulais juste préciser que suivant la valeur de MEASUREMENT c'est le fichier AutoCAD.lin (système anglo-saxon ou impérial) ou acadiso.lin (système métrique) qui est utilisé.

 

Regarder aussi MEASUREINIT.

 

[Edité le 29/6/2007 par (gile)]

[sechanbask]

je pense que pour bien faire if faudrait initialiser les variables et après faire une recherche en fonction de ces variables sinon on va pas s'en sortir...

[formula1]

Ne cherche plus, je l'ai testée ce matin, et elle fonctionne parfaitement

[sechanbask]

tu as fait des modifications ?

 

[Edité le 30/6/2007 par sechanbask]

[formula1]

non.

Comment peut-on dire a un layer de ne pas s'imprimer car j'ai 3 layers qui ne doivent en aucun cas s'imprimer.

[(gile)]

Salut,

 

ça doit être quelque chose du style :

 

Dim MyLayer As AcadLayer
MyLayer.Plottable = False 

 

[Edité le 30/6/2007 par (gile)]

[sechanbask]

Alors pour que le calque ne soit pas imprimable :

 

newlayer1.Plottable = False

 

Je te remets mon code en entier car j'ai fait des modifications afin d'être sûr que ça marche quelque soit la valeur de la variable MEASUREMENT. Je pense que c'est important pour que ton application soit portable (pour qu' elle fonctionne partout, même sur un PC pour lequel rapnouv crée un plan avec les unités anglaises). Attention, il faut aussi que les lignes que tu souhaites charger soient toutes dans acadiso (seul le nom change un peu mais les 2 fichiers contiennent les mêmes lignes) car c'est acadiso.lin qui sera chargé.

 

Option Explicit
Sub calques()


Dim newlayer1 As AcadLayer
Set newlayer1 = ThisDrawing.Layers.Add("NOM DU CALQUE")
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call color.SetRGB(80, 100, 244)
newlayer1.TrueColor = color
newlayer1.Plottable = False

   Dim linetypeName As String
   linetypeName = "ZIGZAG"
   
[surligneur]Dim entry As AcadObject[/surligneur]
For Each entry In ThisDrawing.Linetypes
   If StrComp(entry.Name, linetypeName, 1) = 0 Then
       
   MsgBox linetypeName & " a été trouvé dans dessin actif."
   Dim trouve As Boolean
   trouve = True
   Exit For
   Else
   
   End If
   
   
Next
   
   If trouve = False Then
   Dim fichier1 As String
   Dim var As String
   [surligneur]var = ThisDrawing.GetVariable("MEASUREMENT")
   If var = 0 Then
   ThisDrawing.SetVariable "MEASUREMENT", 1
   var = ThisDrawing.GetVariable("MEASUREMENT")
   MsgBox "Le système des unités est initialisé en unités S.I."
   End If
   fichier1 = "acadiso.lin"[/surligneur]
   MsgBox var
   MsgBox linetypeName & " n'a pas été trouvé dans dessin actif. Nous allons donc le chercher dans le fichier " & fichier1
   
   ThisDrawing.Linetypes.Load linetypeName, [surligneur]"acadiso.lin"[/surligneur]
   MsgBox "trouvé dans fichier..."
   Else
   
   
   
   End If

   newlayer1.Linetype = linetypeName
   MsgBox "le calque NOM DU CALQUE a pour type de ligne : " & linetypeName
   
End Sub

 

bon courage

 

[Edité le 30/6/2007 par sechanbask]

[formula1]

Merci les gars, vous m'avez sorti d'un mauvais pas, maintenant plus besoin d'aller sur d'autre plans pour avoir mes layers.

[sechanbask]

j'ai oublié de te dire de déclarer :

 

Dim entry As AcadObject

 

je vais le mettre en jaune sur le code que je t'ai réécrit. c'est important sinon sur un autre poste tu risques d'avoir des erreurs si les options sont stricts au niveau de la déclaration des variables...

[formula1]

Sechanbask,

Peus-tu me dire pourquoi quand je charge mes layers via ma macro et que je veus imprimer (normalement en noir avec mon fichier .ctb) le preview qui normalement devrais etre noir, ben est en couleur?

[sechanbask]

ta preview est en couleur ou seulement ta présentation ?

 

Si c'est ta preview, je plus simple serai que tu me renvoies ton code fini pour que je regarde...

[formula1]

Voilà mon code

Private Sub CmdCoffrage_Click()

Dim linetypeHidden As String

Dim linetypeCenter2 As String

Dim linetypePhantom2 As String

linetypeHidden = "HIDDEN"

linetypeCenter2 = "CENTER2"

linetypePhantom2 = "PHANTOM2"

For Each entry In ThisDrawing.Linetypes

If StrComp(entry.Name, linetypeHidden, 1) = 0 Then

Dim trouve As Boolean

trouve = True

Exit For

Else

End If

Next

If trouve = False Then

Dim fichier1 As String

fichier1 = "acad.lin"

ThisDrawing.Linetypes.Load linetypeHidden, "acad.lin"

Else

End If

For Each entry In ThisDrawing.Linetypes

If StrComp(entry.Name, linetypeCenter2, 1) = 0 Then

End If

Next

If trouve = False Then

ThisDrawing.Linetypes.Load linetypeCenter2, "acad.lin"

Else

End If

For Each entry In ThisDrawing.Linetypes

If StrComp(entry.Name, linetypePhantom2, 1) = 0 Then

End If

Next

If trouve = False Then

ThisDrawing.Linetypes.Load linetypePhantom2, "acad.lin"

Else

End If

 

Dim newlayer1 As AcadLayer

Set newlayer1 = ThisDrawing.LAYERS.Add("BETON-CSP-CACHE")

Dim color As AcadAcCmColor

Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")

Call color.SetRGB(0, 255, 255)

newlayer1.TrueColor = color

newlayer1.Linetype = linetypeHidden

 

Dim newlayer2 As AcadLayer

Set newlayer2 = ThisDrawing.LAYERS.Add("BETON-CSP-COUPE")

Call color.SetRGB(255, 127, 255)

newlayer2.TrueColor = color

 

Dim newlayer3 As AcadLayer

Set newlayer3 = ThisDrawing.LAYERS.Add("BETON-CSP-VU")

Call color.SetRGB(159, 255, 127)

newlayer3.TrueColor = color

 

Dim newlayer4 As AcadLayer

Set newlayer4 = ThisDrawing.LAYERS.Add("BETON-PREF-VU")

Call color.SetRGB(0, 255, 255)

newlayer4.TrueColor = color

 

Dim newlayer5 As AcadLayer

Set newlayer5 = ThisDrawing.LAYERS.Add("BETON-PREF-COUPE")

Call color.SetRGB(255, 255, 0)

newlayer5.TrueColor = color

 

Dim newlayer6 As AcadLayer

Set newlayer6 = ThisDrawing.LAYERS.Add("BETON-PREF-CACHE")

Call color.SetRGB(255, 0, 0)

newlayer6.TrueColor = color

newlayer6.Linetype = linetypeHidden

 

Dim newlayer7 As AcadLayer

Set newlayer7 = ThisDrawing.LAYERS.Add("HOURDIS-COUPE")

Call color.SetRGB(114, 76, 152)

newlayer7.TrueColor = color

 

Dim newlayer8 As AcadLayer

Set newlayer8 = ThisDrawing.LAYERS.Add("HOURDIS-PLAN")

Call color.SetRGB(114, 76, 152)

newlayer8.TrueColor = color

newlayer8.Linetype = linetypePhantom2

 

Dim newlayer9 As AcadLayer

Set newlayer9 = ThisDrawing.LAYERS.Add("PREDALLES-PLAN")

Call color.SetRGB(114, 76, 152)

newlayer9.TrueColor = color

newlayer9.Linetype = linetypePhantom2

 

Dim newlayer10 As AcadLayer

Set newlayer10 = ThisDrawing.LAYERS.Add("MAC-COUPE")

Call color.SetRGB(152, 114, 76)

newlayer10.TrueColor = color

 

Dim newlayer11 As AcadLayer

Set newlayer11 = ThisDrawing.LAYERS.Add("MAC-VU")

Call color.SetRGB(255, 255, 255)

newlayer11.TrueColor = color

 

Dim newlayer12 As AcadLayer

Set newlayer12 = ThisDrawing.LAYERS.Add("MAC-CACHE")

Call color.SetRGB(255, 0, 0)

newlayer12.TrueColor = color

newlayer12.Linetype = linetypeHidden

 

Dim newlayer13 As AcadLayer

Set newlayer13 = ThisDrawing.LAYERS.Add("METAL-COUPE")

Call color.SetRGB(255, 127, 159)

newlayer13.TrueColor = color

 

Dim newlayer14 As AcadLayer

Set newlayer14 = ThisDrawing.LAYERS.Add("METAL-VU")

Call color.SetRGB(255, 0, 0)

newlayer14.TrueColor = color

 

Dim newlayer15 As AcadLayer

Set newlayer15 = ThisDrawing.LAYERS.Add("METAL-CACHE")

Call color.SetRGB(255, 127, 0)

newlayer15.TrueColor = color

newlayer15.Linetype = linetypeHidden

 

Dim newlayer16 As AcadLayer

Set newlayer16 = ThisDrawing.LAYERS.Add("AXES")

Call color.SetRGB(255, 255, 255)

newlayer16.TrueColor = color

newlayer16.Linetype = linetypeCenter2

 

Dim newlayer17 As AcadLayer

Set newlayer17 = ThisDrawing.LAYERS.Add("NUM-ELEMENT")

Call color.SetRGB(255, 0, 0)

newlayer17.TrueColor = color

 

Dim newlayer18 As AcadLayer

Set newlayer18 = ThisDrawing.LAYERS.Add("NUM-AXES")

Call color.SetRGB(255, 255, 255)

newlayer18.TrueColor = color

 

Dim newlayer19 As AcadLayer

Set newlayer19 = ThisDrawing.LAYERS.Add("TITRES")

Call color.SetRGB(255, 255, 0)

newlayer19.TrueColor = color

 

Dim newlayer20 As AcadLayer

Set newlayer20 = ThisDrawing.LAYERS.Add("PERCEMENTS")

Call color.SetRGB(152, 76, 76)

newlayer20.TrueColor = color

 

Dim newlayer21 As AcadLayer

Set newlayer21 = ThisDrawing.LAYERS.Add("CADRES")

Call color.SetRGB(255, 255, 255)

newlayer21.TrueColor = color

 

Dim newlayer22 As AcadLayer

Set newlayer22 = ThisDrawing.LAYERS.Add("CARTOUCHE")

Call color.SetRGB(255, 255, 255)

newlayer22.TrueColor = color

 

Dim newlayer23 As AcadLayer

Set newlayer23 = ThisDrawing.LAYERS.Add("TEXTES")

Call color.SetRGB(0, 255, 255)

newlayer23.TrueColor = color

 

Dim newlayer24 As AcadLayer

Set newlayer24 = ThisDrawing.LAYERS.Add("HACH-BETON-CSP")

Call color.SetRGB(76, 152, 152)

newlayer24.TrueColor = color

 

Dim newlayer25 As AcadLayer

Set newlayer25 = ThisDrawing.LAYERS.Add("HACH-BETON-PLAN")

Call color.SetRGB(214, 214, 214)

newlayer25.TrueColor = color

 

Dim newlayer26 As AcadLayer

Set newlayer26 = ThisDrawing.LAYERS.Add("HACH-BETON-PREF")

Call color.SetRGB(114, 76, 152)

newlayer26.TrueColor = color

 

Dim newlayer27 As AcadLayer

Set newlayer27 = ThisDrawing.LAYERS.Add("HACH-MAC")

Call color.SetRGB(255, 127, 127)

newlayer27.TrueColor = color

 

Dim newlayer28 As AcadLayer

Set newlayer28 = ThisDrawing.LAYERS.Add("HACH-DIVERS")

Call color.SetRGB(255, 255, 255)

newlayer28.TrueColor = color

 

Dim newlayer29 As AcadLayer

Set newlayer29 = ThisDrawing.LAYERS.Add("COTES-AXES-100")

Call color.SetRGB(255, 255, 255)

newlayer29.TrueColor = color

 

Dim newlayer30 As AcadLayer

Set newlayer30 = ThisDrawing.LAYERS.Add("COTES-AXES-50")

Call color.SetRGB(255, 255, 255)

newlayer30.TrueColor = color

 

Dim newlayer31 As AcadLayer

Set newlayer31 = ThisDrawing.LAYERS.Add("COTES-AXES-25")

Call color.SetRGB(255, 255, 255)

newlayer31.TrueColor = color

 

Dim newlayer32 As AcadLayer

Set newlayer32 = ThisDrawing.LAYERS.Add("COTES-AXES-20")

Call color.SetRGB(255, 255, 255)

newlayer32.TrueColor = color

 

Dim newlayer33 As AcadLayer

Set newlayer33 = ThisDrawing.LAYERS.Add("COTES-100")

Call color.SetRGB(255, 255, 255)

newlayer33.TrueColor = color

 

Dim newlayer34 As AcadLayer

Set newlayer34 = ThisDrawing.LAYERS.Add("COTES-50")

Call color.SetRGB(255, 255, 255)

newlayer34.TrueColor = color

 

Dim newlayer35 As AcadLayer

Set newlayer35 = ThisDrawing.LAYERS.Add("COTES-25")

Call color.SetRGB(255, 255, 255)

newlayer35.TrueColor = color

 

Dim newlayer36 As AcadLayer

Set newlayer36 = ThisDrawing.LAYERS.Add("COTES-20")

Call color.SetRGB(255, 255, 255)

newlayer36.TrueColor = color

 

Dim newlayer37 As AcadLayer

Set newlayer37 = ThisDrawing.LAYERS.Add("COTES-10")

Call color.SetRGB(255, 255, 255)

newlayer37.TrueColor = color

 

Dim newlayer38 As AcadLayer

Set newlayer38 = ThisDrawing.LAYERS.Add("DIVERS")

Call color.SetRGB(255, 255, 255)

newlayer38.TrueColor = color

 

Dim newlayer39 As AcadLayer

Set newlayer39 = ThisDrawing.LAYERS.Add("VPORT")

Call color.SetRGB(255, 127, 0)

newlayer39.TrueColor = color

newlayer39.Plottable = False

 

Dim newlayer40 As AcadLayer

Set newlayer40 = ThisDrawing.LAYERS.Add("CONSTRUCTION")

Call color.SetRGB(91, 91, 91)

newlayer40.TrueColor = color

newlayer40.Plottable = False

 

Dim newlayer41 As AcadLayer

Set newlayer41 = ThisDrawing.LAYERS.Add("METRE")

Call color.SetRGB(255, 127, 0)

newlayer41.TrueColor = color

newlayer41.Plottable = False

 

 

End Sub

 

Et je t'assure, il fonctionne sur plusieur pc mais uniquement dans des dessins vierge

[sechanbask]

tu n'a pas tenu compte de mes précédentes remarques... pas très bien ça... bon , je ne t'en tiendrai pas rigueur et je te change ton code (si je peux) pour te le redonner mais attention que ça ne se reproduise pas. Sinon (et là je fronce les sourcils) :

"ademus queratum, errores files" ça ne veut rien dire en latin mais je trouvais que ça clôturait bien mon post.

 

P.S. SS'il te plait, essaie de pas faire trop de faute de français dans tes messages, ça fait pas trop joli surtout que ça reste puisque c'est un écrit... Essaie firefox, on peux lui inclure une correction orthographique...

 

P.S.S. Tu travailles avec des plan en unités S.I. ou anglosaxonnes ?

[sechanbask]

Comme on vit dans un pays dans lequel les U.S.I. sont applicables et pas mal aplliquée... j'ai rendu ta commande portable, mais basé sur les U.S.I., si tu utilises les unités anglosaxonnes, il faudras faire des modifications...

 

Option Explicit

Sub CmdCoffrage()
Dim linetypeHidden As String
Dim linetypeCenter2 As String
Dim linetypePhantom2 As String
linetypeHidden = "CACHE"
linetypeCenter2 = "AXES2"
linetypePhantom2 = "FANTOME2"



ThisDrawing.SetVariable "MEASUREINIT", 1
ThisDrawing.SetVariable "MEASUREMENT", 1

Dim entry As AcadObject
For Each entry In ThisDrawing.Linetypes
If StrComp(entry.Name, linetypeHidden, 1) = 0 Then
Dim trouve As Boolean
trouve = True
Exit For
Else
End If
Next
If trouve = False Then
Dim fichier1 As String
fichier1 = "acadiso.lin"
ThisDrawing.Linetypes.Load linetypeHidden, "acadiso.lin"
Else
End If
For Each entry In ThisDrawing.Linetypes
If StrComp(entry.Name, linetypeCenter2, 1) = 0 Then
End If
Next
If trouve = False Then
ThisDrawing.Linetypes.Load linetypeCenter2, "acadiso.lin"
Else
End If
For Each entry In ThisDrawing.Linetypes
If StrComp(entry.Name, linetypePhantom2, 1) = 0 Then
End If
Next
If trouve = False Then
ThisDrawing.Linetypes.Load linetypePhantom2, "acadiso.lin"
Else
End If

Dim newlayer1 As AcadLayer
Set newlayer1 = ThisDrawing.Layers.Add("BETON-CSP-CACHE")
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call color.SetRGB(0, 255, 255)
newlayer1.TrueColor = color
newlayer1.Linetype = linetypeHidden

Dim newlayer2 As AcadLayer
Set newlayer2 = ThisDrawing.Layers.Add("BETON-CSP-COUPE")
Call color.SetRGB(255, 127, 255)
newlayer2.TrueColor = color

Dim newlayer3 As AcadLayer
Set newlayer3 = ThisDrawing.Layers.Add("BETON-CSP-VU")
Call color.SetRGB(159, 255, 127)
newlayer3.TrueColor = color

Dim newlayer4 As AcadLayer
Set newlayer4 = ThisDrawing.Layers.Add("BETON-PREF-VU")
Call color.SetRGB(0, 255, 255)
newlayer4.TrueColor = color

Dim newlayer5 As AcadLayer
Set newlayer5 = ThisDrawing.Layers.Add("BETON-PREF-COUPE")
Call color.SetRGB(255, 255, 0)
newlayer5.TrueColor = color

Dim newlayer6 As AcadLayer
Set newlayer6 = ThisDrawing.Layers.Add("BETON-PREF-CACHE")
Call color.SetRGB(255, 0, 0)
newlayer6.TrueColor = color
newlayer6.Linetype = linetypeHidden

Dim newlayer7 As AcadLayer
Set newlayer7 = ThisDrawing.Layers.Add("HOURDIS-COUPE")
Call color.SetRGB(114, 76, 152)
newlayer7.TrueColor = color

Dim newlayer8 As AcadLayer
Set newlayer8 = ThisDrawing.Layers.Add("HOURDIS-PLAN")
Call color.SetRGB(114, 76, 152)
newlayer8.TrueColor = color
newlayer8.Linetype = linetypePhantom2

Dim newlayer9 As AcadLayer
Set newlayer9 = ThisDrawing.Layers.Add("PREDALLES-PLAN")
Call color.SetRGB(114, 76, 152)
newlayer9.TrueColor = color
newlayer9.Linetype = linetypePhantom2

Dim newlayer10 As AcadLayer
Set newlayer10 = ThisDrawing.Layers.Add("MAC-COUPE")
Call color.SetRGB(152, 114, 76)
newlayer10.TrueColor = color

Dim newlayer11 As AcadLayer
Set newlayer11 = ThisDrawing.Layers.Add("MAC-VU")
Call color.SetRGB(255, 255, 255)
newlayer11.TrueColor = color

Dim newlayer12 As AcadLayer
Set newlayer12 = ThisDrawing.Layers.Add("MAC-CACHE")
Call color.SetRGB(255, 0, 0)
newlayer12.TrueColor = color
newlayer12.Linetype = linetypeHidden

Dim newlayer13 As AcadLayer
Set newlayer13 = ThisDrawing.Layers.Add("METAL-COUPE")
Call color.SetRGB(255, 127, 159)
newlayer13.TrueColor = color

Dim newlayer14 As AcadLayer
Set newlayer14 = ThisDrawing.Layers.Add("METAL-VU")
Call color.SetRGB(255, 0, 0)
newlayer14.TrueColor = color

Dim newlayer15 As AcadLayer
Set newlayer15 = ThisDrawing.Layers.Add("METAL-CACHE")
Call color.SetRGB(255, 127, 0)
newlayer15.TrueColor = color
newlayer15.Linetype = linetypeHidden

Dim newlayer16 As AcadLayer
Set newlayer16 = ThisDrawing.Layers.Add("AXES")
Call color.SetRGB(255, 255, 255)
newlayer16.TrueColor = color
newlayer16.Linetype = linetypeCenter2

Dim newlayer17 As AcadLayer
Set newlayer17 = ThisDrawing.Layers.Add("NUM-ELEMENT")
Call color.SetRGB(255, 0, 0)
newlayer17.TrueColor = color

Dim newlayer18 As AcadLayer
Set newlayer18 = ThisDrawing.Layers.Add("NUM-AXES")
Call color.SetRGB(255, 255, 255)
newlayer18.TrueColor = color

Dim newlayer19 As AcadLayer
Set newlayer19 = ThisDrawing.Layers.Add("TITRES")
Call color.SetRGB(255, 255, 0)
newlayer19.TrueColor = color

Dim newlayer20 As AcadLayer
Set newlayer20 = ThisDrawing.Layers.Add("PERCEMENTS")
Call color.SetRGB(152, 76, 76)
newlayer20.TrueColor = color

Dim newlayer21 As AcadLayer
Set newlayer21 = ThisDrawing.Layers.Add("CADRES")
Call color.SetRGB(255, 255, 255)
newlayer21.TrueColor = color

Dim newlayer22 As AcadLayer
Set newlayer22 = ThisDrawing.Layers.Add("CARTOUCHE")
Call color.SetRGB(255, 255, 255)
newlayer22.TrueColor = color

Dim newlayer23 As AcadLayer
Set newlayer23 = ThisDrawing.Layers.Add("TEXTES")
Call color.SetRGB(0, 255, 255)
newlayer23.TrueColor = color

Dim newlayer24 As AcadLayer
Set newlayer24 = ThisDrawing.Layers.Add("HACH-BETON-CSP")
Call color.SetRGB(76, 152, 152)
newlayer24.TrueColor = color

Dim newlayer25 As AcadLayer
Set newlayer25 = ThisDrawing.Layers.Add("HACH-BETON-PLAN")
Call color.SetRGB(214, 214, 214)
newlayer25.TrueColor = color

Dim newlayer26 As AcadLayer
Set newlayer26 = ThisDrawing.Layers.Add("HACH-BETON-PREF")
Call color.SetRGB(114, 76, 152)
newlayer26.TrueColor = color

Dim newlayer27 As AcadLayer
Set newlayer27 = ThisDrawing.Layers.Add("HACH-MAC")
Call color.SetRGB(255, 127, 127)
newlayer27.TrueColor = color

Dim newlayer28 As AcadLayer
Set newlayer28 = ThisDrawing.Layers.Add("HACH-DIVERS")
Call color.SetRGB(255, 255, 255)
newlayer28.TrueColor = color

Dim newlayer29 As AcadLayer
Set newlayer29 = ThisDrawing.Layers.Add("COTES-AXES-100")
Call color.SetRGB(255, 255, 255)
newlayer29.TrueColor = color

Dim newlayer30 As AcadLayer
Set newlayer30 = ThisDrawing.Layers.Add("COTES-AXES-50")
Call color.SetRGB(255, 255, 255)
newlayer30.TrueColor = color

Dim newlayer31 As AcadLayer
Set newlayer31 = ThisDrawing.Layers.Add("COTES-AXES-25")
Call color.SetRGB(255, 255, 255)
newlayer31.TrueColor = color

Dim newlayer32 As AcadLayer
Set newlayer32 = ThisDrawing.Layers.Add("COTES-AXES-20")
Call color.SetRGB(255, 255, 255)
newlayer32.TrueColor = color

Dim newlayer33 As AcadLayer
Set newlayer33 = ThisDrawing.Layers.Add("COTES-100")
Call color.SetRGB(255, 255, 255)
newlayer33.TrueColor = color

Dim newlayer34 As AcadLayer
Set newlayer34 = ThisDrawing.Layers.Add("COTES-50")
Call color.SetRGB(255, 255, 255)
newlayer34.TrueColor = color

Dim newlayer35 As AcadLayer
Set newlayer35 = ThisDrawing.Layers.Add("COTES-25")
Call color.SetRGB(255, 255, 255)
newlayer35.TrueColor = color

Dim newlayer36 As AcadLayer
Set newlayer36 = ThisDrawing.Layers.Add("COTES-20")
Call color.SetRGB(255, 255, 255)
newlayer36.TrueColor = color

Dim newlayer37 As AcadLayer
Set newlayer37 = ThisDrawing.Layers.Add("COTES-10")
Call color.SetRGB(255, 255, 255)
newlayer37.TrueColor = color

Dim newlayer38 As AcadLayer
Set newlayer38 = ThisDrawing.Layers.Add("DIVERS")
Call color.SetRGB(255, 255, 255)
newlayer38.TrueColor = color

Dim newlayer39 As AcadLayer
Set newlayer39 = ThisDrawing.Layers.Add("VPORT")
Call color.SetRGB(255, 127, 0)
newlayer39.TrueColor = color
newlayer39.Plottable = False

Dim newlayer40 As AcadLayer
Set newlayer40 = ThisDrawing.Layers.Add("CONSTRUCTION")
Call color.SetRGB(91, 91, 91)
newlayer40.TrueColor = color
newlayer40.Plottable = False

Dim newlayer41 As AcadLayer
Set newlayer41 = ThisDrawing.Layers.Add("METRE")
Call color.SetRGB(255, 127, 0)
newlayer41.TrueColor = color
newlayer41.Plottable = False


End Sub

 

j'espère que ça ira.. pour moi j'ai pas de problème pour les calques lors de la preview.

[formula1]

Merci, je vais tester ça et te tenir au courant si ça fonctionne.

[formula1]

Un grand MERCI à toi, ça fonctionne parfaitement.

[sechanbask]

ne te réjouis pas trop il arrive que la macro ne s'adapte pas partout, fait des test sur plusieurs postes et si tu ne relèves pas de problème, il faut que tu débugges ta macro en mettant :

 

On error resume next

 

Si tu as des problèmes, corriger les. Si tu n'y arrives pas fait une gestion d'erreur...

 

je te retrouverais sur l'autre sujet pour tes poutres peut-être... bon courage

[speedy]

Bonjour

 

j'ai éssayé ce code vba, il ne fonctionne pas du tout avec 2007, j'ai éssayé de rajouter la ligne On error resume next

 

là je plante autocad.....

 

 

pourrais tu méttre des commentaires dans le code pour que je comprenne mieux, et j'aimerais ensuite pouvoir le faire depuis excel ???

 

@+

 

Michel a

[sechanbask]

Pour que j'essaie de rendre le code portable, il me faudrait le type d'erreur et la ligne sur laquelle ça se produit... bientot

 

P.S. Je suis en train de regarder ton post Accueil du Forum > VBA et VB > Calques

[lili2006]

Bonjour à tous,

 

Pourrais-tu faire passer ton fichier Excel sechanbask, cela serait plus simple pour de novices comme moi, ou bien expliquer la procédure pour copier le code et l'utiliser. (Gile) avait fait un trés bon article sur l'utilisation des Lisps, il n'existe encore rien sur VB & VBA, ou bien ais-je (une fois de plus,...) mal cherché ??

 

Merci à ceux qui voudront bien se lancer et partager leurs connaissances.

 

En attendant, bon dimanche à tous.

[sechanbask]

je ne possède plus le fichiers. Mais je suis en train d'élaborer le protocole d'utilisation...