home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Personal Computer World 2002 March
/
PCWMAR02.iso
/
software
/
turbocad
/
V4
/
tcw.z
/
virtpnt.bas
< prev
next >
Wrap
BASIC Source File
|
1997-10-28
|
14KB
|
563 lines
'Script inserts a point graphic at the point where two non intersecting lines meet.
'
'******************************************************************
'
' TurboCAD for Windows
' Copyright (c) 1993 - 1996
' International Microcomputer Software, Inc.
' (IMSI)
' All rights reserved.
'
'******************************************************************
'
' Filename: VIRTPNT.BAS
'
' Author: Pat Garner
'
' Date: 1/14/97
'
'
' Scriptname: Find Intersection
'
' Version: 2.0
'
' Description: Script inserts a point graphic
' at the point where two non
' intersecting lines meet.
'
'
'
' Revision History:
'
' - 1.0 User must select two line graphics and then run script.
' Script will check that there are only two single lines
' currently part of the selection.
' Script then:
' 1) gets handle of selected lines
' 2) gets handle of both vertices
' 3) gets all vertices coordinates
' 4) determine which end of lines is closer
' 5) calculate angle of lines
' 6) calcutate coordinates of intersect
' 7) insert point object at coordinates
'
'
' Tcadapi Functions used:
' -
'
'
' TODO:
' - Put App in select dragger mode.
' - Prompt user for selection, first graphic
' - Msgbox
' - Status Bar Prompt
' - Wait until the user clicks
' - Check selected graphic to be sure it's a single line.(function?)
' - Get graphics handle
' - TCWVertexCount: more than two?
' - Yes - Inform user that graphic is incorrect
' - Ding, MsgBox "Please ...
' - Ding, Status Bar Prompt "Wrong Graphic Type...
' - Deselect graphic
' - Return Null (zero)
' - No - Return handle of graphic
' - Prompt user for selection, seccond graphic
' - Msgbox
' - Status Bar Prompt
' - Wait until the user clicks
' - Check selected graphic to be sure it's a single line.(function?)
' - Get graphics handle
' - TCWVertexCount: more than two?
' - Yes - Inform user that graphic is incorrect
' - Ding, MsgBox "Please ...
' - Ding, Status Bar Prompt "Wrong Graphic Type...
' - Deselect graphic
' - Return Null (zero)
' - No - Return handle of graphic
' - Query for vertex handles
' - Query for vertex coordinates
' - Determine closer end of lines
' - Calculate angle relative to that end
' - Calculate intersection of lines
' - Insert point object at intersection
' - Deselect two line graphics
' - TCWViewportRedraw
' - TCWViewportExtents
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' * General Script Constants
Global Const MAX_LINES = 2 ' * Maximum number of line graphics
'
Global Const MAX_VERTICES = 2 ' * Maximum number of vertices that a
' ' * line graphic may contain.
'
Global Const MAX_COORDS = 2 ' * Maximum number of coordinate values
'
'
'
Global Const MY_TRUE = 1 ' * For use with TCWPenDown
Global Const MY_FALSE = 0 ' * For use with TCWPenDown
Global Const GK_GRAPHIC = &H0B ' * TurboCAD graphic kind - generic graphic
Global Const GK_ARC = &H02 ' * TurboCAD graphic kind - arc graphic
'
'
'
Dim measure as Double
Dim es As Double
Dim es1 As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: MAIN'''''''''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Main is the conductor of the program
' * and like a music conductor, tells
' * the other parts of the program when
' * it's time to do their thing.
' *
' *
Sub main ()
Dim hDrawing As Long ' * Handle to active drawing
Dim hG As Long ' * Handle to graphic
Dim counter As Long ' * Generic loop counter
Dim gNum As Integer ' * Number of graphics in the current drawing
Dim lNum As Integer ' * Number of line graphics in current drawing
Dim vNum As Integer ' * Number vertices to a graphic
Dim hGraphic(2) As Long ' * Array for line graphic's handles
Dim hVertex(2,2) As Long ' * Array for line graphic's vertices' handles
Dim vCoor(2,2,2) As Double ' * Array for vertices' coordinates
Dim vCoorPoint(2) As Double ' * Array for point object's coordinates
InitializeScript
hDrawing = TCWDrawingActive
gNum = TCWGraphicCount ( hDrawing )
if gNum < 2 then
MsgBox "Must have at least two line graphics in current drawing!"
END
end if
for counter = 0 to gNum-1
hG = TCWGraphicAt ( hDrawing, ( counter ) )
vNum = TCWVertexCount ( hG )
if vNum = 2 then lNum = lNum + 1
next
if lNum < 2 then
MsgBox "Must have at least two line graphics in current drawing!"
END
end if
GetGraphicsHandles hGraphic
GetVertexHandles hGraphic, hVertex
GetVertexCoordinates hVertex, vCoor
CalculateIntersectCoordinates vCoor, vCoorPoint
InsertPointObject vCoorPoint, hDrawing
MsgBox "Finished"
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: InitializeScript'''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Script Setup Stuff
' *
' *
Sub InitializeScript ()
TCWClearError ' * Clear any error out of the error buffer.
measure = Abs(TCWViewExtentsGetY2() - TCWViewExtentsGetY1())/8.5
' * ADD YOUR CODE HERE *
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''FUNCTION: GetLineHandle''''''''''''''''''''''''''''''''''''''
'
' * Parameters: ByVal strPrompt As String - String containing the
' * status bar message.
' *
' *
' * Return Value: Long
' *
' *
' * Description:
' *
' * This subroutine uses TCWGetPoint to
' * get the user to select a point on
' * the current drawing. The function
' * then checks to see if there is a
' * line graphic at that point. If so,
' * function returns lines graphic's
' * handle. If there is not a line
' * graphic present at the user's
' * selected point, the function
' * displays a message box alerting
' * the user of this and then asks
' * the user to select another point.
' *
' *
Function GetLineHandle ( ByVal strPrompt As String ) As Long
Dim hVertex As Long
Dim hGraphic As Long
Dim rVal As Long
Dim r as Long
hVertex = TCWVertexCreate(0,0,0)
while rVal = 0
r=tcwgetpoint(hVertex, strPrompt, 0, 0, &H0040, 1)
if r<0 then
Stop
End If
hGraphic = TCWVertexFindGraphic (hVertex)
vNum = TCWVertexCount (hGraphic)
if vNum = 2 then rVal = hGraphic
wend
GetLineHandle = rVal
End Function
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: GetGraphicsHandles'''''''''''''''''''''''''''''''
'
' * Parameters: ByRef GraphicHandleArray() As Long
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This subroutine cycles through the selected
' * graphics and loads each grahic's handle
' * into an array which will be used later to
' * retrieve other values for the script.
' *
' *
Sub GetGraphicsHandles ( ByRef GraphicHandleArray() As Long )
Dim counter As Long
Dim strPrompt(2) As String
strPrompt(1) = "Please select first line"
strPrompt(2) = "Please select second line"
for counter = 1 to MAX_LINES
GraphicHandleArray( counter - 1 ) = GetLineHandle ( strPrompt( counter ) )
next
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: GetVertexHandles'''''''''''''''''''''''''''''''''
'
' * Parameters: ByRef GraphicHandleArray() As Long
' * ByRef VertexHandleArray() As Long
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This subroutine uses the graphics handles
' * stored in GraphicHandleArray() to
' * the handles for each graphic's vertices
' * then store them in VertexHandleArray().
' *
' *
Sub GetVertexHandles ( ByRef GraphicHandleArray() As Long, _
ByRef VertexHandleArray() As Long )
dim gCounter as long
dim vCounter as long
for gCounter = 0 to (MAX_LINES - 1)
for vCounter = 0 to MAX_VERTICES-1
VertexHandleArray( gCounter, ( vCounter ) ) = _
TCWVertexAt ( GraphicHandleArray( gCounter ), vCounter )
next
next
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: GetVertexCoordinates'''''''''''''''''''''''''''''
'
' * Parameters: ByRef VertexHandleArray() As Long
' * ByRef VertexCoordArray() As Double
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This subroutine takes the vertex handles
' * stored in the VertexHandleArray to
' * retrieve the vertex coordinates for the
' * two selected line graphics and store
' * then in VertexCoordArray().
' *
' *
Sub GetVertexCoordinates ( ByRef VertexHandleArray() As Long, _
ByRef VertexCoordArray() As Double )
dim gCounter as long
dim vCounter as long
dim cCounter as long
for gCounter = 0 to MAX_LINES
for vCounter = 0 to MAX_VERTICES
for cCounter = 0 to MAX_COORDS
if cCounter = 0 then
VertexCoordArray(gCounter, vCounter, cCounter) _
= TCWGetX(VertexHandleArray(gCounter, vCounter))
end if
if cCounter = 1 then
VertexCoordArray(gCounter, vCounter, cCounter) _
= TCWGetY(VertexHandleArray(gCounter, vCounter))
end if
next
next
next
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: CalculateIntersectCoordinates''''''''''''''''''''
'
' * Parameters: ByRef VCA() As Double - Vertex Coordinate Array
' * ByRef PCA() As Double - Point Coordinate Array
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This subroutine takes the vertex coordinates
' * that's been gathered from the selected line
' * graphics and calculates the x and y values
' * for the 'virtual' intersection of the two
' * lines. The resulting x and y values are
' * then stored in PCA() (point coordinate array)
' * for use in the point insertion subroutine.
' *
' *
' * Note:
' *
' * When using the vertex coordinate array VCA()
' * each value is indexed with a base of 0. The
' * first line graphic is 0, the second 1. The
' * first vertex is 0,0 and the second is 0,1.
' * The vertex x/y gets a little more confusing:
' * x of the first vertex of the first line would
' * be 0,0,0 and y, 0,0,1.
' *
' *
Sub CalculateIntersectCoordinates ( ByRef VCA() As Double, _
ByRef PCA() As Double )
Dim a11 As Double
Dim a12 As Double
Dim b1 As Double
Dim b2 As Double
Dim a21 As Double
Dim a22 As Double
Dim x11 As Double
Dim x12 As Double
Dim x21 As Double
Dim x22 As Double
Dim y11 As Double
Dim y12 As Double
Dim y21 As Double
Dim y22 As Double
Dim x As Double
Dim y As Double
Dim d As Double
x11 = VCA( 0, 0, 0 )
x12 = VCA( 0, 1, 0 )
x21 = VCA( 1, 0, 0 )
x22 = VCA( 1, 1, 0 )
y11 = VCA( 0, 0, 1 )
y12 = VCA( 0, 1, 1 )
y21 = VCA( 1, 0, 1 )
y22 = VCA( 1, 1, 1 )
a11 = ( y12 - y11 )
a12 = - ( x12 - x11 )
a21 = ( y22 - y21 )
a22 = - ( x22 - x21 )
b1 = ( ( y12 - y11 ) * x11 ) - ( ( x12 - x11 ) * y11 )
b2 = ( ( y22 - y21 ) * x21 ) - ( ( x22 - x21 ) * y21 )
d = ( ( a11 * a22 ) - ( a21 * a12 ) )
if d = 0 then
MsgBox "No virtual intersection possible!"
END
end if
x = ( ( a22 * b1 ) - ( a12 * b2 ) ) / d
y = ( ( a11 * b2 ) - ( a21 * b1 ) ) / d
PCA( 0 ) = x
PCA( 1 ) = y
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: InsertPointObject''''''''''''''''''''''''''''''''
'
' * Parameters: ByRef PCA() As Double
' * ByVal hDrawing As Long
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This subroutine uses the x and y
' * values stored in PCA() to insert
' * a new point graphic at the 'virtual'
' * intersection of the two selected
' * line graphics.
' *
' *
Sub InsertPointObject ( ByRef PCA() As Double, ByVal hDrawing As Long )
Dim hParentGraphic As Long
Dim hCircleGraphic As Long
Dim hCrossGraphic As Long
Dim hVertex1 As Long
Dim hVertex2 As Long
Dim hVertex3 As Long
Dim hVertex4 As Long
hParentGraphic = TCWGraphicCreate ( GK_GRAPHIC, "" )
hTempGraphic = TCWCircleCenterAndPoint ( PCA#( 0 ),PCA#( 1 ),0#, ( PCA#( 0 ) + .05#*measure ), _
( PCA#( 1 ) + .05#*measure ), 0# )
hCircleGraphic = TCWGraphicCopy ( hTempGraphic )
TCWGraphicDispose hTempGraphic
TCWGraphicAppend hParentGraphic, hCircleGraphic
hCrossGraphic = TCWGraphicCreate ( GK_GRAPHIC, "" )
hVertex1 = TCWVertexCreate ( PCA#( 0 ) - .15#*measure, PCA#( 1 ), 0# )
hVertex2 = TCWVertexCreate ( PCA#( 0 ) + .15#*measure, PCA#( 1 ), 0# )
hVertex3 = TCWVertexCreate ( PCA#( 0 ),PCA#( 1 ) - .15*measure,0# )
hVertex4 = TCWVertexCreate ( PCA#( 0 ),PCA#( 1 ) + .15*measure,0# )
TCWPenDown hVertex1, MY_FALSE
TCWPenDown hVertex2, MY_TRUE
TCWPenDown hVertex3, MY_FALSE
TCWPenDown hVertex4, MY_TRUE
TCWGraphicVertexAdd hCrossGraphic, hVertex1
TCWGraphicVertexAdd hCrossGraphic, hVertex2
TCWGraphicVertexAdd hCrossGraphic, hVertex3
TCWGraphicVertexAdd hCrossGraphic, hVertex4
TCWGraphicAppend hParentGraphic, hCrossGraphic
TCWGraphicAppend 0, hParentGraphic
TCWGraphicDraw hParentGraphic, 0
TCWUndoRecordStart hDrawing, "Virtual Point"
TCWUndoRecordAddGraphic hDrawing, hParentGraphic
TCWUndoRecordEnd hDrawing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''