home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / V4 / tcw.z / radcopy.bas < prev    next >
BASIC Source File  |  1997-10-08  |  4KB  |  154 lines

  1. ' Sample that shows how to draw text along arcs
  2.  
  3. ' Author    : Tamara Cartwright, based on script from TCSources site
  4. ' Date        : 01/26/97
  5.  
  6.  
  7. ' Misc
  8. GLobal Const GK_ARC     = 2
  9.  
  10. sub Main
  11.     Dim t As Long
  12.     Dim gCount As Long
  13.     Dim ga As Long
  14.     Dim vCount As Long
  15.     Dim vc As Long
  16.     Dim vs As Long
  17.     Dim ve As Long
  18.     Dim strText As String
  19.     dim g as Long
  20.     dim i as integer
  21.     dim x as double
  22.     dim y as double
  23.     dim angle as double
  24.     dim angle2 as double
  25.     dim r as double
  26.     dim s as double
  27.     dim pi as double
  28.     dim l as long
  29.     dim a as double
  30.     dim c as string
  31.     dim hActive as long
  32.     dim gText As Long
  33.     dim res As Long
  34.  
  35.     'Get drawing handle
  36.     hActive = TCWDrawingActive()
  37.  
  38.     if (hActive = 0) then
  39.         MsgBox "Need active drawing."
  40.         'Terminate Program
  41.         Stop
  42.     end if
  43.  
  44.     'Get selection count to see that we have 1 graphic selected
  45.     gCount = TCWSelectionCount
  46.     if (gCount = 0) or (gCount <> 1) then
  47.         MsgBox "Program requires an arc (not circle) to be selected."
  48.         'Terminate the program
  49.         Stop
  50.     end if
  51.  
  52.     'Get graphic handle for the selection
  53.     ga = TCWSelectionAt(0)
  54.  
  55.     if (ga = 0) then
  56.           MsgBox "Program requires an arc (not circle) to be selected."
  57.              ' Terminate the program
  58.         Stop
  59.     end if
  60.  
  61.     'Make sure we have an arc and not a circle
  62.     if ((TCWGraphicPropertyGet(ga, "Kind") <> GK_ARC) or TCWGraphicPropertyGet(ga, "Closed")) then
  63.           MsgBox "Program requires an arc (not circle) to be selected."
  64.              ' Terminate the program
  65.              Stop
  66.     End If
  67.  
  68.     vc = TCWVertexAt(ga,0)        ' center of arc
  69.     vs = TCWVertexAt(ga,1)        ' start point of arc
  70.     ve = TCWVertexAt(ga,2)        ' end point of arc
  71.  
  72.     'Deselect the arc
  73.       TCWDeselectAll
  74.   
  75.     'Text to put around the arc
  76.     strText = "He who goes round in circles shall be known as a big wheel!"
  77.  
  78.     'Calculate the value of pi
  79.     pi = atn(1)*4
  80.  
  81.     'Calculate the start angle
  82.     angle = arctan((TCWGetY(vs)-TCWGetY(vc)),(TCWGetX(vs)-TCWGetX(vc)))
  83.  
  84.     'Calculate the end angle
  85.     angle2 = arctan((TCWGetY(ve)-TCWGetY(vc)),(TCWGetX(ve)-TCWGetX(vc)))
  86.  
  87.     while (angle > angle2)
  88.         angle2 = angle2 + pi*2
  89.     wend
  90.     
  91.     'Calculate the radius of the arc
  92.     r = sqr((TCWGetY(ve)-TCWGetY(vc))*(TCWGetY(ve)-TCWGetY(vc))  +   (TCWGetX(ve)-TCWGetX(vc))*(TCWGetX(ve)-TCWGetX(vc)))
  93.  
  94.  
  95.     ' text character width = chord length / number of chars in string
  96.     s = ((angle2-angle) * r) / len(strText)
  97.  
  98.     'Length of string
  99.     l = len(strText)
  100.  
  101.     'Setup Undo Record for this copy, we don't need to add the text graphics to 
  102.     'the undo record because TCADAPI will do that for us
  103.     TCWUndoRecordStart hActive, "Radical Text Copy"
  104.     'put the characters around the arc
  105.     for i = 0 to l - 1
  106.         a = angle + ((angle2 - angle)*i)/l
  107.         x = TCWGetX(vc) + r * cos(a)
  108.         y = TCWGetY(vc) + r * sin(a)
  109.  
  110.         c = mid(strText, l-i, 1)
  111.  
  112.         gText = TCWText(x, y, 0.0, c, s, (a - (pi/2)))
  113.         res = TCWGraphicPropertySet(gText, "TextFont", "Arial")
  114.     next i
  115.  
  116.     'End undo record
  117.     TCWUndoRecordEnd hActive
  118.  
  119. End Sub
  120.  
  121. ' Four quadrant ArcTan function written by a mathematically impaired programmer who did not want to
  122. ' leave anything to chance. (It will take dx and dy and deliver an angle between 0 and 2pi).
  123.  
  124. function arctan(ByVal dy As double, ByVal dx As Double) As Double
  125.     Dim pi as Double    
  126.     Dim a as double
  127.     pi = atn(1)*4
  128.     
  129.     if (abs(dx) < 0.0001) then
  130.         if (dy > 0) then
  131.             a = pi/2
  132.         else
  133.             a = 3*pi/2
  134.         end if
  135.     else
  136.         a = abs(atn(dy/dx))
  137.         if (dx < 0) then
  138.             if (dy < 0) then  ' 3rd quad
  139.                 a = pi+a
  140.             else            ' 2nd quad
  141.                 a = pi-a
  142.             end if
  143.         else 
  144.             if (dy < 0) then  ' 4th quad
  145.                 a = 2*pi-a
  146.             else            ' 1st quad
  147.  
  148.             end if
  149.  
  150.         end if
  151.     end if
  152.     arctan = a
  153. end function
  154.