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.
Parents
  • 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
    
Reply Children
No Data