This is a bit cleaner.
[code]
Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function
Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function
Public Function AddSS _
(Optional ssName As String = "goo") As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(ssName).Delete
Set AddSS = ThisDrawing.SelectionSets.Add(ssName)
On Error GoTo 0
End Function
Public Function DeleteSS _
(ssName As String) As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(ssName).Delete
On Error GoTo 0
End Function
Sub main()
Dim fType(1) As Integer
Dim fData(1) As Variant
fType(0) = 0
fData(0) = "TEXT"
fType(1) = 8
fData(1) = "0"
Dim ssText As AcadSelectionSet
Set ssText = AddSS("TEXT")
ssText.Select acSelectionSetAll, , , fType, fData
Dim rad As Double
rad = 150
Dim i As Integer
Dim txt As AcadText
For i = 0 To ssText.Count - 1
Set txt = ssText(i)
Dim ssLines As AcadSelectionSet
Dim fType1(0) As Integer
Dim fData1(0) As Variant
fType1(0) = 0
fData1(0) = "LINE"
Set ssLines = AddSS("LINES")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, _
(CircularPlinePoints(txt.InsertionPoint, rad)), fType1, fData1
Select Case ssLines.Count
Case 1
txt.Rotate txt.InsertionPoint, ssLines(0).Angle
Case Else
'iterate ssLines and find closed line by
'checking end points.
End Select
DeleteSS ("LINES")
Next i
DeleteSS ("TEXT")
End Sub
[/code]
wrote in message news:5404524@discussion.autodesk.com...
This if this helps...
[code]
Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function
Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function
Sub stub()
Dim fType(1) As Integer
Dim fData(1) As Variant
'filter for text on "yourLayer"
fType(0) = 0
fData(0) = "TEXT"
fType(1) = 8
fData(1) = "yourLayer"
Dim ssText As AcadSelectionSet
Set ssText = ThisDrawing.SelectionSets.Add("TEXT")
ssText.Select acSelectionSetAll, , , fType, fData
Dim rad As Double
rad = ThisDrawing.Utility.GetReal("Enter search radius: ")
Dim i As Integer
Dim txt As AcadText
For i = 0 To ssText.Count - 1
Set txt = ssText(i)
Dim ssLines As AcadSelectionSet
Dim fType1(0) As Integer
Dim fData1(0) As Variant
fType1(0) = 0
fData1(0) = "LINE"
Set ssLines = ThisDrawing.SelectionSets.Add("LINES")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, _
(CircularPlinePoints(txt.InsertionPoint, rad)), fType1, fData1
Select Case ssLines.Count
Case 0
MsgBox "Increase radius and try again: "
Case 1
txt.Rotate txt.InsertionPoint, ssLines(0).Angle
Case Else
'iterate ssLines and find closed line by
'checking end points.
End Select
ThisDrawing.SelectionSets("LINES").Delete
Next i
ThisDrawing.SelectionSets("TEXT").Delete
End Sub
[/code]