creating parallel arches

hascons · May 1st 2011

I've been trying to create parallel arches (similar to railroad tracks around a bend). Its very easy to create the outer arch with

Code

Public Sub CreateQuarterCircle(Xpt As Double, Ypt As Double, w As Double, h As Double, Dir As String, Optional nm As String)
Dim ws As Worksheet, sh As sHape, rt As Integer


If Dir = "Left" Then
    Xpt = Xpt + w
    rt = -90
Else
    rt = 0
End If


Set ws = Sheets("worksheet")
    ws.Shapes.AddShape(msoShapeArc, Xpt, Ypt, w, h).Name = nm
Set sh = ws.Shapes(nm)
    With sh
        .Fill.Visible = False
        .Line.Weight = 1
        .Rotation = rt
        
    End With
    
End Sub

Display More

My problem is creating the inner arch to run parallel with the outer arch. I've tried increasing the y point by the (arch Spacing) as well as reducing the xpoint by the same as well as subtracting the (arch spacing) from the width and height. I can't seem to get the arches to run parallel. They always get wider or shorter at the top or bottom.

Anyone have any ideas why. I must just not be getting how the syntax works for these shape types. Or where the arch is actually originating from. I assume that the arch is created by using 1/4 of a complete circle, but even reducing the width and height doesn't get the arches to run parallel.

Herbds7 · May 2nd 2011

Re: creating parallel arches

Excel 2010 Shapes
Quarter Circles
http://www.mediafire.com/file/78urk3m7enyoncg/05_01_11.xlsm

PJ_in_FL · May 2nd 2011

Re: creating parallel arches

Here's two sets I created that are parallel. I verified by zooming up the magnification to get a better view. Note the way Top and Left have to adjust to keep the center the same when the width and height change. The adjustment is different for "Left" arches than for other arches.

Code

Sub CreateArches()
'CreateQuarterCircle Left, Top, Width, Height, Dir, Name
'Left arches
CreateQuarterCircle 100, 100, 80, 100, "Left", "A Outer"
CreateQuarterCircle 110, 110, 70, 90, "Left", "A Inner"
'Right arches
CreateQuarterCircle 100, 300, 100, 100, "", "B Outer"
CreateQuarterCircle 100, 310, 90, 90, "", "B Inner"
End Sub


Public Sub CheckShapes()
Dim ws As Worksheet, sh As Shape, rt As Integer
Dim iRow As Integer, iCol As Integer


Set ws = ActiveSheet    ' Sheets("worksheet")


iCol = 1
iRow = 1


For Each sh In ws.Shapes
    Cells(iRow, iCol).Value = sh.Name
    Cells(iRow + 1, iCol).Value = sh.left
    Cells(iRow + 2, iCol).Value = sh.top
    Cells(iRow + 3, iCol).Value = sh.Width
    Cells(iRow + 4, iCol).Value = sh.Height
    iCol = iCol + 1
Next


End Sub

Display More

hascons · May 2nd 2011

Re: creating parallel arches

Thanks Guys for your your Help!

The people at this site really are Experts!!!!

Herbds7 Your example sheet is a perfect example of what i'm trying to do.

creating parallel arches

Participate now!

Share