Drawing a 4-bar linkage diagram?

[emmcee]

Hey guys, I'm trying to draw this 4 bar-linkage diagram in this link: http://s1113.photobucket.com/albums/k511/Emmcee1/?action=view&current=Untitled.jpg

This is the outline that I want from it:
' Create a new bar between (x1,y1) and (x2,y2) with a coupling at either end.
' Specify bar and coupling colours using Long constants or RGB(...) calls.
' You must save the result in a Shape variable if you want to move it later.

Function NewBar(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, _ ByVal lngBarColour As Long, ByVal lngCouplingColour As Long) As Shape

End Function


Somehow I tried doing this, but it wouldn't work like nothing pops up in the drawing when I click run. This is what i coded:

Option Explicit

'
' Main subprogram is DrawFigure
' The first part (adding a sheet and removing grid and margin labels) is done for you
' The rest requires you to pick up parameters from named cells,
' to draw 4-bar linkage at specified location, and
' apply fills according to the parameter sheet.

' Cell names. Use wksParams.Range(NAME_CX) etc to obtain cell contents.

Const NAME_CX = "CentreX"
Const NAME_CY = "CentreY"

Sub DrawFigure()
' Local variables
Dim wksParams As Worksheet
Dim shp As Shape
Dim cx As Single, cy As Single

' Identify parameters sheet. Use wksParams.Range(...) rather than ActiveSheet
Set wksParams = Sheets("FigParams")

' Create new clean sheet, this becomes the active sheet
Sheets.Add

With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With

' Obtain positional parameters from the active sheet

cx = wksParams.Range(NAME_CX).Value
cy = wksParams.Range(NAME_CY).Value

End Sub

Function Aline(x As Single, y As Single) As Shape

Set Aline = ActiveSheet.Shapes.AddShape(msoShapeline… x, y)

End Function

Can anyone help me with another code that might work with this figure?

 

[bertie]

Excel can probably do this but you will have to code in the physics (mechanics) of each line's interaction with the other lines. And it has been a while since I cared what hit Isaac Newton on the head.

To code the physics you will need to take into account the change in the connecting angles between the lines that result by changing the position of one line. And determine what effect that has on the other angles and lines.

Here is a crude Macro Recorder solution. It is not precise, nor even pretty. The generated code indicates some kind of iteration, i.e., a loop.

