lengthen/shorten a line with VBA code

An arbitrary line is drawn. Make a macro that is associated with a key, for example F5. When F5 is pressed, the line will be extended by a step of 0.1"
Holding SHIFT while pressing F5 shortens the line by 0.1"
Holding down CTRL while pressing F5 lengthens the line by 0.1" on the other side. Holding down SHIFT and CTRL and pressing F5 shortens the line by 0.1" on the other side.
  • Sub line_lengthen()

    'Line must be selected

    'On error go to errorhandler may be added to improve code

    Dim sss As Shape
    Set sss = ActiveShape
    'Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    'x1 = s.Curve.Nodes(1).PositionX
    'MsgBox s.Curve.Length
    On Error GoTo errorh
    mx2 = sss.Curve.Nodes(2).PositionX
    my2 = sss.Curve.Nodes(2).PositionY
    mx1 = sss.Curve.Nodes(1).PositionX
    my1 = sss.Curve.Nodes(1).PositionY
    'mdelta = 1 / 2.54 'cm
    'If tbDelta.Value = "" Then 'if use userform as command interface
    mdelta = 1 'value to lengthen. If negative value - shorten
    'mdelta = tbDelta.Value
    'End If
    mlength = sss.Curve.Length
    'MsgBox s.Curve.Length
    'Set s = ActiveShape
    's.Curve.Nodes(2).PositionX = s.Curve.Nodes(2).PositionX + 1 / 2.54
    'sss.Curve.Nodes(2).PositionX = ((mlength + mdelta) / mlength) * mx
    'sss.Curve.Nodes(2).PositionY = ((mlength + mdelta) / mlength) * my
    'MsgBox mx2 - mx1
    sss.Curve.Nodes(2).PositionX = (((mlength + mdelta) * (mx2 - mx1)) / mlength) + mx1
    sss.Curve.Nodes(2).PositionY = (((mlength + mdelta) * (my2 - my1)) / mlength) + my1
    Exit Sub

    End Sub

Reply Children
No Data