Change Text.
This application will change the Height, Layer, Style or Colour of
selected text within a drawing. You can use the 'Select Objects' button to
select any objects on screen by using any of the standard AutoCAD
selection methods, or you can choose 'Select All' to select all text
entities. The application will automatically filter out all non-text
entities.
Create a form with controls as above and add this coding :
Option Explicit
Private Sub CheckBox1_Click()
If TextBox1.Enabled = False Then
TextBox1.Enabled = True
UserForm1.TextBox1.SetFocus
'set focus to the textbox
UserForm1.TextBox1.SelStart = 0
'start at the first character
UserForm1.TextBox1.SelLength = Len(UserForm1.TextBox1.Text)
Else
TextBox1.Enabled = False
End If
End Sub
Private Sub CheckBox2_Click()
If ComboBox1.Enabled = False Then
ComboBox1.Enabled = True
Else
ComboBox1.Enabled = False
End If
End Sub
Private Sub CheckBox3_Click()
If ComboBox2.Enabled = False Then
ComboBox2.Enabled = True
Else
ComboBox2.Enabled = False
End If
End Sub
Private Sub CheckBox4_Click()
If ComboBox3.Enabled = False Then
ComboBox3.Enabled = True
Else
ComboBox3.Enabled = False
End If
End Sub
Private Sub CommandButton1_Click()
Dim pt1(0) As Double
Dim pt2(0) As Double
Dim FilterSet As Object
Dim gpCode(0) As Integer
Dim gpValue(0) As Variant
'declare variables
UserForm1.Hide
'hide the dialogue
Set FilterSet = ThisDrawing.SelectionSets.Add("TEMP")
'create a selection set
gpCode(0) = 0
'set the filter DXF code
gpValue(0) = "TEXT"
'set the filter DXF value
FilterSet.Select acSelectionSetAll, pt1, pt2, gpCode, gpValue
'select all text in the drawing
Dim FilterEnt As Object
For Each FilterEnt In FilterSet
'start the loop
If CheckBox1.Value = True Then
FilterEnt.Height = TextBox1.Text
End If
'retrieve the height
If CheckBox2.Value = True Then
FilterEnt.Layer = ComboBox1.Text
FilterEnt.Color = acByLayer
End If
'retrieve the layer
If CheckBox3.Value = True Then
FilterEnt.StyleName = ComboBox2.Text
End If
'retrieve the style
If CheckBox4.Value = True Then
FilterEnt.Color = ComboBox3.Text
End If
'retrieve the color
FilterEnt.Update
'update the entity
Next FilterEnt
ThisDrawing.SelectionSets("TEMP").Delete
'delete the selection set
End
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub CommandButton3_Click()
Dim pt1 As Variant
Dim pt2 As Variant
Dim FilterSet As Object
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
'declare variables
Set FilterSet = ThisDrawing.SelectionSets.Add("TEMP")
'create a selection set
FilterType(0) = 0
'set the filter DXF code
FilterData(0) = "TEXT"
'set the filter DXF type
UserForm1.Hide
'hide the dialogue
FilterSet.SelectOnScreen FilterType, FilterData
'select text on screen
Dim FilterEnt As Object
For Each FilterEnt In FilterSet
'start the loop
If CheckBox1.Value = True Then
FilterEnt.Height = TextBox1.Text
End If
'retrieve the height
If CheckBox2.Value = True Then
FilterEnt.Layer = ComboBox1.Text
FilterEnt.Color = acByLayer
End If
'retrieve the layer
If CheckBox3.Value = True Then
FilterEnt.StyleName = ComboBox2.Text
End If
'retrieve the style
If CheckBox4.Value = True Then
FilterEnt.Color = ComboBox3.Text
End If
'retrieve the colour
FilterEnt.Update
'update the entity
Next FilterEnt
ThisDrawing.SelectionSets("TEMP").Delete
'delete the selection set
End
End Sub
Private Sub UserForm_Initialize()
Dim objLayer As AcadLayer
Dim i As Integer
'declare variables
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
CheckBox4.Value = False
'switch off all checkboxes
TextBox1.Text = ThisDrawing.GetVariable("TextSize")
'retrieve the current text height
ComboBox1.Text = ThisDrawing.GetVariable("CLayer")
'retrieve the current text style
ComboBox2.Text = ThisDrawing.GetVariable("TextStyle")
'retrieve the current text style
For Each objLayer In ThisDrawing.Layers
'get the layer names and loop thru' them
ComboBox1.AddItem objLayer.Name
'add them to the list box
Next
Dim objStyle As AcadTextStyle
'declare variables
For Each objStyle In ThisDrawing.TextStyles
'get the layer names and loop thru' them
ComboBox2.AddItem objStyle.Name
'add them to the list box
Next
For i = 1 To 255
'start the loop
ComboBox3.AddItem i
'add colour number to combo box
Next i
End Sub
Now open a new module and add this coding :
Sub Chtext1()
UserForm1.Show
End Sub
To run this application run the macro "Chtext1".
There is one thing wrong with this application. The list of Layers and
Styles are not sorted. I didn't include the coding for this as it would
have complicated the issue. Therefore, I have included another version of
this application within the zip file that includes the sort coding. (Many
thanks to Randall Raath.)
If you would like to download the source code for this Application/s, then
click Here |