![]() |
Line Position Drawing Object
I have two drawing objects on my sheet--"Line 1" and "Line 2". I want to
programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". All help would be appreciated. Thanks. |
Line Position Drawing Object
Marvin wrote:
I have two drawing objects on my sheet--"Line 1" and "Line 2". I want to programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". All help would be appreciated. Thanks. Hi Marvin With ActiveSheet.Shapes("Line 2") ..Top = ActiveSheet.Shapes("Line 1").Top - .Height ..Left = ActiveSheet.Shapes("Line 1").Left - .Width End With Ken Johnson |
Line Position Drawing Object
Hi Marvin, In my last reply I assumed that you wanted Line 2 to maintain the same length and orientation so that the whole line moves when it connects with Line 1. After re-reading your post I now see a different interpretation... maybe you want the bottom end of Line 2 to connect with the top left end of Line 1 while Line 2's top left end stays put. If this is the case then the code needs to first determine which Node on Line 2 is the lower one, then move the lower node to the top left end of Line 1... Public Sub Move_Line_Lower_Point() pointsarray1 = _ ActiveSheet.Shapes("Line 2").Nodes(1).Points pointsarray2 = _ ActiveSheet.Shapes("Line 2").Nodes(2).Points If pointsarray1(1, 2) pointsarray2(1, 2) Then ActiveSheet.Shapes("Line 2").Nodes.SetPosition 1, _ ActiveSheet.Shapes("Line 1").Left, _ ActiveSheet.Shapes("Line 1").Top Else: ActiveSheet.Shapes("Line 2").Nodes.SetPosition 2, _ ActiveSheet.Shapes("Line 1").Left, _ ActiveSheet.Shapes("Line 1").Top End If End Sub Ken Johnson |
Line Position Drawing Object
Thank you. This works fine for a line that has not been rotated. If "Line
2" has been rotated, the ends do not match up. "Ken Johnson" wrote: Marvin wrote: I have two drawing objects on my sheet--"Line 1" and "Line 2". I want to programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". All help would be appreciated. Thanks. Hi Marvin With ActiveSheet.Shapes("Line 2") ..Top = ActiveSheet.Shapes("Line 1").Top - .Height ..Left = ActiveSheet.Shapes("Line 1").Left - .Width End With Ken Johnson |
Line Position Drawing Object
Hi Ken,
I found that didn't always work depending on the original relative positions of the two lines, eg two similar angled lines one above the other gave me a cross. However there are other implications of using this method that results in changing one of the lines from a true line to a Freeform autoshape. If the line had not already been named from its default will get renamed from say Line 2 to Freeform 2. Alternatively could trap the left & top, right (left + width) & bottom (top + height) positions of the respective lines and change the dimensions of one of the lines as appropriate (width not to be confused with weight). However if I wanted to go there I wouldn't start from here, to coin a phrase. The OP might be better to replace the second line with a connector line (from the autoshapes menu). Record a macro while doing select the connector line select an end connector and drag to connect to the end of the ordinary line Regards, Peter T "Ken Johnson" wrote in message ups.com... Hi Marvin, In my last reply I assumed that you wanted Line 2 to maintain the same length and orientation so that the whole line moves when it connects with Line 1. After re-reading your post I now see a different interpretation... maybe you want the bottom end of Line 2 to connect with the top left end of Line 1 while Line 2's top left end stays put. If this is the case then the code needs to first determine which Node on Line 2 is the lower one, then move the lower node to the top left end of Line 1... Public Sub Move_Line_Lower_Point() pointsarray1 = _ ActiveSheet.Shapes("Line 2").Nodes(1).Points pointsarray2 = _ ActiveSheet.Shapes("Line 2").Nodes(2).Points If pointsarray1(1, 2) pointsarray2(1, 2) Then ActiveSheet.Shapes("Line 2").Nodes.SetPosition 1, _ ActiveSheet.Shapes("Line 1").Left, _ ActiveSheet.Shapes("Line 1").Top Else: ActiveSheet.Shapes("Line 2").Nodes.SetPosition 2, _ ActiveSheet.Shapes("Line 1").Left, _ ActiveSheet.Shapes("Line 1").Top End If End Sub Ken Johnson |
Line Position Drawing Object
Marvin wrote:
Let me simplify my issue. Line 1 was drawn. Line 2 was drawn, then rotated. I want Line 2, same size, same orientation (after rotation) I want to programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". Hi Marvin, Try this... Public Sub Join3() Application.ScreenUpdating = False Dim Line1 As Shape Dim Line2 As Shape Dim L1_Node1_XY As Variant Dim L1_Node2_XY As Variant Dim L2_Node1_XY As Variant Dim L2_Node2_XY As Variant Dim L1_Top_Node As Long Dim L2_Bottom_Node As Long Set Line1 = ActiveSheet.Shapes("Line 1") Set Line2 = ActiveSheet.Shapes("Line 2") Dim dX As Single, dY As Single 'Get Node Coordinates L1_Node1_XY = Line1.Nodes(1).Points L1_Node2_XY = Line1.Nodes(2).Points L2_Node1_XY = Line2.Nodes(1).Points L2_Node2_XY = Line2.Nodes(2).Points 'Determine Line1's top node If L1_Node1_XY(1, 2) < L1_Node2_XY(1, 2) Then L1_Top_Node = 1 Else: L1_Top_Node = 2 End If 'determine Line2's height (dY) and width (dX) dY = Abs(L2_Node2_XY(1, 2) - L2_Node1_XY(1, 2)) dX = Abs(L2_Node2_XY(1, 1) - L2_Node1_XY(1, 1)) 'Position Line2's first point at line1's top point Line2.Nodes.SetPosition 1, _ Line1.Nodes(L1_Top_Node).Points(1, 1), _ Line1.Nodes(L1_Top_Node).Points(1, 2) 'position line2's second point at line1's 'top point less the height and width Line2.Nodes.SetPosition 2, _ Line1.Nodes(L1_Top_Node).Points(1, 1) - dX, _ Line1.Nodes(L1_Top_Node).Points(1, 2) - dY End Sub Hope it works for you.It took quite a few attempts, and I had to sleep on it, before I had any success, hence the delay! Ken Johnson |
Line Position Drawing Object
Sub test1()
Dim ln1 As Line, ln2 As Line Set ln1 = ActiveSheet.Lines(1) ' or by name eg "Line 1" Set ln2 = ActiveSheet.Lines(2) ' both lines known to slope down from left to right ' move ln2 to attach bottom right to ln1 top-left With ln2 .Left = ln1.Left - .Width .Top = ln1.Top - .Height End With ' might want to move ln1 if insufficient to left & above to place ln2 ' also error handle in case line(s) don't exist End Sub Regards, Peter T "Marvin" wrote in message ... Let me simplify my issue. Line 1 was drawn. Line 2 was drawn, then rotated. I want Line 2, same size, same orientation (after rotation) I want to programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". "Marvin" wrote: Thank you. This works fine for a line that has not been rotated. If "Line 2" has been rotated, the ends do not match up. "Ken Johnson" wrote: Marvin wrote: I have two drawing objects on my sheet--"Line 1" and "Line 2". I want to programatically move the bottom right end of "Line 2" to join the top left end of "Line 1". All help would be appreciated. Thanks. Hi Marvin With ActiveSheet.Shapes("Line 2") ..Top = ActiveSheet.Shapes("Line 1").Top - .Height ..Left = ActiveSheet.Shapes("Line 1").Left - .Width End With Ken Johnson |
Line Position Drawing Object
Hi Peter,
That's amazing, the code's identical to my first attempt except for the dimension part, ie Dim as Shape versus Dim as Line. I tried all sorts of things before I finally got it to work by moving the Node points, which does change the line to a freeform as you previously stated, but at least its name stayed as Line 2. Thanks for that, it will come in handy. Ken Johnson |
Line Position Drawing Object
Hi Ken,
I'm very sorry to say I never looked at your first post, only the second. Not sure why that why that didn't do exactly what the OP wanted. Shape vs Line not directly relevant to the method, I used As Line merely to grab the first two Lines on the sheet without worrying about names (As Line would fail if trying to reference your new freeform but Shape wouldn't). Regards, Peter T "Ken Johnson" wrote in message oups.com... Hi Peter, That's amazing, the code's identical to my first attempt except for the dimension part, ie Dim as Shape versus Dim as Line. I tried all sorts of things before I finally got it to work by moving the Node points, which does change the line to a freeform as you previously stated, but at least its name stayed as Line 2. Thanks for that, it will come in handy. Ken Johnson |
Line Position Drawing Object
Hi Peter, Actually, looking back, I didn't use Dim As Shape, I just referenced them as Shapes using Activesheet.Shapes("Line 2") and that appears to have impacted on the final result. Ken Johnson |
All times are GMT +1. The time now is 03:19 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com