Aller au contenu

Tampon identité


phil_vsd

Messages recommandés

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

 

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Lien vers le commentaire
Partager sur d’autres sites

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.

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Lien vers le commentaire
Partager sur d’autres sites

  • 1 mois après...

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]

Nous n’ héritons pas de la terre de nos ancêtres.Nous l’empruntons à nos enfants.

Lien vers le commentaire
Partager sur d’autres sites

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 compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité