×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Wind Rose

Wind Rose

Wind Rose

(OP)
Ever need a wind rose?  Here's a start:

'This routine inserts a new worksheet and draws a series of shapes to create
'a basic wind rose, which is a figure showing wind direction, frequency, and speed.

'Input data has the form:
'         1       4      6  ...
' 2   0.01%   0.01%   0.00% ...
' 5   0.20%   0.17%   0.19% ...
'10   0.51%   0.47%   0.48% ...
'Where line 1 is wind direction in degrees and column 1 is a list
'of wind speeds.  The data is percent of time wind blows from given
'direction.
'In C3 above, the wind blows at 2 - 5 mph from 22 degrees 0.17% of time.
'Selection must include the wind direction and wind speed

Sub Windrose()
'
   Dim color(2, 9) As Integer
   
   dirct = Selection.Columns.Count - 1
   SpdCt = Selection.Rows.Count - 1
   FRow = Selection.Row + 1
   FCol = Selection.Column + 1
   Pi = 3.1415926
   xsize = 600     'approx Max size in x and y
   xoff = 500      'offset from left
   yoff = 400      'offset from top
   
'------------------- set number of arrows
   arrowwidth = 30 'degrees
'---------------------------------------------
   
   'Wind speeds are indicated by colors but Excel color tables don't match
   'cells: 1 black, 2, white, 3 red, 4 green, 5 blue, 6 yellow, 7 purple, 8 lt blue
   '       9 dk red, 10 dk green
   color(1, 0) = 36   'cells
   color(1, 1) = 8
   color(1, 2) = 6
   color(1, 3) = 4
   color(1, 4) = 5
   color(1, 5) = 7
   color(1, 6) = 3
   'shapes: 1 white, 2 red, 3 green, 4 blue, 5 yellow, 6 purple, 7 lt blue, 8 black
   '        9 white, 10 red
   color(2, 0) = 43    'shapes
   color(2, 1) = 7
   color(2, 2) = 5
   color(2, 3) = 3
   color(2, 4) = 4
   color(2, 5) = 6
   color(2, 6) = 2
   
   'scan for min and max values
   mindir = 999
   maxdir = -999
   maxv = -999
   For c = FCol To FCol + dirct - 1
      If Cells(FRow - 1, c) < mindir Then mindir = Cells(FRow - 1, c)
      If Cells(FRow - 1, c) > maxdir Then maxdir = Cells(FRow - 1, c)
      For r = FRow To FRow + SpdCt - 1
         If Cells(r, c) > maxv Then maxv = Cells(r, c)
      Next
   Next
   
   'set plot scale
   xscale = xsize / maxv / 3
   't = 2 * 3.1415926 / DirCt / 1.25 'angular width of arrows
   t = (maxdir - mindir) * arrowwidth / 50000
   
   'draw on a new sheet (convenient for erasing)
   Set datasheet = ActiveSheet
   Sheets.Add after:=Sheets(Sheets.Count), Type:="Worksheet"
   Sheets(Sheets.Count).Name = "Rose"
   Set Rosesheet = Sheets(Sheets.Count)
   Rosesheet.Select
   
   'Draw wind rose
   If True Then     'a simple on/off switch for debugging
      maxarrow = -999  'for scale
      lastarrowdir = mindir - arrowwidth
      For c = FCol To FCol + dirct - 1
         lastv = 0        'for legend
         If datasheet.Cells(FRow - 1, c) > lastarrowdir + arrowwidth Then
            c = c - 1
            lastarrowdir = datasheet.Cells(FRow - 1, c)
            Debug.Print "   drawing "; lastarrowdir; "degrees"
            datasheet.Cells(FRow - 1, c).Font.ColorIndex = 3    '<======= mark which data is used
            a = datasheet.Cells(FRow - 1, c) * Pi / 180 - Pi / 2
            p = 0
            For r = FRow To FRow + SpdCt - 1
               p = p + datasheet.Cells(r, c)  'sum percentages if necessary
               If p > maxarrow Then maxarrow = p  'track the longest arrow to set scales later
               b = xscale * p
               w = b * t
               Debug.Print "   b & w = "; b; w
               With Cells(15 + r - FRow, 5) 'add increment to legend
                  .Formula = datasheet.Cells(r, FCol - 1)
                  .Interior.ColorIndex = color(1, r - FRow)
                  .HorizontalAlignment = xlCenter
                  .NumberFormat = """" & lastv & " - ""0"
                  lastv = Int(Cells(15 + r - FRow, 5))
               End With
               If b > 10 Then              'draw shape but function jams if b is too small
                  With ActiveSheet.Shapes.BuildFreeform(msoEditingCorner, xoff, yoff)
                     .AddNodes msoSegmentLine, msoEditingAuto, _
                        xoff + b * Cos(a) - w * Sin(a), yoff + b * Sin(a) + w * Cos(a)
                     .AddNodes msoSegmentLine, msoEditingAuto, _
                        xoff + b * Cos(a) + w * Sin(a), yoff + b * Sin(a) - w * Cos(a)
                     .AddNodes msoSegmentLine, msoEditingAuto, xoff, yoff
                     .ConvertToShape.Select
                     Selection.ShapeRange.ZOrder msoSendToBack
                     Selection.ShapeRange.Fill.ForeColor.SchemeColor = color(2, r - FRow)
                  End With
               End If
            Next
         Else
            'could accumlate values to cut out a spreadsheet step
         End If
      Next
   End If
    
   'draw scales
   b = maxarrow * xscale * 1.2
   c = 15
   d = 37.5
   ActiveSheet.Shapes.AddLine(xoff, yoff - b, xoff, yoff + b).Select
   ActiveSheet.Shapes.AddLine(xoff - b, yoff, xoff + b, yoff).Select
    
   'ActiveSheet.Shapes.AddLine(xoff, yoff - maxarrow * xscale / 2, xoff, yoff + maxarrow * xscale / 2).Select
   'ActiveSheet.Shapes.AddLine(xoff - maxarrow * xscale / 2, yoff, xoff + maxarrow * xscale / 2, yoff).Select
    
   ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, xoff - c, yoff - b - c, d, d).Select
   'ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, xoff - 10, yoff - a * xscale / 2 - 10, 37.5, 28.5).Select
   With Selection
      .ShapeRange.Line.Visible = msoFalse
      .Characters.Text = "N"
      .Font.Name = "Monotype Corsiva"
      .Font.FontStyle = "Bold"
      .Font.Size = 20
   End With
   ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, xoff + b - c, yoff - c, d, d).Select
   With Selection
      .ShapeRange.Line.Visible = msoFalse
      .Characters.Text = "E"
      .Font.Name = "Monotype Corsiva"
      .Font.FontStyle = "Bold"
      .Font.Size = 20
   End With
   ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, xoff - c, yoff + b - c, d, d).Select
    With Selection
      .ShapeRange.Line.Visible = msoFalse
      .Characters.Text = "S"
      .Font.Name = "Monotype Corsiva"
      .Font.FontStyle = "Bold"
      .Font.Size = 20
    End With
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, xoff - b - c, yoff - c, d, d).Select
    With Selection
      .ShapeRange.Line.Visible = msoFalse
      .Characters.Text = "W"
      .Font.Name = "Monotype Corsiva"
      .Font.FontStyle = "Bold"
      .Font.Size = 20
    End With

   c = 12      'text size
   For a = 1 To 8
      b = a * xscale / 40
      If xoff - b > xoff - (maxarrow * xscale) Then
         ActiveSheet.Shapes.AddShape(msoShapeOval, xoff - b, yoff - b, 2 * b, 2 * b).Select
         Selection.ShapeRange.Fill.Visible = msoFalse
         Selection.ShapeRange.Line.Weight = 1.5
         Selection.ShapeRange.Line.DashStyle = msoLineRoundDot
         ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
               xoff - (b / 1.41) - c, yoff - (b / 1.41) - c, 3 * c, 2 * c).Select
         With Selection
           .ShapeRange.Line.Visible = msoFalse
           .ShapeRange.Fill.Visible = msoFalse
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Characters.Text = Format(a * xscale / 600, "0.0")
           .Font.Name = "arial"
           .Font.FontStyle = "Bold"
           .Font.Size = c
         End With
      End If
    Next
    
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Group.Select
End Sub

RE: Wind Rose

This looks interesting.  I have two questions:

1.  Where do we get the data to insert into the program to create the Wind Rose?

2.  Are there Wind Roses available for specific sites like airports and how would we get copies of them?

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login


Resources

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a part’s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. Download Now

Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close