AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

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.

Change Text

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
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website