[COLOR=darkblue]Sub[/COLOR] DrawShape()
  [COLOR=green]'lines[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] linetop [COLOR=darkblue]As[/COLOR] Shape
  [COLOR=darkblue]Dim[/COLOR] lineright [COLOR=darkblue]As[/COLOR] Shape
  [COLOR=darkblue]Dim[/COLOR] lineBottom [COLOR=darkblue]As[/COLOR] Shape
  [COLOR=darkblue]Dim[/COLOR] lineleft [COLOR=darkblue]As[/COLOR] Shape
  [COLOR=green]'couplings[/COLOR]
  'Dim coupTopRight As Shape
  [COLOR=green]'Dim coupBottomRight As Shape[/COLOR]
  [COLOR=green]'Dim coupBottomLeft As Shape[/COLOR]
  [COLOR=green]'Dim coupTopLeft As Shape[/COLOR]
 
  [COLOR=green]'draw lines[/COLOR]
  [COLOR=darkblue]Set[/COLOR] linetop = NewBar(100, 50, 250, 40, 18, 0, 1)      'maroon line
  [COLOR=darkblue]Set[/COLOR] lineright = NewBar(250, 40, 280, 150, 11, 0, 1)   [COLOR=green]'dark blue[/COLOR]
  [COLOR=darkblue]Set[/COLOR] lineBottom = NewBar(280, 150, 90, 150, 16, 0, 1)  'dark grey
  [COLOR=darkblue]Set[/COLOR] lineleft = NewBar(90, 150, 100, 50, 10, 0, 1)     [COLOR=green]'dark green[/COLOR]
 
  [COLOR=green]'draw couplings[/COLOR]
  [COLOR=green]'Set coupTopRight = NewBar(244.5, 35.25, 8.25, 9#, 0, 16, 2)[/COLOR]
  [COLOR=green]'Set coupBottomRight = NewBar(294.75, 145.5, 8.25, 9#, 0, 16, 2)[/COLOR]
  [COLOR=green]'Set coupBottomLeft = NewBar(86.25, 144.75, 9#, 9#, 0, 16, 2)[/COLOR]
  [COLOR=green]'Set coupTopLeft = NewBar(94.5, 45.75, 9#, 9.75, 0, 16, 2)[/COLOR]
 
  [COLOR=green]'group the shape[/COLOR]
  [COLOR=green]'Sheets("Sheet1").Shapes.SelectAll[/COLOR]
  [COLOR=green]'Selection.ShapeRange.Group.Select[/COLOR]
  [COLOR=green]'Selection.Name = "Bertie"[/COLOR]
 
   Macro6 lineleft, linetop, lineright
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Pause()
  [COLOR=darkblue]Dim[/COLOR] start [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Single[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] t [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Single[/COLOR]
 
  t = 0.15
  start = Timer
  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] Timer < start + t
    DoEvents
  [COLOR=darkblue]Loop[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Sub[/COLOR] Macro6([COLOR=darkblue]ByRef[/COLOR] lineleft [COLOR=darkblue]As[/COLOR] Shape, _
          [COLOR=darkblue]ByRef[/COLOR] linetop [COLOR=darkblue]As[/COLOR] Shape, _
          [COLOR=darkblue]ByRef[/COLOR] lineright [COLOR=darkblue]As[/COLOR] Shape)
[COLOR=green]'[/COLOR]
 
  lineleft.Name = "Line 43"
  linetop.Name = "Line 40"
  lineright.Name = "Line 41"
 
[COLOR=green]'[/COLOR]
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 90#
    Selection.ShapeRange.Item("Line 43").Width = 27.75
    Selection.ShapeRange.Item("Line 43").Top = 58.5
    Selection.ShapeRange.Item("Line 43").Height = 91.5
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft 17.25
    Selection.ShapeRange.IncrementTop 7.5
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.IncrementLeft 16.5
    Selection.ShapeRange.IncrementTop 7.5
    Selection.ShapeRange.Item("Line 41").Left = 266.25
    Selection.ShapeRange.Item("Line 41").Width = 14.25
    Selection.ShapeRange.Item("Line 41").Top = 47.25
    Selection.ShapeRange.Item("Line 41").Height = 102.75
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 90#
    Selection.ShapeRange.Item("Line 43").Width = 54#
    Selection.ShapeRange.Item("Line 43").Top = 79.5
    Selection.ShapeRange.Item("Line 43").Height = 70.5
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft 29.25
    Selection.ShapeRange.IncrementTop 21#
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 15#
    Selection.ShapeRange.Item("Line 41").Top = 68.25
    Selection.ShapeRange.Item("Line 41").Height = 81.75
    Pause
 
    Selection.ShapeRange.Flip msoFlipHorizontal
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 90#
    Selection.ShapeRange.Item("Line 43").Width = 81#
    Selection.ShapeRange.Item("Line 43").Top = 98.25
    Selection.ShapeRange.Item("Line 43").Height = 51.75
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft 26.25
    Selection.ShapeRange.IncrementTop 21#
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 40.5
    Selection.ShapeRange.Item("Line 41").Top = 90#
    Selection.ShapeRange.Item("Line 41").Height = 60#
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 90#
    Selection.ShapeRange.Item("Line 43").Width = 105#
    Selection.ShapeRange.Item("Line 43").Top = 128.25
    Selection.ShapeRange.Item("Line 43").Height = 21.75
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft 21#
    Selection.ShapeRange.IncrementTop 28.5
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 61.5
    Selection.ShapeRange.Item("Line 41").Top = 120#
    Selection.ShapeRange.Item("Line 41").Height = 30#
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 90#
    Selection.ShapeRange.Item("Line 43").Width = 109.5
    Selection.ShapeRange.Item("Line 43").Top = 141.75
    Selection.ShapeRange.Item("Line 43").Height = 8.25
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft 3#
    Selection.ShapeRange.IncrementTop 14.25
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 64.5
    Selection.ShapeRange.Item("Line 41").Top = 134.25
    Selection.ShapeRange.Item("Line 41").Height = 15.75
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.Item("Line 43").Left = 89.25
    Selection.ShapeRange.Item("Line 43").Width = 105#
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 17.25
    Pause
 
    Selection.ShapeRange.Flip msoFlipVertical
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementTop 1.5
    Selection.ShapeRange.Item("Line 40").Left = 191.25
    Selection.ShapeRange.Item("Line 40").Width = 154.5
    Selection.ShapeRange.Item("Line 40").Top = 133.5
    Selection.ShapeRange.Item("Line 40").Height = 35.25
    Pause
 
    Selection.ShapeRange.Item("Line 40").Top = 154.5
    Selection.ShapeRange.Item("Line 40").Height = 14.25
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 62.25
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 4.5
    Pause
 
    Selection.ShapeRange.Flip msoFlipVertical
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 89.25
    Selection.ShapeRange.Item("Line 43").Width = 81#
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 40.5
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -21#
    Selection.ShapeRange.IncrementTop 23.25
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 280.5
    Selection.ShapeRange.Item("Line 41").Width = 42#
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 30.75
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 89.25
    Selection.ShapeRange.Item("Line 43").Width = 36#
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 72#
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -45#
    Selection.ShapeRange.IncrementTop 27.75
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 279.75
    Selection.ShapeRange.Item("Line 41").Width = 0.75
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 56.25
    Pause
 
    Selection.ShapeRange.Flip msoFlipHorizontal
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 81#
    Selection.ShapeRange.Item("Line 43").Width = 8.25
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 81#
    Pause
 
    Selection.ShapeRange.Flip msoFlipHorizontal
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -47.25
    Selection.ShapeRange.IncrementTop 11.25
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 231#
    Selection.ShapeRange.Item("Line 41").Width = 49.5
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 69.75
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 47.25
    Selection.ShapeRange.Item("Line 43").Width = 42#
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 48.75
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -31.5
    Selection.ShapeRange.IncrementTop -32.25
    Selection.ShapeRange.Item("Line 40").Left = 46.5
    Selection.ShapeRange.Item("Line 40").Width = 144#
    Selection.ShapeRange.Flip msoFlipVertical
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 191.25
    Selection.ShapeRange.Item("Line 41").Width = 89.25
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 65.25
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 23.25
    Selection.ShapeRange.Item("Line 43").Width = 66#
    Selection.ShapeRange.Item("Line 43").Top = 150#
    Selection.ShapeRange.Item("Line 43").Height = 12#
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.IncrementLeft -22.5
    Selection.ShapeRange.IncrementTop -35.25
    ActiveSheet.Shapes("Line 41").Select
    Range("D18").Select
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 168#
    Selection.ShapeRange.Item("Line 41").Width = 112.5
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 29.25
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 24#
    Selection.ShapeRange.Item("Line 43").Width = 65.25
    Selection.ShapeRange.Item("Line 43").Top = 127.5
    Selection.ShapeRange.Item("Line 43").Height = 22.5
    Selection.ShapeRange.Flip msoFlipVertical
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.Item("Line 40").Left = 25.5
    Selection.ShapeRange.Item("Line 40").Width = 142.5
    Selection.ShapeRange.Item("Line 40").Top = 127.5
    Selection.ShapeRange.Item("Line 40").Height = 50.25
    Pause
 
    Selection.ShapeRange.Item("Line 40").Left = 25.5
    Selection.ShapeRange.Item("Line 40").Width = 61.5
    Selection.ShapeRange.Item("Line 40").Top = 127.5
    Selection.ShapeRange.Item("Line 40").Height = 61.5
    Pause
 
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 85.5
    Selection.ShapeRange.Item("Line 41").Width = 195#
    Selection.ShapeRange.Item("Line 41").Top = 150#
    Selection.ShapeRange.Item("Line 41").Height = 39#
    Pause
 
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 54.75
    Selection.ShapeRange.Item("Line 43").Width = 34.5
    Selection.ShapeRange.Item("Line 43").Top = 106.5
    Selection.ShapeRange.Item("Line 43").Height = 43.5
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.Item("Line 40").Left = 54.75
    Selection.ShapeRange.Item("Line 40").Width = 32.25
    Selection.ShapeRange.Item("Line 40").Top = 105.75
    Selection.ShapeRange.Item("Line 40").Height = 83.25
    Pause
 
    Selection.ShapeRange.Item("Line 40").Left = 54.75
    Selection.ShapeRange.Item("Line 40").Width = 73.5
    Selection.ShapeRange.Item("Line 40").Top = 105.75
    Selection.ShapeRange.Item("Line 40").Height = 24.75
    Pause
 
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 127.5
    Selection.ShapeRange.Item("Line 41").Width = 153#
    Selection.ShapeRange.Item("Line 41").Top = 131.25
    Selection.ShapeRange.Item("Line 41").Height = 18.75
    Pause
 
    Selection.ShapeRange.Flip msoFlipVertical
    ActiveSheet.Shapes("Line 43").Select
    Selection.ShapeRange.Item("Line 43").Left = 88.5
    Selection.ShapeRange.Item("Line 43").Width = 0.75
    Selection.ShapeRange.Item("Line 43").Top = 91.5
    Selection.ShapeRange.Item("Line 43").Height = 58.5
    Pause
 
    ActiveSheet.Shapes("Line 40").Select
    Selection.ShapeRange.Item("Line 40").Left = 87.75
    Selection.ShapeRange.Item("Line 40").Width = 40.5
    Selection.ShapeRange.Item("Line 40").Top = 90.75
    Selection.ShapeRange.Item("Line 40").Height = 39.75
    Pause
 
    Selection.ShapeRange.Item("Line 40").Left = 87.75
    Selection.ShapeRange.Item("Line 40").Width = 140.25
    Selection.ShapeRange.Item("Line 40").Top = 87.75
    Selection.ShapeRange.Item("Line 40").Height = 3#
    Selection.ShapeRange.Flip msoFlipVertical
    ActiveSheet.Shapes("Line 41").Select
    Selection.ShapeRange.Item("Line 41").Left = 226.5
    Selection.ShapeRange.Item("Line 41").Width = 54#
    Selection.ShapeRange.Item("Line 41").Top = 88.5
    Selection.ShapeRange.Item("Line 41").Height = 61.5
[COLOR=darkblue]End[/COLOR] Sub