home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Personal Computer World 2002 March
/
PCWMAR02.iso
/
software
/
turbocad
/
V4
/
tcw.z
/
radcopy.bas
< prev
next >
Wrap
BASIC Source File
|
1997-10-08
|
4KB
|
154 lines
' Sample that shows how to draw text along arcs
' Author : Tamara Cartwright, based on script from TCSources site
' Date : 01/26/97
' Misc
GLobal Const GK_ARC = 2
sub Main
Dim t As Long
Dim gCount As Long
Dim ga As Long
Dim vCount As Long
Dim vc As Long
Dim vs As Long
Dim ve As Long
Dim strText As String
dim g as Long
dim i as integer
dim x as double
dim y as double
dim angle as double
dim angle2 as double
dim r as double
dim s as double
dim pi as double
dim l as long
dim a as double
dim c as string
dim hActive as long
dim gText As Long
dim res As Long
'Get drawing handle
hActive = TCWDrawingActive()
if (hActive = 0) then
MsgBox "Need active drawing."
'Terminate Program
Stop
end if
'Get selection count to see that we have 1 graphic selected
gCount = TCWSelectionCount
if (gCount = 0) or (gCount <> 1) then
MsgBox "Program requires an arc (not circle) to be selected."
'Terminate the program
Stop
end if
'Get graphic handle for the selection
ga = TCWSelectionAt(0)
if (ga = 0) then
MsgBox "Program requires an arc (not circle) to be selected."
' Terminate the program
Stop
end if
'Make sure we have an arc and not a circle
if ((TCWGraphicPropertyGet(ga, "Kind") <> GK_ARC) or TCWGraphicPropertyGet(ga, "Closed")) then
MsgBox "Program requires an arc (not circle) to be selected."
' Terminate the program
Stop
End If
vc = TCWVertexAt(ga,0) ' center of arc
vs = TCWVertexAt(ga,1) ' start point of arc
ve = TCWVertexAt(ga,2) ' end point of arc
'Deselect the arc
TCWDeselectAll
'Text to put around the arc
strText = "He who goes round in circles shall be known as a big wheel!"
'Calculate the value of pi
pi = atn(1)*4
'Calculate the start angle
angle = arctan((TCWGetY(vs)-TCWGetY(vc)),(TCWGetX(vs)-TCWGetX(vc)))
'Calculate the end angle
angle2 = arctan((TCWGetY(ve)-TCWGetY(vc)),(TCWGetX(ve)-TCWGetX(vc)))
while (angle > angle2)
angle2 = angle2 + pi*2
wend
'Calculate the radius of the arc
r = sqr((TCWGetY(ve)-TCWGetY(vc))*(TCWGetY(ve)-TCWGetY(vc)) + (TCWGetX(ve)-TCWGetX(vc))*(TCWGetX(ve)-TCWGetX(vc)))
' text character width = chord length / number of chars in string
s = ((angle2-angle) * r) / len(strText)
'Length of string
l = len(strText)
'Setup Undo Record for this copy, we don't need to add the text graphics to
'the undo record because TCADAPI will do that for us
TCWUndoRecordStart hActive, "Radical Text Copy"
'put the characters around the arc
for i = 0 to l - 1
a = angle + ((angle2 - angle)*i)/l
x = TCWGetX(vc) + r * cos(a)
y = TCWGetY(vc) + r * sin(a)
c = mid(strText, l-i, 1)
gText = TCWText(x, y, 0.0, c, s, (a - (pi/2)))
res = TCWGraphicPropertySet(gText, "TextFont", "Arial")
next i
'End undo record
TCWUndoRecordEnd hActive
End Sub
' Four quadrant ArcTan function written by a mathematically impaired programmer who did not want to
' leave anything to chance. (It will take dx and dy and deliver an angle between 0 and 2pi).
function arctan(ByVal dy As double, ByVal dx As Double) As Double
Dim pi as Double
Dim a as double
pi = atn(1)*4
if (abs(dx) < 0.0001) then
if (dy > 0) then
a = pi/2
else
a = 3*pi/2
end if
else
a = abs(atn(dy/dx))
if (dx < 0) then
if (dy < 0) then ' 3rd quad
a = pi+a
else ' 2nd quad
a = pi-a
end if
else
if (dy < 0) then ' 4th quad
a = 2*pi-a
else ' 1st quad
end if
end if
end if
arctan = a
end function