View Single Post
Old 29-12-2005, 23:33
Alex's Avatar
Alex Alex is offline
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4


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:

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
    ' 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
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
        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?
Reply With Quote