Community site general questions lengthen/shorten a line with VBA code

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

Eskimo over 1 year ago

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

bhbp.bg2 over 1 year ago in reply to Eskimo

Thank You. I will try your code and than comment.
Cancel
Up 0 Down

Reply

Cancel

Children

No Data