TheSwamp
Code Red => VB(A) => Topic started by: David Hall on November 02, 2005, 01:34:21 PM
-
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
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
-
Don't have time to make it pretty right now, maybe at lunch but what about this
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 Sub
I would also filter the selection set so only text is selectable, then you could get rid of the "if typeof" test
-
that works well. Thanks. I couldn't get my head wrapped aroung the nested ifs today
-
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
-
Still not very secksie but
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
-
that works well. Thanks. I couldn't get my head wrapped aroung the nested ifs today
Not a problem.