Generating a complex msoffice shape from data points in excel? 3

[navyguy]

Hello again.

I was wondering if anybody knew how to generate msoffice shape based on x,y positions stored in visual basic or in an excel sheet.

For example, an "L" shaped geometry may have x,y points of

x y
1 1
1 4
2 4
2 2
4 2
4 1
1 1

If this were graphed in excel using xyplot you would see an "L" shaped geometry.

So here is the trick I am looking for. How can I use those points to generate a shape showing the same geometry.

I know that while in excel I can use the drawing tool and use a freeform line to click several points to create a shape.

I would really like to create a shape based on x and y values stored in an array in VB code run as a macro.

Any ideas?????

 

[sfvb]

I think there is a number of ways to do it. The example I'm using assumes that the spreadsheet is setup like this:

Sub DrawCoordinates()
   Dim multiplier    As Single
   Dim x_offset      As Single
   Dim y_offset      As Single
   Dim x_position    As Single
   Dim y_position    As Single
   
   multiplier = 10
   x_offset = 150
   y_offset = 80
   
   x_position = Range("A2").Value * multiplier + x_offset
   y_position = -Range("B2").Value * multiplier + y_offset
   
   With Sheet1.Shapes.BuildFreeform(msoEditingAuto, x_position, y_position)
      For idx = 3 To Range("A2").End(xlDown).Row
         x_position = Range("A" & idx).Value * multiplier + x_offset
         y_position = -Range("B" & idx).Value * multiplier + y_offset
         
         .AddNodes msoSegmentLine, msoEditingAuto, x_position, y_position
      Next
      .ConvertToShape.Select
   End With
End Sub

 

[sfvb]

I accidently hit the submit button before I was ready. Let me start again:


I think there are a number of ways to do it. The example I'm using assumes that the spreadsheet is setup like this:

In that case the code in my previous post should work.

Note: You'll notice I reversed the sign of the Y points. (Excel uses Quadrant IV of the graph system, except in gives positive Y values to what would ordinary be negative values)

Also, I broke the code out for readability. So the code could be made more efficient, but when giving an example I think readability is more important. You can always change the code as you see fit.

 

[navyguy]

This is awsome. I tried it on a complex shape with 300 points and it worked great. Much Thanks.

 

[mscallisto]

I agree that's awesome but I have 2 questions.

Is there a way to intrepet the xy's to visually see what it represents? I tried to plot it in a normal grid and can no way get an L shape yet the script certainly produces one.

How do the xy's work here and how would one determine the xy's to produce an H etc.


My second question for SFVB is how did you post the spreadsheet example?

 

[mscallisto]

Forget the first question....I see you started from the bottom left of the L.

 

[sfvb]

Answer to 1st question:
I see you already have the answer to your first question, but I'll post the answer in case anyone else finds it useful.

