PDA

View Full Version : Help with Text / TextStyle change routine



newfoundfreedom
2007-05-10, 03:15 PM
I need help with my first VBA routine. What I am trying to accomplish is as follows:

1. Change the "Standard" TextStyle to have Height = 250, Width = 0.8, & Font = romans.shx
2. Set "Standard" TextStyle as Current
3. Change all existing Text and MText entities to the "Standard" Text Style

Looking at some of the other code examples on this forum - I have been able to complete steps one and two - but I don't know how to accomplish the third. My coding knowledge is fledgling at best - but I imagine that I have to create a dynamic array and then put all the existing Text and MText objects into that array - then cycle through each of them setting their text style to "Standard". Could someone please post a code example. Thanks you.

This is what I currently have.


Sub ChangeTextStyle()

Dim objTextStyle As AcadTextStyle
Set objTextStyle = ThisDrawing.TextStyles("Standard")
objTextStyle.fontFile = "romans.shx"
objTextStyle.Height = 250
objTextStyle.Width = 0.8

ThisDrawing.ActiveTextStyle = objTextStyle

End Sub

Ed Jobe
2007-05-10, 04:25 PM
Rather than an array, use a selectionset. An AcadSelectionset is derived from a collection, which has methods to iterate through the objects it contains. You can use the filtering abilities of the ss to obtain just text objexts. Then its just a matter of stepping through the collection and changing the props of each object. I would also recommend creating a new style that is your standard and using that instead of "Standard". Call it "Romans250" for example, if you intend to fix the height.

saustin
2007-05-10, 04:56 PM
Try this:


Option Explicit

Sub ChangeTextStyle()

Dim objTextStyle As AcadTextStyle
Dim oPaper As AcadPaperSpace
Dim entObj As AcadEntity
Dim dtxtObj As AcadText
Dim mtxtObj As AcadMText

Set objTextStyle = ThisDrawing.TextStyles.Add("NewStyle")
objTextStyle.fontFile = "romans.shx"
objTextStyle.Height = 250
objTextStyle.Width = 0.8

ThisDrawing.ActiveTextStyle = objTextStyle

For Each entObj In ThisDrawing.ModelSpace
If entObj.ObjectName = "AcDbText" Then
Set dtxtObj = entObj
With dtxtObj
.StyleName = "NewStyle"
.Height = 250
.ScaleFactor = 0.8
End With
ElseIf entObj.ObjectName = "AcDbMText" Then
Set mtxtObj = entObj
With mtxtObj
.StyleName = "NewStyle"
.Height = 250
.Width = 0.8
End With
End If
Next entObj

End Sub

ska