ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Line Position Drawing Object (https://www.excelbanter.com/excel-programming/376120-line-position-drawing-object.html)

Marvin

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.

Ken Johnson

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


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


Marvin

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



Peter T

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




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


Peter T

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





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


Peter T

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




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