Tampon identité

[phil_vsd]

Bonjour,

 

J'ai récupéré une petite routine qui peut être utile à plusieurs d'entres nous. D'un clik cela insère le chemin, le nom, le dessinateur et la date sous forme de texte. Pratique pour retrouver l'origine d'un plan papier. J'ai trouvé des fragments de codes sous les sites autocad les plus connus et je me suis fait la main dessus pour apprendre le VBA.

 

Je n'ai plus les adresses sous la main mais ces fragments se trouvent chez Maxence Dellanoy, Lourdelle, etc...

 

Comme d'habitude, vous suggestions m'intéressent.

 

 

 

Public Sub Tampon()

' Déclaration des variables

Dim Pt1 As Variant

Dim txtTout As String

Dim txtTexte1 As String

Dim txtTexte2 As String

Dim txtTexte3 As String

Dim currLayer As AcadLayer

Dim newLayer As AcadLayer

 

 

 

' Demande du point d'insertion du texte

Pt1 = ThisDrawing.Utility.GetPoint(, "Sélection d'un point SVP")

 

 

 

' Définition du texte à insérer dans le dessin

txtTexte1 = " " & ThisDrawing.FullName

txtTexte2 = " Par VOTRE NOM le : "

txtTexte3 = Now

 

 

txtTout = txtTexte1 & txtTexte2 & txtTexte3

 

 

' Mémorise le calque courant, l'"active layer"

Set currLayer = ThisDrawing.ActiveLayer

 

' Créé le layer Path finder VBA pour y insérer le texte du chemin

Set newLayer = ThisDrawing.Layers.Add("Path finder VBA")

ThisDrawing.ActiveLayer = newLayer

 

 

' Ajout du texte

ThisDrawing.PaperSpace.AddText txtTout, Pt1, 2

 

' Retourne sur le calque d'avant l'insertion

ThisDrawing.ActiveLayer = currLayer

 

 

End Sub

 

[Invité Patrick]

Oui, les infos insérées sont statiques, on peut aussi utiliser des champs dynamiques, dans ce cas les infos seront dynamiques.

[phil_vsd]

Bonjour,

 

En effet les champs dynammiques sont une mines d'or ! Merci mille fois !

[lecrabe]

 

Bonjour

 

Oui mais les champs dynamiques n'existent que depuis la version 2005 ! :exclam:

 

Donc un petit programme VBA est le bienvenu pour les versions précédentes ... :)

 

Le Decapode

 

[phil_vsd]

Salut tous,

 

Attention Le Decapode, la petite routine postée n'est pas dynamique, cela implique que le dessinateur doit lui-même lors de chaque mise à jour effacer l'ancien texte inséré et relancer la routine afin d'en insérer un à jour. Cela peut être un peu dangereux si l'on oubli de le faire on se retrouve avec deux plans différents dans le temps ayant un tampon équivalent. Après on joue au jeu des erreurs... Mais bon, c'est mieux que rien.

[winfield]

Bonsoir,

je te propose une variante, car tu oublies ou tu n'a pas encore été en contact avec les irréductibles qui ne bosse qu'en espace objet.

 

Je me suis inspiré de ton code.

 

Public Sub Tampon2()
   ' Déclaration des variables
   Dim Pt1 As Variant
   Dim Txt1 As String
   Dim NewLayer As AcadLayer
   Dim StrNomLayer As String
   Dim NomMode as String

   StrNomLayer = "Path finder VBA"
   NomModel = ThisDrawing.ActiveLayout.Name
   ' Demande du point d'insertion du texte
   Pt1 = ThisDrawing.Utility.GetPoint(, "Sélection d'un point SVP")
   
   ' Définition du texte à insérer dans le dessin
   Txt1 = ThisDrawing.FullName & " Par VOTRE NOM le : " & Now
   
   ' Créé le layer Path finder VBA pour y insérer le texte du chemin
   Set NewLayer = ThisDrawing.Layers.Add(StrNomLayer)
   
   ' Ajout du texte
   If NomModel = "Model" Then
       ThisDrawing.ModelSpace.AddText Txt1, Pt1, 2
   Else
       ThisDrawing.PaperSpace.AddText Txt1, Pt1, 2
   End If
  Txt1.layer=StrNomLayer
End Sub

 

[Edité le 1/10/2006 par winfield]

[phil_vsd]

That's right man ! Salut à eux ! hé hé !