Modif TexteStyle

[phil_vsd]

Bonsoir tous,

 

Voici deux routines, l'une pour remplacer un Textestyle par un autre. L'autre pour modifier la hauteur des tous les Mtextes ayant les même textstyle.

 

J'ai quelques problèmes avec les effets Gras et Italiques, ils ne suivent pas le move !

 

J'attend vos critiques ! Merci !

 

 
Sub Select_style_texte2()


Dim SST As AcadSelectionSet

On Error GoTo SORTIE

Set SST = ThisDrawing.SelectionSets.Add("NewSelect1")
SST.Clear


Dim TXS As String
Dim OB1 As AcadMText
Dim TX2 As String
Dim OB2 As AcadMText




' Pour piquer l'objet

ThisDrawing.Utility.GetEntity OB1, basePnt, "Sélectionnez un style de texte à modifier"

TXS = OB1.StyleName 'La variable est renseignée par le style de texte pointé


MsgBox "Vous allez modifier le style de texte : " & TXS, vbInformation, "ATTENTION"

'Sélection de la cible

ThisDrawing.Utility.GetEntity OB2, basePnt, "Sélectionnez un style de texte cible. "

TX2 = OB2.StyleName 'La variable est renseignée par le style de texte pointé
Taille1 = OB2.height
Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant

Filtertype(0) = 7 'DXF des style de texte
Filterdata(0) = TXS

'Selection à l'écran des objets
SST.Select acSelectionSetAll, , , Filtertype, Filterdata 'Sélectionne tout à l'écran

SST.Highlight True 'allume la sélection


Dim TEXTSELECTED As AcadMText
For Each TEXTSELECTED In SST
TEXTSELECTED.StyleName = TX2
TEXTSELECTED.height = Taille1

Next

SST.Highlight False 'Eteind la sélection




MsgBox "Tous les Mtext ayant le style de texte : " & TXS & " ont maintenant le style : " & TX2, vbInformation, "INFO"
   
SORTIE:
SST.Delete 'Vide la sélection
   
End Sub

 

 

et la deuxième :

 

 

Sub Select_hauteur_texte()


Dim SST As AcadSelectionSet

On Error GoTo SORTIE

Set SST = ThisDrawing.SelectionSets.Add("NewSelect1")
SST.Clear


Dim TXS As String
Dim OB1 As AcadMText



' Pour piquer l'objet

ThisDrawing.Utility.GetEntity OB1, basePnt, "Sélectionnez un style de texte à modifier"

TXS = OB1.StyleName 'La variable est renseignée par le style de texte pointé

MsgBox "Vous allez modifier le style de texte : " & TXS, vbInformation, "ATTENTION"


Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant

Filtertype(0) = 7 'DXF des style de texte
Filterdata(0) = TXS

'Selection tout à l'écran des objets
SST.Select acSelectionSetAll, , , Filtertype, Filterdata 'Sélectionne tout à l'écran

SST.Highlight True 'allume la sélection


Dim Hauteur As Double
Hauteur = ThisDrawing.Utility.GetReal("Entrez la hauteur : ")


Dim TEXTSELECTED As AcadMText
For Each TEXTSELECTED In SST
TEXTSELECTED.color = acRed
TEXTSELECTED.height = Hauteur
TEXTSELECTED.color = acByLayer

Next

SST.Highlight False 'Eteind la sélection




MsgBox "Tous les Mtext ayant le style de texte : " & TXS & " a maintenant une hauteur de : " & Hauteur, vbInformation, "INFO"
   
SORTIE:
SST.Delete 'Vide la sélection
   
End Sub

 

 

A suivre...