home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F41007_modEditCircle.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  3.1 KB  |  77 lines

  1. Attribute VB_Name = "modEditCircle"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12.  
  13. 'Before start this script it is necessary to create some objects and to select a part from them
  14.  
  15.  
  16. Public Sub CircleEdit()
  17. ' Edits coordinates of the centre and radius of a selected circle
  18. Dim App As Application
  19. Dim ActDr As Drawing
  20. Dim Grs As Graphics
  21. Dim Gr As Graphic
  22. Dim Vers As Vertices
  23. Dim Ver As Vertex
  24. Dim ObjSel As Selection
  25. Dim NumSel As Long, i As Long
  26. Dim GrSelType As String
  27.  
  28.     Set App = IMSIGX.Application    'Returns base application - TurboCAD
  29.     Set ActDr = App.ActiveDrawing   'Returns Active Drawing
  30.     Set ObjSel = ActDr.Selection    'Returns Selected objects as Selection collection
  31.     NumSel = ObjSel.Count   'Returns the number of items in the collection.
  32.  
  33.  
  34.     If NumSel = 0 Then
  35.         MsgBox ("No circle was selected.Please select the circle and try again")
  36.         Exit Sub
  37.     End If
  38.     For i = 0 To NumSel - 1
  39.         Set Gr = ObjSel.Item(i) 'Returns part of a collection - graphic in the selection collection
  40.         GrSelType = Gr.Type
  41.         If GrSelType = "CIRCLE" Then
  42.             Set Vers = Gr.Vertices ' Return the Vertices collection for current graphic - Circle
  43.             Set Ver = Vers.Item(0) ' This Vertex is the center of the circle
  44. Dim XcOld#, YcOld# ' coordinates of the center of the circle
  45. Dim Xr#, Yr# ' coordinates the point on the circle
  46. Dim ROld#
  47.             XcOld = Ver.X
  48.             YcOld = Ver.Y
  49.             Set Ver = Vers.Item(1) 'This Vertex lies on the circle
  50.             Xr = Ver.X
  51.             Yr = Ver.Y
  52.             ROld = Sqr((Xr - XcOld) * (Xr - XcOld) + (Yr - YcOld) * (Yr - YcOld))
  53.             frmEditCircle.TextBox1.Text = CStr(XcOld)
  54.             frmEditCircle.TextBox2.Text = CStr(YcOld)
  55.             frmEditCircle.TextBox3.Text = CStr(ROld)
  56.             frmEditCircle.Show
  57.             Gr.Unselect
  58.  
  59. Dim XcNew#, YcNew#
  60. Dim RNew#
  61.             XcNew = CDbl(frmEditCircle.TextBox1.Text)
  62.             YcNew = CDbl(frmEditCircle.TextBox2.Text)
  63.             RNew = CDbl(frmEditCircle.TextBox3.Text)
  64. Dim Matr As Matrix ' A transformation matrix
  65. Dim xScale#, yScale#
  66. Dim dx#, dy#
  67.             xScale = RNew / ROld
  68.             yScale = RNew / ROld
  69.             dx = XcNew - XcOld
  70.             dy = YcNew - YcOld
  71.             Set Matr = Gr.Scale(xScale, yScale, 1)  'Scales the Graphic object.
  72.             Set Matr = Gr.MoveRelative(dx, dy, 0)   'Moves the Graphic object by a specified offset
  73.         End If
  74.     Next i
  75.     ActDr.Views(0).Refresh
  76. End Sub
  77.