home *** CD-ROM | disk | FTP | other *** search
/ BUG 11 / BUGCD1998_02.ISO / aplic / turbocad / tcw.z / radcopy.bas < prev    next >
BASIC Source File  |  1997-05-05  |  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 NULL     = 0
  9. GLobal Const GK_ARC     = 2
  10.  
  11. sub Main
  12.     Dim t As Long
  13.     Dim gCount As Long
  14.     Dim ga As Long
  15.     Dim vCount As Long
  16.     Dim vc As Long
  17.     Dim vs As Long
  18.     Dim ve As Long
  19.     Dim strText As String
  20.     dim g as Long
  21.     dim i as integer
  22.     dim x as double
  23.     dim y as double
  24.     dim angle as double
  25.     dim angle2 as double
  26.     dim r as double
  27.     dim s as double
  28.     dim pi as double
  29.     dim l as long
  30.     dim a as double
  31.     dim c as string
  32.     dim hActive as long
  33.     dim gText As Long
  34.     dim res As Long
  35.  
  36.     'Get drawing handle
  37.     hActive = TCWDrawingActive()
  38.  
  39.     if (hActive = NULL) then
  40.         MsgBox "Need active drawing."
  41.         'Terminate Program
  42.         Stop
  43.     end if
  44.  
  45.     'Get selection count to see that we have 1 graphic selected
  46.     gCount = TCWSelectionCount
  47.     if (gCount = NULL) or (gCount <> 1) then
  48.         MsgBox "Program requires an arc (not circle) to be selected."
  49.         'Terminate the program
  50.         Stop
  51.     end if
  52.  
  53.     'Get graphic handle for the selection
  54.     ga = TCWSelectionAt(0)
  55.  
  56.     if (ga = NULL) then
  57.           MsgBox "Program requires an arc (not circle) to be selected."
  58.              ' Terminate the program
  59.         Stop
  60.     end if
  61.  
  62.     'Make sure we have an arc and not a circle
  63.     if ((TCWGraphicPropertyGet(ga, "Kind") <> GK_ARC) or TCWGraphicPropertyGet(ga, "Closed")) then
  64.           MsgBox "Program requires an arc (not circle) to be selected."
  65.              ' Terminate the program
  66.              Stop
  67.     End If
  68.  
  69.     vc = TCWVertexAt(ga,0)        ' center of arc
  70.     vs = TCWVertexAt(ga,1)        ' start point of arc
  71.     ve = TCWVertexAt(ga,2)        ' end point of arc
  72.  
  73.     'Deselect the arc
  74.       TCWDeselectAll
  75.   
  76.     'Text to put around the arc
  77.     strText = "He who goes round in circles shall be known as a big wheel!"
  78.  
  79.     'Calculate the value of pi
  80.     pi = atn(1)*4
  81.  
  82.     'Calculate the start angle
  83.     angle = arctan((TCWGetY(vs)-TCWGetY(vc)),(TCWGetX(vs)-TCWGetX(vc)))
  84.  
  85.     'Calculate the end angle
  86.     angle2 = arctan((TCWGetY(ve)-TCWGetY(vc)),(TCWGetX(ve)-TCWGetX(vc)))
  87.  
  88.     while (angle > angle2)
  89.         angle2 = angle2 + pi*2
  90.     wend
  91.     
  92.     'Calculate the radius of the arc
  93.     r = sqr((TCWGetY(ve)-TCWGetY(vc))*(TCWGetY(ve)-TCWGetY(vc))  +   (TCWGetX(ve)-TCWGetX(vc))*(TCWGetX(ve)-TCWGetX(vc)))
  94.  
  95.  
  96.     ' text character width = chord length / number of chars in string
  97.     s = ((angle2-angle) * r) / len(strText)
  98.  
  99.     'Length of string
  100.     l = len(strText)
  101.  
  102.     'Setup Undo Record for this copy, we don't need to add the text graphics to 
  103.     'the undo record because TCADAPI will do that for us
  104.     TCWUndoRecordStart hActive, "Radical Text Copy"
  105.     'put the characters around the arc
  106.     for i = 0 to l - 1
  107.         a = angle + ((angle2 - angle)*i)/l
  108.         x = TCWGetX(vc) + r * cos(a)
  109.         y = TCWGetY(vc) + r * sin(a)
  110.  
  111.         c = mid(strText, l-i, 1)
  112.  
  113.         gText = TCWText(x, y, 0.0, c, s, (a - (pi/2)))
  114.         res = TCWGraphicPropertySet(gText, "TextFont", "Arial")
  115.     next i
  116.  
  117.     'End undo record
  118.     TCWUndoRecordEnd hActive
  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.