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 errorhmx2 = sss.Curve.Nodes(2).PositionXmy2 = sss.Curve.Nodes(2).PositionYmx1 = sss.Curve.Nodes(1).PositionXmy1 = sss.Curve.Nodes(1).PositionY'mdelta = 1 / 2.54 'cm'If tbDelta.Value = "" Then 'if use userform as command interfacemdelta = 1 'value to lengthen. If negative value - shorten'Else'mdelta = tbDelta.Value'End Ifmlength = 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 Suberrorh: MsgBox "SELECT LINE AND TRY AGAIN!"
End Sub
Not working brother
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
Hello,
Please add End Sub
as last row in code aboveGreetings!
Thank You. I will try your code and than comment.