Création de calques en VBA (sous 2005)

[DenisHen]

Bonjour à tous (ou bonsoir)

Je cherche à créer des calques en VBA, j'y ai réussi en une vingtaine de secondes.... Mais pour changer de couleur.....Alors là.... Je rame ! ! Quand au type de ligne dudit calque, je n'ose en parler ! ! ! 😞

Si une bonne âme tombe sur ces quelques lignes.... Bref, merci d'avance...

Denis...

P.S.: Bonnes fêtes de fin d'année à toutes les Cadxpiennes et tous les Cadxpiens... Et longue vie au site... 😄

[DenisHen]

C'est re-moi... :D

Bon, pour les calques, c'est bon.... Mais il faut que je me penche sur la vérification de l'existance d'un calque avant de le créer....A mon avis, ça devrait faire un truc comme-çà :

 

Do " tant que n calque " <= " nombre calque "

if calque n trouvé then exit loop else n=n+1

loop

if n calque = calque à créer then calque existe déjà else création du calque

 

Si quelqu'un comprend ! ! Chapeau bas ! ! :o

 

Bon, vu l'heure, je regarde LES NULS coffret 2 DVD3 et je me couche...

 

Bonne nuit les petits... ;)

 

Denis...

[winfield]

Bonjour,

En espèrant que ça puisse t'aider :

 Sub CalqueEtText()
   Dim ObjCalque As AcadLayer
   Dim StrNomCalque As String
   StrNomCalque = "MonCalque"
   Dim ObjStyleText As AcadTextStyle
   Dim StrStyleText As String
   Dim Pt(0 To 2) As Double
   Dim ObjText As AcadText

   Pt(0) = 50: Pt(1) = 50: Pt(2) = 0
   StrStyleText = "MonStyleTxt"    
   
   On Error Resume Next
   Set ObjCalque = ThisDrawing.Layers(StrNomCalque)
   If Err <> 0 Then
       Err.Clear
       Set ObjCalque = ThisDrawing.Layers.Add(StrNomCalque)
       ObjCalque.Color = acCyan
   End If
   ThisDrawing.ActiveLayer = ObjCalque
   Set ObjStyleText = ThisDrawing.TextStyles(StrStyleText)
   If Err <> 0 Then
   Err.Clear
   Set ObjStyleText = ThisDrawing.TextStyles.Add(StrStyleText)
   ObjStyleText.fontFile = "Romand.shx"
   End If
   
   Set ObjText = ThisDrawing.ModelSpace.AddText("Bonnes fêtes !", Pt, 5)
   ObjText.StyleName = StrStyleText

End Sub

Bonne continuation