home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F40779_modCloud.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  3.6 KB  |  118 lines
  1. Attribute VB_Name = "modCloud"
  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. ' Converts a selected polyline into a "cloud"
  13. Public Sub Cloud()
  14.  
  15.     Dim ActDr As Drawing
  16.     Dim Grs As Graphics
  17.     Dim GrPolygon As Graphic, GrCloud As Graphic
  18.     Dim Vers As Vertices
  19.     Dim Ver As Vertex, Ver1 As Vertex, Ver2 As Vertex
  20.     Dim x As Double, y As Double, a As Double, alpha As Double, beta As Double, Pi As Double
  21.  
  22.     Set ActDr = IMSIGX.Application.ActiveDrawing
  23.     
  24.     If ActDr.Selection.Count = 0 Then
  25.         Beep
  26.         MsgBox "Please select a polyline to convert"
  27.     Else
  28.         Set GrPolygon = ActDr.Selection.Item(0)
  29.         ' convert the segments into double arcs
  30.         Set Vers = GrPolygon.Vertices
  31.         n = Vers.Count
  32.         
  33.         ' find out the direction
  34.         Area = PolyArea(GrPolygon)
  35.         Direction = Sgn(Area)
  36.         
  37.         Set GrCloud = ActDr.Graphics.Add(imsiGroup)  ' will be a group
  38.         
  39.         For i = 1 To n - 1
  40.         
  41.             Set Ver1 = Vers.Item(i - 1)
  42.             Set Ver2 = Vers.Item(i)
  43.             
  44.             Pi = (Atn(1) * 4)
  45.             a = Atn2(Ver2.y - Ver1.y, Ver2.x - Ver1.x)
  46.             If Direction > 0 Then
  47.                 alpha = Pi + a
  48.                 beta = 2 * Pi + a
  49.             Else
  50.                 alpha = a
  51.                 beta = Pi + a
  52.             End If
  53.             ' add another vertex 2/3 from the first
  54.             x = (Ver1.x + Ver2.x * 2) / 3
  55.             y = (Ver1.y + Ver2.y * 2) / 3
  56.             
  57.             Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((Ver1.x + x) / 2, (Ver1.y + y) / 2, 0, x, y, 0, alpha, beta)
  58.             Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((x + Ver2.x) / 2, (y + Ver2.y) / 2, 0, Ver2.x, Ver2.y, 0, alpha, beta)
  59.         
  60.         Next i
  61.         
  62.         GrPolygon.Unselect
  63.         GrPolygon.Delete
  64.         GrCloud.Select
  65.     
  66.     End If
  67.  
  68. End Sub
  69.  
  70. Function Atn2(dy As Double, dx As Double) As Double
  71.  
  72.     Dim Pi As Double
  73.  
  74.     Pi = (Atn(1) * 4)
  75.     If dx <> 0 Then
  76.         If dx > 0 Then
  77.             retval# = Atn(dy / dx)
  78.         Else
  79.             retval# = Atn(dy / dx) + Pi
  80.         End If
  81.     Else
  82.         retval# = Pi / 2 * Sgn(dy)
  83.     End If
  84.     Atn2 = retval#
  85.  
  86. End Function
  87.  
  88. Function PolyArea(Gr As Graphic) As Double
  89.  
  90.     Dim i As Integer
  91.     Dim Vers As Vertices
  92.     Dim Ver1 As Vertex, Ver2 As Vertex
  93.     Dim Area As Double
  94.     Area = 0
  95.     Set Vers = Gr.Vertices
  96.     ' for all vertices, find the area (using cross product)
  97.     For i = 0 To Vers.Count - 2
  98.         Set Ver1 = Vers.Item(i)
  99.         Set Ver2 = Vers.Item(i + 1)
  100.         '  i  j  k
  101.         '  x1 y1 z1
  102.         '  x2 y2 z2
  103.         ' area = half the length of the cross product
  104.         x1 = Ver1.x
  105.         y1 = Ver1.y
  106.         z1 = Ver1.Z
  107.         x2 = Ver2.x
  108.         y2 = Ver2.y
  109.         z2 = Ver2.Z
  110.         xx = y1 * z2 - y2 * z1
  111.         yy = x1 * z2 - x2 * z1
  112.         zz = x1 * y2 - x2 * y1
  113.         Area = Area + Sqr(xx * xx + yy * yy + zz * zz) * Sgn(zz)
  114.     Next i
  115.     PolyArea = Area
  116.  
  117. End Function
  118.