LAYERS

[formula1]

Bonjours,

Je cherche a faire un petit prog en VBA qui me permetrais de charger une liste de layers que j'aurais définie.

Ainsi ça méviterai de devoir les piquer sur mes autres plans.

Merci d'avance pour vos réponses.

[Krynn]

Hello, 2 petites questions:

- il y a bcp de plans ou il faut mettre la liste de calque?

- pourquoi en VBA?

 

1) Si les plans n'existe pas encore, il faut faire un DWT (fichier modèle)

 

2) Si les fichiers existe et qu'il y en as pas bcp, le lieux est d'utiliser le Design Center (c'est peu etre ce que cous faite deja?

 

3) un petit scripte style -_LAYER N "nonducalque" ; -_LAYER N "nonducalque2" ; ... (c'est un peu tard pour me pancher dessus)

 

3) Si il y en a bcp, un script (le meme que celui d'au dessus) avec http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=15445#pid62971 est la meilleures solution

[Krynn]

voila en script:

_-layer;N;nomducalques;N;nomducalques2;N;nomducalques3;;

[sechanbask]

En VBA pour créer un calque :

 

Dim newlayer1 As AcadLayer
Set newlayer1 = ThisDrawing.Layers.Add("NOM DU CALQUE")

 

Pour le rendre actif:

 

ThisDrawing.ActiveLayer = ThisDrawing.Layers("NOM DU CALQUE")

 

 

Pour récupérer le calque courant:

Function CalqueCourant()
StrCalqueCourant = ThisDrawing.ActiveLayer.Name
End Function

 

Bon courage.

[formula1]

Merci, ça marche mais comment je peus leur donner la couleur et le type de trait?

[sechanbask]

Avec VBA, on peut tout faire enfin je pense :cool:

 

 

Pense à regarder l'aide d'autocad (pas de VBA mais autocad, le dernier point du sommaire générale)

 

Je te donne un exemple pour la couleur et si tu n'arrives à trouver la méthode pour les lignes je te filerai un coup de main :

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
End Sub

 

bon courage...

[formula1]

Un grand merci a toi pour la couleur, mais pour les types de ligne, j'ai chercher toute la soirée dans l'aide de autocad, mais je n'ai pas trouver.

Il faut savoir que je débute dans le vba.

[sechanbask]

Coucou,

 

J'avoue avoir étais un peu sec dans mes propos mais c'est pour que tu comprennes qu'une fois que tu auras réussi à comprendre l'aide de VBA, tu sauras tout faire et à ce moment là, tu n'auras plus besoin de l'aide... je déconne un peu mais l'aide est bien faite cependant mais c'est vrai qu'elle devient utilisable qu'à un certain moment...

 

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
'si le type de ligne est dans les fichiers de ligne autocad
For Each entry In ThisDrawing.Linetypes
       If StrComp(entry.name, "ZIGZAG", 1) = 0 Then
           Exit For
       End If
   Next
newlayer1.Linetype = "ZIGZAG"
End Sub

 

Par contre si tu sais que ta ligne ne dépend d'un fichier chargé par autocad, il faut définir ton type de ligne et là attention ça devient dur voire très dur...

 

Bon courage... je suis étonné que le forum de VBA soit si plat en ce moment et ça me désole un peu... c'est la vie, je suis dépassé par le lisp comme si j'étais un vieux mdr

[formula1]

Merci, mais j'ai essayer ton code, mais ça ne fonctionne pas, est-ce qu'il ne fudrais pas charger a un momment le type de ligne?

[sechanbask]

Il fonctionne chez moi...

Tu as quel type d'erreur? erreur de variable?

[formula1]

C'est une erreur d'execution qu'il m'indique.

il me dit que 'La Methode Linetype de l'objet IAcadLayer a échoué.

[sechanbask]

j'ai trouvé pour le type de ligne mais le plus compliqué, ça va être de te l'expliquer car il va falloir faire des boucles, un test ...

je le poste quand j'aurais fini de manger car là j'ai très faim...

 

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

[formula1]

Pour le probleme de ligne, ne cherche plus, j'ai trouvé.

 

Dim linetypeName As String

linetypeName = "CACHE2"

 

' Load "CACHE2" line type from AutoCAD.lin file

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

 

newlayer1.linetype = "HIDDEN"

 

Merci encoure pour les codes.

Si tu sais comment avec VBA, je peus inserer un bloc qui contiends des attributs, je suis tout a toi.

[sechanbask]

Bon je pense que j'ai assez détaillé alors :

 

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

   Dim linetypeName As String
   linetypeName = "ZIGZAG"

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
   fichier1 = "acad.lin"
   MsgBox linetypeName & " n'a pas été trouvé dans dessin actif. Nous allons donc le chercher dans le fichier " & fichier1
   
   ThisDrawing.Linetypes.Load linetypeName, "acad.lin"
   MsgBox "trouvé dans fichier..."
   Else
   
   
   
   End If

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

 

S'il y a une chose que tu ne comprends pas n'hésite pas à me demander car les réponses que je te fournirais pourront d'aider à appréhender le code et repousser tes ambitions... enfin je pense... sinon à quoi ce forum servirait-il?

[winfield]

Salut,

Avant d'utiliser un type de ligne, il faut charger le fichier de définition des types de lignes.

Dim StrTypeLigne As String
Dim ObjCalque As AcadLayer
Dim StrCalque As String
Dim ObjLine as AcadLine
.........................................
StrTypeLigne = "ZIGZAG"
StrCalque="MonCalque"
.........................................
ThisDrawing.Linetypes.Load StrTypeLigne, "ACAD.LIN"
......................................
Set ObjCalque = ThisDrawing.Layers.Add(StrCalque)
......................................
ObjLine.Linetype = StrTypeLigne
......................................

[surligneur] car là j'ai très fin... [/surligneur]

keceke ce serait si t'av lé cros, avec les SMS, il n'y a pas de FOTES...koike....y'a un dico :(

;)

