Align Text With UCS - Code

I'm sure others can improve upon this...
It will align the text with the current UCS. I typically use this with UCS View.


Option Explicit

'04/04
'Align text rotation with the UCS (typically view)

Public Sub Align_Text_With_UCS()

Dim retAngle As Double
Dim oEnt As AcadEntity
Dim oSS As AcadSelectionSet

Dim Pt1 As Variant
Dim Pt2 As Variant

Dim grpCode(0 To 3) As Integer
Dim dataVal(0 To 3) As Variant

' Build a selection set of group codes and values to filter for: Text or Mtext.
grpCode(0) = -4
dataVal(0) = "<OR"
grpCode(1) = 0
dataVal(1) = "TEXT"
grpCode(2) = 0
dataVal(2) = "MTEXT"
grpCode(3) = -4
dataVal(3) = "OR>"

' get the UCS origin
Pt1 = ThisDrawing.GetVariable("ucsorg")
' get the X direction vector
Pt2 = ThisDrawing.GetVariable("UCSXDIR")
' get the angle in radians
retAngle = ThisDrawing.Utility.AngleFromXAxis(Pt1, Pt2)
'get (m)text entities to modify
Set oSS = BuildSelectionSet("Select Text:", grpCode, dataVal)
' set rotation angle for each entity
For Each oEnt In oSS
If TypeOf oEnt Is AcadText Then
oEnt.Rotation = retAngle
ElseIf TypeOf oEnt Is AcadMText Then
oEnt.Rotation = 0
End If
Next oEnt

' release memory (yeah right)
Set oEnt = Nothing
Set oSS = Nothing
End Sub

 

Sorry for the double post. i've included all the code in this post, along with a few revisions. (the first code wouldn't work if the UCS origin wasn't 0,0)


Public Sub Align_Text_With_UCS()

Dim retAngle As Double
Dim oEnt As AcadEntity
Dim oSS As AcadSelectionSet

Dim Pt1(0 To 2) As Double
Dim Pt2 As Variant

Dim grpCode(0 To 3) As Integer
Dim dataVal(0 To 3) As Variant

' Build a selection set of group codes and values to filter for: Text or Mtext.
grpCode(0) = -4: dataVal(0) = "<OR"
grpCode(1) = 0: dataVal(1) = "TEXT"
grpCode(2) = 0: dataVal(2) = "MTEXT"
grpCode(3) = -4: dataVal(3) = "OR>"

Pt1(0) = 0
Pt1(1) = 0
Pt1(2) = 0

' get the X direction vector
Pt2 = ThisDrawing.GetVariable("UCSXDIR")
' get the angle in radians
retAngle = ThisDrawing.Utility.AngleFromXAxis(Pt1, Pt2)
'get (m)text entities to modify
Set oSS = BuildSelectionSet("Select Text:", grpCode, dataVal)

' set rotation angle for each entity
For Each oEnt In oSS
If TypeOf oEnt Is AcadText Then
oEnt.Rotation = retAngle
ElseIf TypeOf oEnt Is AcadMText Then
oEnt.Rotation = 0
End If
Next oEnt

' release memory (yeah right)
Set oEnt = Nothing
Set oSS = Nothing
End Sub






'return a selection set
Public Function BuildSelectionSet(strPrompt As String, vGroupCode As Variant, vDataValues As Variant) As AcadSelectionSet
Dim ssetObj As AcadSelectionSet

'create a new selection set object
Set ssetObj = vbdPowerSet("SS01")

If strPrompt <> vbNullString Then
ThisDrawing.Utility.Prompt strPrompt
End If

If Not IsEmpty(vGroupCode) Then
ssetObj.SelectOnScreen vGroupCode, vDataValues
Else
ssetObj.SelectOnScreen
End If

Set BuildSelectionSet = ssetObj

End Function



'Simple sel set object creation function.
'vba will return an error if the sel set object already exists
'in the SSETS collection
Public Function vbdPowerSet(strName As String) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = strName Then
objSelCol.Item(strName).Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add(strName)
Set vbdPowerSet = objSelSet
End Function

 

Hi Dave - what's the problem with rotating an MText object in the
Align_Text_With_UCS() sub below?

Just curious,
Perion

with a few revisions. (the first code wouldn't work if the UCS origin wasn't
0,0)

vDataValues As Variant) As AcadSelectionSet