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

  1. 'Script inserts a point graphic at the point where two non intersecting lines meet.
  2. '
  3. '******************************************************************
  4. '                                                              
  5. '                      TurboCAD for Windows                    
  6. '                   Copyright (c) 1993 - 1996                   
  7. '             International Microcomputer Software, Inc.         
  8. '                            (IMSI)                              
  9. '                      All rights reserved.                
  10. '                                                                
  11. '******************************************************************
  12. '
  13. ' Filename: VIRTPNT.BAS
  14. '
  15. ' Author:    Pat Garner
  16. '
  17. ' Date:        1/14/97
  18. '
  19. '
  20. ' Scriptname:    Find Intersection
  21. '
  22. ' Version:        2.0
  23. '
  24. ' Description:    Script inserts a point graphic
  25. '                at the point where two non
  26. '                intersecting lines meet.
  27. '
  28. '
  29. '
  30. ' Revision History:
  31. '
  32. '              - 1.0    User must select two line graphics and then run script.
  33. '            Script will check that there are only two single lines
  34. '            currently part of the selection.
  35. '            Script then:    
  36. '                        1) gets handle of selected lines
  37. '                        2) gets handle of both vertices
  38. '                        3) gets all vertices coordinates
  39. '                        4) determine which end of lines is closer
  40. '                        5) calculate angle of lines
  41. '                        6) calcutate coordinates of intersect
  42. '                        7) insert point object at coordinates
  43. '
  44. '
  45. ' Tcadapi Functions used:
  46. '                            -
  47. '
  48. '
  49. ' TODO:
  50. '        - Put App in select dragger mode.
  51. '        - Prompt user for selection, first graphic
  52. '            - Msgbox
  53. '            - Status Bar Prompt
  54. '        - Wait until the user clicks
  55. '        - Check selected graphic to be sure it's a single line.(function?)
  56. '            - Get graphics handle
  57. '            - TCWVertexCount: more than two?
  58. '                - Yes    - Inform user that graphic is incorrect
  59. '                            - Ding, MsgBox "Please ...
  60. '                            - Ding, Status Bar Prompt "Wrong Graphic Type...
  61. '                        - Deselect graphic
  62. '                        - Return Null (zero)
  63. '                - No    - Return handle of graphic
  64. '        - Prompt user for selection, seccond graphic
  65. '            - Msgbox
  66. '            - Status Bar Prompt
  67. '        - Wait until the user clicks
  68. '        - Check selected graphic to be sure it's a single line.(function?)
  69. '            - Get graphics handle
  70. '            - TCWVertexCount: more than two?
  71. '                - Yes    - Inform user that graphic is incorrect
  72. '                            - Ding, MsgBox "Please ...
  73. '                            - Ding, Status Bar Prompt "Wrong Graphic Type...
  74. '                        - Deselect graphic
  75. '                        - Return Null (zero)
  76. '                - No    - Return handle of graphic
  77. '        - Query for vertex handles
  78. '        - Query for vertex coordinates
  79. '        - Determine closer end of lines
  80. '        - Calculate angle relative to that end
  81. '        - Calculate intersection of lines
  82. '        - Insert point object at intersection
  83. '        - Deselect two line graphics
  84. '        - TCWViewportRedraw
  85. '        - TCWViewportExtents
  86. '
  87. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  88.  
  89.  
  90.  
  91.  
  92. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  93. '
  94. ' * General Script Constants
  95. Global Const MAX_LINES = 2                    ' * Maximum number of line graphics 
  96. '
  97. Global Const MAX_VERTICES = 2                ' * Maximum number of vertices that a 
  98. '                                            ' * line graphic may contain.  
  99. '
  100. Global Const MAX_COORDS = 2                    ' * Maximum number of coordinate values
  101. '
  102. '
  103. '
  104. Global Const MY_TRUE    = 1                    ' * For use with TCWPenDown
  105. Global Const MY_FALSE    = 0                    ' * For use with TCWPenDown
  106. Global Const GK_GRAPHIC    = &H0B                ' * TurboCAD graphic kind - generic graphic
  107. Global Const GK_ARC    = &H02                ' * TurboCAD graphic kind - arc graphic
  108. '
  109. '
  110. '
  111. Dim measure as Double
  112. Dim es As Double
  113. Dim es1 As Long
  114. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  115.  
  116. ''SUBROUTINE: MAIN'''''''''''''''''''''''''''''''''''''''''''''
  117. '
  118. ' * Parameters: None
  119. ' * 
  120. ' *
  121. ' * Return Value: None
  122. ' * 
  123. ' *
  124. ' * Description:
  125. ' *
  126. ' *        Main is the conductor of the program
  127. ' *         and like a music conductor, tells
  128. ' *         the other parts of the program when
  129. ' *         it's time to do their thing.
  130. ' *
  131. ' *
  132. Sub main ()
  133.  
  134.     Dim hDrawing        As Long        ' * Handle to active drawing
  135.     Dim hG                As Long        ' * Handle to graphic
  136.     Dim counter            As Long        ' * Generic loop counter
  137.     Dim gNum            As Integer    ' * Number of graphics in the current drawing
  138.     Dim lNum            As Integer    ' * Number of line graphics in current drawing
  139.     Dim vNum            As Integer    ' * Number vertices to a graphic
  140.     Dim hGraphic(2)        As Long        ' * Array for line graphic's handles
  141.     Dim hVertex(2,2)    As Long        ' * Array for line graphic's vertices' handles
  142.     Dim vCoor(2,2,2)    As Double    ' * Array for vertices' coordinates
  143.     Dim vCoorPoint(2)    As Double    ' * Array for point object's coordinates
  144.  
  145.     
  146.     InitializeScript
  147.  
  148.     hDrawing = TCWDrawingActive
  149.     gNum = TCWGraphicCount ( hDrawing )
  150.  
  151.     if gNum < 2 then
  152.  
  153.         MsgBox "Must have at least two line graphics in current drawing!"
  154.         END
  155.  
  156.     end if
  157.  
  158.  
  159.     for counter = 0 to gNum-1
  160.  
  161.         hG = TCWGraphicAt ( hDrawing, ( counter ) )
  162.         vNum = TCWVertexCount ( hG )
  163.         if vNum = 2 then lNum = lNum + 1
  164.  
  165.     next
  166.  
  167.  
  168.  
  169.     if lNum < 2 then
  170.  
  171.         MsgBox "Must have at least two line graphics in current drawing!"
  172.         END
  173.  
  174.     end if
  175.  
  176.  
  177.     GetGraphicsHandles hGraphic
  178.     GetVertexHandles hGraphic, hVertex
  179.  
  180.     
  181.     GetVertexCoordinates hVertex, vCoor
  182.     CalculateIntersectCoordinates vCoor, vCoorPoint
  183.     
  184.     InsertPointObject vCoorPoint, hDrawing
  185.  
  186.   MsgBox "Finished"
  187. End Sub
  188. '
  189. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  190.  
  191.  
  192. ''SUBROUTINE: InitializeScript'''''''''''''''''''''''''''''''''
  193. '
  194. ' * Parameters: None
  195. ' *
  196. ' * 
  197. ' * Return Value: None
  198. ' *
  199. ' * 
  200. ' * Description:
  201. ' *
  202. ' *        Script Setup Stuff
  203. ' *
  204. ' *
  205. Sub InitializeScript ()
  206.  
  207.     TCWClearError    ' * Clear any error out of the error buffer.
  208.  
  209.     
  210.  
  211.       measure = Abs(TCWViewExtentsGetY2() - TCWViewExtentsGetY1())/8.5    
  212.         
  213.     ' * ADD YOUR CODE HERE *
  214.  
  215. End Sub
  216. '
  217. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  218.  
  219. ''FUNCTION: GetLineHandle''''''''''''''''''''''''''''''''''''''
  220. '
  221. ' * Parameters: ByVal strPrompt As String    -    String containing the 
  222. ' *                                                 status bar message.
  223. ' * 
  224. ' *
  225. ' * Return Value:    Long
  226. ' * 
  227. ' * 
  228. ' * Description:    
  229. ' * 
  230. ' *        This subroutine uses TCWGetPoint to 
  231. ' *         get the user to select a point on 
  232. ' *         the current drawing.  The function
  233. ' *         then checks to see if there is a 
  234. ' *         line graphic at that point.  If so, 
  235. ' *         function returns lines graphic's
  236. ' *         handle.  If there is not a line 
  237. ' *         graphic present at the user's 
  238. ' *         selected point, the function
  239. ' *         displays a message box alerting
  240. ' *         the user of this and then asks
  241. ' *         the user to select another point.
  242. ' * 
  243. ' *  
  244. Function GetLineHandle ( ByVal strPrompt As String ) As Long
  245.  
  246.     Dim hVertex        As Long
  247.     Dim hGraphic    As Long
  248.     Dim rVal        As Long
  249.                 Dim r as Long
  250.                
  251.     hVertex = TCWVertexCreate(0,0,0) 
  252.  
  253.  
  254.     while rVal = 0 
  255.  
  256.              r=tcwgetpoint(hVertex, strPrompt, 0, 0, &H0040, 1)
  257. if r<0 then
  258. Stop
  259. End If
  260.         hGraphic = TCWVertexFindGraphic (hVertex)
  261.  
  262.         vNum = TCWVertexCount (hGraphic)
  263.         if vNum = 2 then rVal = hGraphic
  264.  
  265.     wend
  266.  
  267.     GetLineHandle = rVal
  268.  
  269. End Function
  270. '
  271. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  272.  
  273.  
  274.  
  275. ''SUBROUTINE: GetGraphicsHandles'''''''''''''''''''''''''''''''
  276. '
  277. ' * Parameters: ByRef GraphicHandleArray() As Long
  278. ' *
  279. ' * 
  280. ' * Return Value: None
  281. ' *
  282. ' * 
  283. ' * Description:
  284. ' *
  285. ' *        This subroutine cycles through the selected
  286. ' *         graphics and loads each grahic's handle
  287. ' *         into an array which will be used later to
  288. ' *         retrieve other values for the script.
  289. ' * 
  290. ' *
  291. Sub GetGraphicsHandles ( ByRef GraphicHandleArray() As Long )
  292.  
  293.     Dim counter            As Long
  294.     Dim strPrompt(2)    As String
  295.  
  296.     strPrompt(1) = "Please select first line"
  297.     strPrompt(2) = "Please select second line"
  298.     
  299.     
  300.     for counter = 1 to MAX_LINES
  301.         GraphicHandleArray( counter - 1 ) = GetLineHandle ( strPrompt( counter ) )
  302.     next
  303.     
  304. End Sub
  305. '
  306. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  307.  
  308.  
  309. ''SUBROUTINE: GetVertexHandles'''''''''''''''''''''''''''''''''
  310. '
  311. ' * Parameters:    ByRef GraphicHandleArray() As Long 
  312. ' *                ByRef VertexHandleArray() As Long
  313. ' * 
  314. ' * 
  315. ' * Return Value: None
  316. ' * 
  317. ' * 
  318. ' * Description:
  319. ' *
  320. ' *        This subroutine uses the graphics handles
  321. ' *         stored in GraphicHandleArray() to 
  322. ' *         the handles for each graphic's vertices
  323. ' *         then store them in VertexHandleArray().
  324. ' *
  325. ' *
  326. Sub GetVertexHandles (    ByRef GraphicHandleArray() As Long, _ 
  327.                         ByRef VertexHandleArray() As Long )
  328.  
  329.     dim gCounter as long
  330.     dim vCounter as long
  331.     
  332.     for gCounter = 0 to (MAX_LINES - 1)
  333.     
  334.         for vCounter = 0 to MAX_VERTICES-1
  335.  
  336.             VertexHandleArray( gCounter, ( vCounter ) ) = _ 
  337.              TCWVertexAt ( GraphicHandleArray( gCounter ), vCounter )
  338.         next
  339.  
  340.     next
  341.  
  342. End Sub
  343. '
  344. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  345.  
  346.  
  347.  
  348.  
  349. ''SUBROUTINE: GetVertexCoordinates'''''''''''''''''''''''''''''
  350. '
  351. ' * Parameters: ByRef VertexHandleArray() As Long
  352. ' *                ByRef VertexCoordArray() As Double
  353. ' *
  354. ' * 
  355. ' * Return Value: None
  356. ' * 
  357. ' *
  358. ' * Description:
  359. ' *
  360. ' *        This subroutine takes the vertex handles
  361. ' *         stored in the VertexHandleArray to 
  362. ' *         retrieve the vertex coordinates for the
  363. ' *         two selected line graphics and store 
  364. ' *         then in VertexCoordArray().
  365. ' * 
  366. ' *
  367. Sub GetVertexCoordinates (    ByRef VertexHandleArray() As Long, _ 
  368.                             ByRef VertexCoordArray() As Double )
  369.  
  370.     dim gCounter as long
  371.     dim vCounter as long
  372.     dim cCounter as long
  373.  
  374.     for gCounter = 0 to MAX_LINES
  375.  
  376.         for vCounter = 0 to MAX_VERTICES
  377.  
  378.             for cCounter = 0 to MAX_COORDS
  379.  
  380.                 if cCounter = 0 then
  381.  
  382.                     VertexCoordArray(gCounter, vCounter, cCounter) _
  383.                                     = TCWGetX(VertexHandleArray(gCounter, vCounter))
  384.  
  385.                 end if
  386.  
  387.     
  388.                 if cCounter = 1 then
  389.  
  390.     
  391.                     VertexCoordArray(gCounter, vCounter, cCounter) _
  392.                                 = TCWGetY(VertexHandleArray(gCounter, vCounter))
  393.  
  394.  
  395.     
  396.                 end if
  397.  
  398.     
  399.             next
  400.  
  401.     
  402.         next
  403.  
  404.  
  405.     next
  406.  
  407. End Sub
  408. '
  409. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  410.  
  411.  
  412.  
  413.  
  414. ''SUBROUTINE: CalculateIntersectCoordinates''''''''''''''''''''
  415. '
  416. ' * Parameters: ByRef VCA() As Double - Vertex Coordinate Array
  417. ' *                ByRef PCA() As Double - Point Coordinate Array
  418. ' *
  419. ' * 
  420. ' * Return Value: None
  421. ' * 
  422. ' *
  423. ' * Description:
  424. ' *
  425. ' *        This subroutine takes the vertex coordinates
  426. ' *         that's been gathered from the selected line
  427. ' *         graphics and calculates the x and y values
  428. ' *         for the 'virtual' intersection of the two
  429. ' *         lines.  The resulting x and y values are
  430. ' *         then stored in PCA() (point coordinate array)
  431. ' *         for use in the point insertion subroutine.
  432. ' * 
  433. ' *
  434. ' * Note:
  435. ' *        
  436. ' *        When using the vertex coordinate array VCA()
  437. ' *         each value is indexed with a base of 0.  The
  438. ' *         first line graphic is 0, the second 1.  The
  439. ' *         first vertex is 0,0 and the second is 0,1.
  440. ' *         The vertex x/y gets a little more confusing:
  441. ' *         x of the first vertex of the first line would
  442. ' *         be 0,0,0 and y, 0,0,1.
  443. ' * 
  444. ' *
  445. Sub CalculateIntersectCoordinates ( ByRef VCA() As Double, _ 
  446.                                     ByRef PCA() As Double )
  447.  
  448.     Dim a11 As Double
  449.     Dim a12 As Double
  450.  
  451.     Dim b1     As Double
  452.     Dim b2    As Double
  453.  
  454.     Dim a21 As Double
  455.     Dim a22 As Double
  456.  
  457.     Dim x11 As Double
  458.     Dim x12 As Double
  459.  
  460.     Dim x21 As Double
  461.     Dim x22 As Double
  462.  
  463.     Dim y11    As Double
  464.     Dim y12 As Double
  465.  
  466.     Dim y21 As Double
  467.     Dim y22 As Double
  468.  
  469.     Dim x    As Double
  470.     Dim y    As Double
  471.     Dim d    As Double
  472.  
  473.  
  474.     x11 = VCA( 0, 0, 0 )
  475.     x12 = VCA( 0, 1, 0 )
  476.     x21 = VCA( 1, 0, 0 )
  477.     x22 = VCA( 1, 1, 0 )
  478.     y11 = VCA( 0, 0, 1 )
  479.     y12 = VCA( 0, 1, 1 )
  480.     y21 = VCA( 1, 0, 1 )
  481.     y22 = VCA( 1, 1, 1 )
  482.     a11    = ( y12 - y11 )
  483.     a12    = - ( x12 - x11 )
  484.     a21    = ( y22 - y21 )
  485.     a22    = - ( x22 - x21 )
  486.     b1    = ( ( y12 - y11 ) * x11 ) - ( ( x12 - x11 ) * y11 )
  487.     b2    = ( ( y22 - y21 ) * x21 ) - ( ( x22 - x21 ) * y21 )
  488.     d    = ( ( a11 * a22 ) - ( a21 * a12 ) )
  489.  
  490.     if d = 0 then
  491.         MsgBox "No virtual intersection possible!"
  492.         END
  493.     end if
  494.  
  495.     x = ( ( a22 * b1 ) - ( a12 * b2 ) ) / d
  496.     y = ( ( a11 * b2 ) - ( a21 * b1 ) ) / d
  497.  
  498.     PCA( 0 ) = x
  499.     PCA( 1 ) = y
  500.  
  501. End Sub
  502. '
  503. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  504.  
  505. ''SUBROUTINE: InsertPointObject''''''''''''''''''''''''''''''''
  506. '
  507. ' * Parameters:    ByRef PCA() As Double
  508. ' *                ByVal hDrawing As Long
  509. ' *
  510. ' * 
  511. ' * Return Value: None
  512. ' * 
  513. ' *
  514. ' * Description:
  515. ' *
  516. ' *        This subroutine uses the x and  y
  517. ' *         values stored in PCA() to insert
  518. ' *         a new point graphic at the 'virtual'
  519. ' *         intersection of the two selected
  520. ' *         line graphics.
  521. ' *
  522. ' *
  523. Sub InsertPointObject ( ByRef PCA() As Double, ByVal hDrawing As Long )
  524.  
  525.     Dim hParentGraphic    As Long
  526.     Dim hCircleGraphic    As Long
  527.     Dim hCrossGraphic    As Long    
  528.     Dim hVertex1        As Long
  529.     Dim hVertex2        As Long
  530.     Dim hVertex3        As Long
  531.     Dim hVertex4        As Long
  532.  
  533.  
  534.     hParentGraphic    = TCWGraphicCreate ( GK_GRAPHIC, "" )
  535.  
  536.         hTempGraphic = TCWCircleCenterAndPoint ( PCA#( 0 ),PCA#( 1 ),0#,    ( PCA#( 0 ) + .05#*measure ), _ 
  537.     ( PCA#( 1 ) + .05#*measure ),     0# )
  538.             hCircleGraphic = TCWGraphicCopy ( hTempGraphic )
  539.         TCWGraphicDispose hTempGraphic
  540.         TCWGraphicAppend hParentGraphic, hCircleGraphic
  541.         hCrossGraphic    = TCWGraphicCreate ( GK_GRAPHIC, "" )
  542.             hVertex1 = TCWVertexCreate ( PCA#( 0 ) - .15#*measure,    PCA#( 1 ),            0# )
  543.             hVertex2 = TCWVertexCreate ( PCA#( 0 ) + .15#*measure,    PCA#( 1 ),            0# )
  544.             hVertex3 = TCWVertexCreate ( PCA#( 0 ),PCA#( 1 ) - .15*measure,0# )
  545.             hVertex4 = TCWVertexCreate ( PCA#( 0 ),PCA#( 1 ) + .15*measure,0# )
  546.             TCWPenDown hVertex1, MY_FALSE
  547.             TCWPenDown hVertex2, MY_TRUE
  548.             TCWPenDown hVertex3, MY_FALSE
  549.             TCWPenDown hVertex4, MY_TRUE
  550.             TCWGraphicVertexAdd hCrossGraphic, hVertex1
  551.             TCWGraphicVertexAdd hCrossGraphic, hVertex2
  552.             TCWGraphicVertexAdd hCrossGraphic, hVertex3
  553.             TCWGraphicVertexAdd hCrossGraphic, hVertex4
  554.         TCWGraphicAppend hParentGraphic, hCrossGraphic
  555.                 TCWGraphicAppend 0, hParentGraphic
  556.     TCWGraphicDraw hParentGraphic, 0
  557.     TCWUndoRecordStart hDrawing, "Virtual Point"
  558.     TCWUndoRecordAddGraphic hDrawing, hParentGraphic
  559.     TCWUndoRecordEnd hDrawing
  560.  
  561. End Sub
  562. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  563.