..

Bon WE à tous

 

Dsl d'être arrivé après la bataille (snif)

 

[Edité le 29/6/2007 par winfield]

[sechanbask]

>winfield c'est malin... tu viens tellement souvent ici que je te pardonne ta remarque désobligeante. Ose me dire que je fait du sms et plein de fautes...

 

Comme dirait mon estomac quand il a faim : "quand je manque de sucre et que les sucs gastriques me rongent je fais n'importe quoi."

 

Alors je mets cette faute sur le compte de faim. Tant pis pour elle...

 

 

P.S. Je suis bêtement attaché à l'orthographe alors je rectifie cette faute sans plus attendre.

[winfield]

P.S. Je suis bêtement attaché à l'orthographe alors je rectifie cette faute sans plus attendre.

Pourkoi ?

c'était assez fin...........pour garder la ligne :D

[sechanbask]

>winfield : pourquoi tu ne relève pas les fautes de formula1 ?

 

>formula1 : je te conseille mon code car si tu utilise le tien (ou celui de winfield, et toc) à maintes reprises, tu auras une erreur de chargement (autocad va tenter de charger, en vain, plusieurs fois la même ligne). Et le mien est mieux que le votre d'abord !! Na!!

[formula1]

C'est bizarre, la meme macro ne fonctionne pas dans la version anglaise de autocad.

Il me dit qu'il y a une erreur au niveau de cette ligne :

ThisDrawing.Linetypes.Load "StrTypeLigne", "ACAD.LIN"

[formula1]

OK, rectifier et effectivement ton code marche mieuxque celui de winfield

[sechanbask]

(Tu parlais de la macro de qui?)

si c'est de la mienne :

ThisDrawing.Linetypes.Load "StrTypeLigne", "ACAD.LIN"...

 

La methode me paraît bonne (sauf erreur de ma part). Alors je pense que le fichier "ACAD.LIN" n'est pas chargé (il n'est peut-être pas dans un dossier où autocad fouille). Pour l'instant, je ne vois que cette erreur de possible.

 

Essaie de voir si avec le fichier ACADISO.LIN ça fonctionne...

 

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

[winfield]

>winfield : pourquoi tu ne relève pas les fautes de formula1 ?

Parce qu'il "n'est encore que ceinture jaune", donc il est normal qu'il commette des errorzes....môa, c'est fichu, on peut plus rien...on ne fait pas avancer un âne qui ne veut pas avancer ;)

 

 

[formula1]

Non, non, tous vas bien je métais tromper.

La macro marche a merveille.

[sechanbask]

Ta macro va te servir à quoi au juste? Tu travailles dans quel domaine?

[formula1]

je travail dans la stabilité (c'est a dire que je fais des plansde béton armé).

Peus-tu vérifier ma macro car il m'indique une erreur a la derniere ligne?

 

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

 

 

End Sub