Thread: Some new questions View Single Post
#6
29-12-2005, 22:33
 Alex Administrator Join Date: Nov 2002 Posts: 1,940 Blog Entries: 4

Zizy,

About finding the angle, it is not a trivial thing to do. The problem is that there is no easy way of determining the coordinates of a particular letter, so you can't get the point of the end of a text object.

However I came up with the workaround: I duplicate the original object, add a "." to the end, convert the text to curves and since my dot will be the last character of the text, it will be the last subpath of the resulting curve, so I just get the coordinates of the first node of that subpath and it will be a reasonable estimate of the end of the original text object.

Then it is just a pure math of finding angle between two vectors.

Here is a working example - select two text objects fitted to a path and run the following macro:

Code:
```Sub FindAngle()
Dim x1 As Double, y1 As Double
Dim x2 As Double, y2 As Double
Dim x0 As Double, y0 As Double
Dim dLen As Double, dDot As Double
Dim dAngle As Double
Dim sr As ShapeRange
Dim sPath As Shape
Dim strText As String

Set sr = ActiveSelection.Shapes.FindShapes(Type:=cdrTextShape)
If sr.Count <> 2 Then
MsgBox "The selection must contain two text objects fitted to path", vbCritical
Exit Sub
End If

' Find the end of the first text object
GetEndOfText sr(1), x1, y1
' Find the end of the second text object
GetEndOfText sr(2), x2, y2

' Find the center of the path.
' Assume that both text objects are fitted to
' either the same path or paths with the same center

If sr(1).Effects.TextOnPathEffect Is Nothing Then
MsgBox "Text objects must be fitted to path", vbCritical
Exit Sub
End If

Set sPath = sr(1).Effects.TextOnPathEffect.TextOnPath.Path
ActiveDocument.ReferencePoint = cdrCenter
sPath.GetPosition x0, y0

' Draw the leader lines to indicate the angle we found
ActiveLayer.CreateLineSegment x0, y0, x1, y1
ActiveLayer.CreateLineSegment x0, y0, x2, y2

' Find the angle between the end points of the text objects and the center of the path
x1 = x1 - x0
y1 = y1 - y0
x2 = x2 - x0
y2 = y2 - y0

dDot = x1 * x2 + y1 * y2 ' Dot product of the vectors
dLen = Sqr((x1 * x1 + y1 * y1) * (x2 * x2 + y2 * y2))
dAngle = arccos(dDot / dLen)

strText = "Angle = " & Format(dAngle, "0.00") & " degrees"
ActiveLayer.CreateArtisticText x0 + (x1 + x2) / 2, y0 + (y1 + y2) / 2, strText
End Sub

Private Sub GetEndOfText(ByVal sText As Shape, ByRef x As Double, y As Double)
Dim sDup As Shape
' Make a temporary duplicate of the text
Set sDup = sText.Duplicate
' Add a DOT at the end of the text
sDup.Text.Story.InsertAfter "."
' Convert the text to curves
sDup.ConvertToCurves
' Get the position of the first node of the last subpath of the curve
sDup.Curve.SubPaths(sDup.Curve.SubPaths.Count).StartNode.GetPosition x, y
' Delete the duplicate
sDup.Delete
End Sub

Private Function arccos(ByVal x As Double) As Double
Const pi As Double = 3.14159265358979
If x >= 1 Then
arccos = 0
ElseIf x <= -1 Then
arccos = 180
Else
arccos = 90 - Atn(x / Sqr(1 - x * x)) * 180 / pi
End If
End Function```
To save a CDR file without embedded VBA macros, just go to the File Save dialog, click the "Options >>" button at the bottom to expand the dialog and uncheck the "Save with embedded VBA Project" button on the bottom right.

I'm not quite sure what you mean by your question #3 above. What coordinates of workspace you are looking for?