If you took a normal piece of graph paper and put an X and a Y line on it, then you would:
Draw a point at the 1st x,y coordinate (1,1 in navyguy's example).
Then you would create a point at the next x,y coordinate (1,4 in the example) and draw a line from the previous point (1,1) to the point you just entered (1,4).
Next, you would create a point at the next x,y coordinate (2,4 in the example) and draw a line from the previous point (1,4) to the point you just entered (2,4).
You would continue doing this until there were no more points to draw.

So to draw an H, you could use the following coordinates:

X  Y
1  1
1  6
2  6
2  4
4  4
4  6
5  6
5  1
4  1
4  3
2  3
2  1
1  1

Note: You'll notice there are 3 variables multiplier, x_offset, and y_offset that are assigned a value before the main code starts. The x_offset and y_offset adjust where the image is displayed. The multiplier determines how large the image is.


Answer to 2nd question:
I have a website, so I just FTP the image to the site and make a reference to it when I post an answer on the Tek-Tips forum. For example, the image you see in this post is located at:

http://www.threadbender.com/tek-tips/screenshot_07.jpg

To get the image to show on this forum I just type:

[img]http://www.threadbender.com/tek-tips/screenshot_07.jpg[/img]

(You need to include the beginning and ending brackets.)

 

[navyguy]

Hey, this is Navy Guy again. This is fantastic stuff. I have two more questions. The values for offset - what units are they. If I want the object to be 3 inches from the top and 4 inches from the left, how does that translate to the offset values.

The other question stems from me trying the code on another computer. I got errors. After experimenting around it seems to be that when the distance between two points were within .2 units of each other I get an error when converting to shape. Perhaps VB doesn't allow two consecutive points with the same location. Maybe two points that are close to one another gets "snap to grid" or something making then be entered as the same point.

I am curious as to what may be happening and why on my computer at work there seems to be no problem and my computer at home I have these errors.

Any ideas????

 

[mscallisto]

Thank you very much.... excellent explanations!!

 

[sfvb]

Navyguy,

I didn't really know the answer to what the units correlate to, so I played around a bit and here's what I came up with:

The units used by X and Y coordinates are dependent on the screen resolution. One X or Y unit is .75 pixels (which makes sense since most CRT's have an aspect ratio of 4:3. (Yeah I know 4:3 is 1.333:1, look at it backwards 3:4 or .75:1) So, if your screen resolution is 1024 x 768, you could theoretically draw an image that was 768 x 576. I say theoretically, because you have a Title bar and a Menu at the top of the screen, (plus you probably have at least one Toolbar), then you have the Row display on the left, the Scrollbar on the right, and the Status bar at the bottom. All of these decrease from your usable image space.

I played around with the code until I got the same error you did involving distance. You said you got the error at a distance of .2. If you used the example code I posted, the multiplier used by the code is 10, so that would make it a distance of 2.
2 * .75 = 1.5. If you've played around with Excel enough, you've probably noticed that mixing an integer with a single, will often display incorrect results. For example 2 * .75 may display 1.499999999999 or it may display 1.5, or it may display 1.500000000001.

Excel Help says that the X and Y coordinates passed to the BuildFreeform Method take a single, but I suspect it really expects a long or an integer (or rounds it off to a long or an integer internally), therefore the 2 * .75 may be interpreted as 1 or 2. If it is interpreted as a 1, it seems to generate an error, if it interprets it as a 2, it seems to have no problem.

If this is indeed the problem, then it could be how Excel interprets the data, or it could be a difference in
graphics drivers. Either way, the safe bet seems to be to make sure that either the (X or Y value * .75 * the multiplier) is greater than or equal 2.

I'm not sure this helped you, but it was all that I was able to come up with.

Steve

 

[davefish]

Iv'e tried this code and agree it's very useful, but as always there's one more question. Mine is, how would this technique handle circles and would you be able to group the objects when created?

Hope you haven't been asked this question

Regards

DaveFish

 

[sfvb]

I can explain the how the circles would work, and yes you can group the items, but I'm on the road right now and won't have time to explain till I get home. Hopefully, Sat afternoon, if not then sometime Sun. If you don't have an answer by then, I'll post an answer.

Steve

 

[davefish]

Thanks Steve, I look forwrad to it.

Dave

 

[sfvb]

Dave,

I realized once I started that I'll need an idea of what your trying to accomplish. There are just too many ways to accomplish the drawing of lines and circles. The more concrete the idea, the better I'll be able to code and explain an answer.

In the meantime, here's an example of drawing a circle, and grouping objects. The sample is based on this:

Sub RollBall()
   Dim Ball             As Object
   Dim BallFloor        As Single
   Dim Diameter         As Single
   Dim Radius           As Single
   Dim xCenter          As Single
   Dim yCenter          As Single
   Dim xOffset          As Single
   Dim yOffset          As Single
   
   Dim yDownBeg         As Single
   Dim yDownEnd         As Single
   Dim xAcrossBeg       As Single
   Dim xAcrossEnd       As Single
   
   Dim xArcTopOffset    As Single
   Dim xArcTopRight     As Single
   Dim xArcTopLeft      As Single
   Dim yArcTop          As Single
   Dim ArcWidth         As Single
   Dim ArcHeight        As Single
   
   Dim currShapeCount   As Integer
   Dim distPerDegree    As Single
   Dim idx              As Integer
   
   Dim PauseTime        As Single
   Dim StartTime        As Single
   
   Const PI             As Double = 3.14159265358979
   Const degrees60      As Double = PI / 180 * 60     'use 60 degrees

'------------------------------------------------

   With ActiveSheet
      'eliminate the gridlines
      .Cells.Interior.ColorIndex = 2
      .Cells.Interior.Pattern = xlSolid

'get the diameter and make sure it's between 40 and 170 inclusive

      Diameter = .Range("B1").Value
      If Diameter < 40 Then
         Diameter = 40
      ElseIf Diameter > 170 Then
         Diameter = 170
      End If
      
      BallFloor = 240
      xOffset = 10
      yOffset = BallFloor - Diameter

'calculate the radius and origin of the ball

      Radius = Diameter / 2
      xCenter = xOffset + Radius
      yCenter = yOffset + Radius
      
      With .Shapes

'add a floor for the ball to roll across

         .AddLine(xOffset, BallFloor, xOffset + 700, BallFloor).Select

'add the ball

         .AddShape(msoShapeOval, xOffset, yOffset, Diameter, Diameter).Select

'add the line going down the ball

         yDownBeg = yCenter - Radius
         yDownEnd = yCenter + Radius
         .AddLine(xCenter, yDownBeg, xCenter, yDownEnd).Select

'add the line going across the ball

         xAcrossBeg = xCenter - Radius
         xAcrossEnd = xCenter + Radius
         .AddLine(xAcrossBeg, yCenter, xAcrossEnd, yCenter).Select

'calculate the width and height for the arcs

         ArcWidth = Diameter / 11

'11 was arbitrary choice

         ArcHeight = Sin(degrees60) * Radius

'60 degrees was an arbitrary choice

'calculate the left and right x points for the top of the two arcs

         xArcTopOffset = Cos(degrees60) * Radius
         xArcTopRight = xCenter + xArcTopOffset - ArcWidth
         xArcTopLeft = xCenter - xArcTopOffset

'calculate the y point of the top of the arcs

         yArcTop = yCenter - ArcHeight

'add the arc on the left side of the ball

         .AddShape(msoShapeArc, xArcTopLeft, yArcTop, ArcWidth, ArcHeight).Select
         Selection.ShapeRange.Adjustments.Item(2) = 270

'add the arc on the right side of the ball

         .AddShape(msoShapeArc, xArcTopRight, yArcTop, ArcWidth, ArcHeight).Select
         Selection.ShapeRange.Adjustments.Item(2) = 270
         Selection.ShapeRange.Flip msoFlipHorizontal

'group the last 5 shapes and assign the group to the Ball object

         currShapeCount = .Count
         Set Ball = .Range(Array(currShapeCount - 0, _
                                 currShapeCount - 1, _
                                 currShapeCount - 2, _
                                 currShapeCount - 3, _
                                 currShapeCount - 4)).Group
      End With

'get the PauseTime, divide it by 1000
      'and make sure the result is between 0 and .05 inclusive

      PauseTime = .Range("B2").Value / 1000
      If PauseTime < 0 Then
         PauseTime = 0
      ElseIf PauseTime > 0.05 Then
         PauseTime = 0.05
      End If

'pause for 1 second

     StartTime = Timer
     Do While Timer < StartTime + 1
        DoEvents
     Loop

'simulate the ball rolling across a floor

      distPerDegree = Diameter * PI / 360
      For idx = 1 To 360

'rotate the ball one degree from its last position,
         'then move the ball an amount equivalent to a 1 degree rotation

         Ball.Rotation = idx
         Ball.Left = xOffset + distPerDegree * idx

'pause for a while

         StartTime = Timer
         DoEvents
         Do While Timer < StartTime + PauseTime
            DoEvents
         Loop
      Next

'pause for 1 second

     StartTime = Timer
     Do While Timer < StartTime + 1
        DoEvents
     Loop

'delete the ball

     .Shapes(.Shapes.Count).Delete

'delete the floor

     .Shapes(.Shapes.Count).Delete
   End With
End Sub

Steve

 

[davefish]

Steve,

Thanks for the guide. I see how you've constructed the ball etc and this leads me to believe I have a very complex requirement. I'm attempting to programmatically draw a simple power circuit which incorporates various shapes, some of which are circles. I decided not to import GIF's as I had to specify a cell location initially, then provide an offset TOP & LEFT to place them correctly. The net result was very jittery on initiation. If there's some way of importing a GIF to a sepcifc X,Y Coordinate on a sheet then this will surffice, and I'd love to know how. If not, I'll adopt your methodology in creating the circles etc.

Regards

Dave

 

[sfvb]

Here's an example of loading a gif and placing it an a specific x,y coordinate.

Sub ShowGif()
   Dim gifPath    As String
   Dim xGif       As Single
   Dim yGif       As Single
   
   gifPath = "C:\PowerCkt\deltaY.gif"
   xGif = 150
   yGif = 100
   
   ActiveSheet.Pictures.Insert(gifPath).Select
   Selection.ShapeRange.Left = xGif
   Selection.ShapeRange.Top = yGif
End Sub

 

[davefish]

Fantastic!

Steve,

Thanks for your help.


Dave

 

[davefish]

Steve,

Sorry to be a pain, but the intitial position of the GIF is dependant upon the cell that has focus on the sheet. Is there a way to turn off the cell focus, or disacossiate the Gif from the cell position?

Dave

 

[sfvb]

Dave,

I ran the macro with the active cell at IV65536, and with the active cell at A1. It was in the same position both times.

Set xGif, and yGif to 0, and run the macro. The upper left corner of the image should be in cell A1, regardless of which cell your in when you run the macro.

Steve