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