lengthen/shorten a line with VBA code

bhbp.bg2
over 1 year ago 
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
No Data
Reply
  • 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
Children

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.