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
    'Else
    '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
    errorh:
    MsgBox "SELECT LINE AND TRY AGAIN!"

    End Sub

  • Option Explicit
    Const dblLengthIncrement As Double = 0.1
    
    Sub shorten_from_start_node()
    
        Dim segThis As Segment
        Dim dblDeltaX As Double
        Dim dblDeltaY As Double
        
        Set segThis = ActiveShape.Curve.Segments.First
        polar_to_cartesian segThis.StartingControlPointAngle, dblLengthIncrement, dblDeltaX, dblDeltaY
        segThis.StartNode.SetPosition segThis.StartNode.PositionX + dblDeltaX, segThis.StartNode.PositionY + dblDeltaY
    End Sub
    
    Sub lengthen_from_start_node()
    
        Dim segThis As Segment
        Dim dblDeltaX As Double
        Dim dblDeltaY As Double
        
        Set segThis = ActiveShape.Curve.Segments.First
        polar_to_cartesian segThis.StartingControlPointAngle, dblLengthIncrement, dblDeltaX, dblDeltaY
        segThis.StartNode.SetPosition segThis.StartNode.PositionX - dblDeltaX, segThis.StartNode.PositionY - dblDeltaY
    End Sub
    
    Sub shorten_from_end_node()
    
        Dim segThis As Segment
        Dim dblDeltaX As Double
        Dim dblDeltaY As Double
    
        Set segThis = ActiveShape.Curve.Segments.First
        polar_to_cartesian segThis.EndingControlPointAngle, dblLengthIncrement, dblDeltaX, dblDeltaY
        segThis.EndNode.SetPosition segThis.EndNode.PositionX + dblDeltaX, segThis.EndNode.PositionY + dblDeltaY
    End Sub
    
    Sub lengthen_from_end_node()
    
        Dim segThis As Segment
        Dim dblDeltaX As Double
        Dim dblDeltaY As Double
        
        Set segThis = ActiveShape.Curve.Segments.First
        polar_to_cartesian segThis.EndingControlPointAngle, dblLengthIncrement, dblDeltaX, dblDeltaY
        segThis.EndNode.SetPosition segThis.EndNode.PositionX - dblDeltaX, segThis.EndNode.PositionY - dblDeltaY
    End Sub
    
    Sub polar_to_cartesian(ByVal Angle As Double, ByVal Length As Double, ByRef DeltaX As Double, ByRef DeltaY As Double)
    
        DeltaX = Length * Cos(Angle * 3.14159265358979 / 180)
        DeltaY = Length * Sin(Angle * 3.14159265358979 / 180)
    End Sub