Topic: rotation of text

[David Hall]

I cant get this to work.  What im trying to do is fix a drawing a consultant sent me.  his text is not all at 0 or 90 degrees.  I want to check each piece of dtext and mtext for rotation, and fix the non-standard ones.  here is my code

Code: [Select]

Option Explicit

Public Sub FIX_ROTATION()
    Dim objSelected As Object
    Dim objTxt As AcadText
    Dim objMTxt As AcadMText
    Dim objSelSet As AcadSelectionSet
    On Error GoTo ErrControl
    Dim N As Integer
    Dim pi
   
    pi = 4 * Atn(1)

    If ThisDrawing.SelectionSets.Count > 0 Then
        For N = 0 To ThisDrawing.SelectionSets.Count - 1
            If ThisDrawing.SelectionSets.Item(N).Name = "FIXTEXT" Then
                ThisDrawing.SelectionSets("FIXTEXT").Delete
            End If
        Next N
    End If

    Set objSelSet = ThisDrawing.SelectionSets.Add("FIXTEXT")
    objSelSet.SelectOnScreen
    'objSelSet.Select acSelectionSetAll
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
            Set objTxt = objSelected
            Select Case objTxt.Rotation
                Case 0:
                    objTxt.Rotation = 0
                Case 90:
                    objTxt.Rotation = (pi / 2)
                Case objTxt.Rotation < (pi / 2)         <---- here is the problem.  Im trying to find text w/ > 0 but < 75 degrees
                    objTxt.Rotation = 0
                Case Else
                    objTxt.Rotation = (pi / 2)
            End Select

        End If
    Next


    '        For Each objSelected In objSelSet
    '        If TypeOf objSelected Is AcadText Then
    '            Set objTxt = objSelected
    '            If objTxt.Rotation > 0 And objTxt.Rotation < 75 Then
    '                objTxt.Rotation = 0
    '            Else: objTxt.Rotation = (pi / 2)
    '            End If
    '
    '        End If
    '    Next

    '    For Each objSelected In objSelSet
    '        If TypeOf objSelected Is AcadMText Then
    '            Set objMTxt = objSelected
    '            If objMTxt.Rotation > 0 And objMTxt.Rotation < 75 Then
    '                objMTxt.Rotation = 0
    '            Else: objMTxt.Rotation = 90
    '            End If
    '
    '        End If
    '    Next
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete
    ThisDrawing.Application.Update
Exit_Here:
    Exit Sub
ErrControl:
    MsgBox Err.Description
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete


End Sub
I started using IF statements, but didn't want to nest 4 levels deep

[Bob Wahr]

Don't have time to make it pretty right now, maybe at lunch but what about this

Code: [Select]

Option Explicit

Public Sub FIX_ROTATION()
    Dim objSelected As Object
    Dim objTxt As AcadText
    Dim objMTxt As AcadMText
    Dim objSelSet As AcadSelectionSet
    Dim dblRotDec As Double
    Dim dblRotRad As Double
    On Error GoTo ErrControl
    Dim N As Integer
    Dim pi
   
    pi = 4 * Atn(1)

    If ThisDrawing.SelectionSets.Count > 0 Then
        For N = 0 To ThisDrawing.SelectionSets.Count - 1
            If ThisDrawing.SelectionSets.Item(N).Name = "FIXTEXT" Then
                ThisDrawing.SelectionSets("FIXTEXT").Delete
            End If
        Next N
    End If

    Set objSelSet = ThisDrawing.SelectionSets.Add("FIXTEXT")
    objSelSet.SelectOnScreen
    'objSelSet.Select acSelectionSetAll
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
            Set objTxt = objSelected
            dblRotRad = objTxt.Rotation
            dblRotDec = (dblRotRad * 180) / pi
            If dblRotDec > 180 Then
              dblRotDec = dblRotDec - 180
            End If
            If dblRotDec > 45 And dblRotDec < 135 Then
              dblRotRad = (90 * pi) / 180
            Else
              dblRotRad = 0
            End If
            objTxt.Rotation = dblRotRad
        End If
    Next
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete
    ThisDrawing.Application.Update
Exit_Here:
    Exit Sub
ErrControl:
    MsgBox Err.Description
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete


End SubI would also filter the selection set so only text is selectable, then you could get rid of the "if typeof" test

[David Hall]

that works well.  Thanks.  I couldn't get my head wrapped aroung the nested ifs today

[David Hall]

I would also filter the selection set so only text is selectable, then you could get rid of the "if typeof" test

that was next on the list.  thanks

[Bob Wahr]

Still not very secksie but

Code: [Select]

Option Explicit

Public Sub FIX_ROTATION()
    Dim objSelected As Object
    Dim objTxt As AcadText
    Dim objMTxt As AcadMText
    Dim objSelSet As AcadSelectionSet
    Dim dblRot As Double
    Dim intGrp(0 To 3) As Integer
    Dim varDat(0 To 3) As Variant
    
    On Error GoTo ErrControl

    If ThisDrawing.SelectionSets.Count > 0 Then
        For Each objSelSet In ThisDrawing.SelectionSets
            If objSelSet.Name = "FIXTEXT" Then
                objSelSet.Delete
                Exit For
            End If
        Next objSelSet
    End If
    intGrp(0) = -4: intGrp(1) = 0: intGrp(2) = 0: intGrp(3) = -4
    varDat(0) = "<or": varDat(1) = "TEXT": varDat(2) = "MTEXT": varDat(3) = "or>"
    Set objSelSet = ThisDrawing.SelectionSets.Add("FIXTEXT")
    objSelSet.SelectOnScreen intGrp, varDat
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
            Set objTxt = objSelected
            dblRot = objTxt.Rotation
            objTxt.Rotation = Angulator(dblRot)
        Else
            Set objMTxt = objSelected
            dblRot = objMTxt.Rotation
            objMTxt.Rotation = Angulator(dblRot)
        End If
    Next
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete
    ThisDrawing.Application.Update
Exit_Here:
    Exit Sub
ErrControl:
    MsgBox Err.Description
    ThisDrawing.SelectionSets.Item("FIXTEXT").Delete
End Sub

Function Angulator(dblRotRad As Double) As Double
    Dim dblRotDec As Double
    Dim PI As Double
    PI = 4 * Atn(1)
    dblRotDec = (dblRotRad * 180) / PI
    If dblRotDec > 180 Then
      dblRotDec = dblRotDec - 180
    End If
    If dblRotDec > 45 And dblRotDec < 135 Then
      Angulator = (90 * PI) / 180
    Else
      Angulator = 0
    End If
End Function

[Bob Wahr]

that works well. Thanks. I couldn't get my head wrapped aroung the nested ifs today

Not a problem.