extend a line or polyline

Hi group,

I need some help understanding how to extend a line or polyline. I have a
offset routine that I would like to add a extend feature to but have NO idea
how to approach it. Any help in the area in the way of description is
greatly appreciated.

TextBox1 & TextBox2 are the offsets from runway centerline given the runway
width. TextBox3 & TextBox4 are to be the extend distances beyond the
existing selected polyline that I want to extend the selected object.

Thanks for all your help. Have a great day.

I not sure if this stuff helps undertand what I'm attemping so I included
it.

Private Sub ComboBox1_Change()
With ComboBox1
Select Case .Text
Case "75'"
TextBox1.Text = "300" 'RSA width
TextBox2.Text = "800" 'object free area width
TextBox3.Text = "600" 'RSA beyond rw end
TextBox4.Text = "600" 'Object free area beyond rw end
Case "100'"
TextBox1.Text = "400" 'RSA width
TextBox2.Text = "800" 'object free area width
TextBox3.Text = "800" 'RSA beyond rw end
TextBox4.Text = "800" 'Object free area beyond rw end

Case "150'"
TextBox1.Text = "500" 'RSA width
TextBox2.Text = "800" 'object free area width
TextBox3.Text = "1000" 'RSA beyond rw end
TextBox4.Text = "1000" 'Object free area beyond rw end

Case "200'"
TextBox1.Text = "500" 'RSA width
TextBox2.Text = "800" 'object free area width
TextBox3.Text = "1000" 'RSA beyond rw end
TextBox4.Text = "1000" 'Object free area beyond rw end
End Select
End With
End Sub

Public Sub TextBox1_Change()
Dim TextBox1 As Double

End Sub

Private Sub CommandButton2_Click()
Dim entity As AcadEntity
hide
Dim i As Integer
Dim offset1 As Double
Dim offset2 As Double
Dim offsetEntities As Variant
Dim selectionSet As AcadSelectionSet ' Define the offest distances.
offset1 = TextBox1 'rsa
offset2 = (TextBox1 * 2) ' Make sure the layer that will hold the new
offset2 = (TextBox1 - offset2) 'rsa
offset3 = TextBox2
offset4 = (TextBox2 * 2) ' Make sure the layer that will hold the new
offset4 = (TextBox2 - offset4)


' entities exists.
Dim objlayer As AcadLayer
Set objlayer = ThisDrawing.Layers.Add("C-RSA")
Set objlayer = ThisDrawing.Layers.Add("C-ROFA")
Set objlayer = ThisDrawing.Layers.Add("C-OFA")
' Delete the selection set if it already exists.

For Each selectionSet In ThisDrawing.SelectionSets
If selectionSet.Name = "CurrentSelection" Then
selectionSet.Delete
Exit For
End If
Next selectionSet ' Create a new instance of the selection set.
Set selectionSet = ThisDrawing.SelectionSets.Add("CurrentSelection")
' Add entities to the selection set.
selectionSet.SelectOnScreen ' Create the offsets and put them on the
correct layer.
For Each entity In selectionSet
offsetEntities = entity.Offset(offset1)

For i = LBound(offsetEntities) To UBound(offsetEntities)
offsetEntities(i).Layer = "C-RSA"
Next i
offsetEntities = entity.Offset(offset2)

For i = LBound(offsetEntities) To UBound(offsetEntities)
offsetEntities(i).Layer = "C-RSA"
Next i

offsetEntities = entity.Offset(offset3)
For i = LBound(offsetEntities) To UBound(offsetEntities)
offsetEntities(i).Layer = "C-OFA"
Next i

offsetEntities = entity.Offset(offset4)
For i = LBound(offsetEntities) To UBound(offsetEntities)
offsetEntities(i).Layer = "C-OFA"
Next i
Next entity

Update
Show
End Sub
Private Sub CommandButton1_Click()
End
End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub TextBox4_Change()

End Sub
Private Sub UserForm_Initialize()


UserForm1.ComboBox1.AddItem "75'"
UserForm1.ComboBox1.AddItem "100'"
UserForm1.ComboBox1.AddItem "150'"
UserForm1.ComboBox1.AddItem "200'"


End Sub

 

Hi John, here's a nudge for you...... no code this time ;-)
For lines, think "StartPoint" "Endpoint" "Angle" "PolarPoint".....
For plines think "FirstCoordinate" "SecondCoordinate" "Angle" "PolarPoint"
"NextToLastCoordinate" "LastCoordinate" "Angle" "PolarPoint"

Good Luck,
Jeff

 

Jeff,

Thanks. I'll do some checking on your noted commands.
Have a great father's day!
John

 

Jeff,

Thanks for the hint. can I get another?

Do I look at the viewtwist for the difference between world and a user
coordinate system when using a polar angle?


Sub test()

Dim pt1 As Variant
Dim pt2 As Variant
Dim newpt1 As Variant
Dim newpt2 As Variant
Dim newpt3 As Variant
Dim newpt4 As Variant
Dim newpt5 As Variant
Dim newpt6 As Variant
Dim newpt7 As Variant
Dim newpt8 As Variant

Dim oline As AcadLine
pt1 = ThisDrawing.Utility.GetPoint(, "PICK FIRST RUNWAY END: ")
newpt1 = ThisDrawing.Utility.PolarPoint(pt1, 1.570796327, 250)
newpt2 = ThisDrawing.Utility.PolarPoint(pt1, -1.570796327, 250)
newpt3 = ThisDrawing.Utility.PolarPoint(newpt1, 3.14, 1000)
newpt4 = ThisDrawing.Utility.PolarPoint(newpt2, 3.14, 1000)

pt2 = ThisDrawing.Utility.GetPoint(, "PICK SECOND RUNWAY END: ")
newpt5 = ThisDrawing.Utility.PolarPoint(pt2, 1.570796327, 250)
newpt6 = ThisDrawing.Utility.PolarPoint(pt2, -1.570796327, 250)
newpt7 = ThisDrawing.Utility.PolarPoint(newpt5, 3.14, -1000)
newpt8 = ThisDrawing.Utility.PolarPoint(newpt6, 3.14, -1000)


Set oline = ThisDrawing.ModelSpace.AddLine(pt1, newpt1)
Set oline = ThisDrawing.ModelSpace.AddLine(pt1, newpt2)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt1, newpt3)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt2, newpt4)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt3, newpt4)

Set oline = ThisDrawing.ModelSpace.AddLine(pt2, newpt5)
Set oline = ThisDrawing.ModelSpace.AddLine(pt2, newpt6)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt5, newpt7)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt6, newpt8)
Set oline = ThisDrawing.ModelSpace.AddLine(newpt7, newpt8)


oline.Update
End Sub

 

Here's where I cannot help much. I don't use UCS's due to the fact they can
really screw-up LandDesktop drawing. Although I do think that you'd want to
do all of your calculations in World coordinates and use the
TranslateCoordinates Method to go back and forth.

Jeff

 

When you say "the difference", what is it you're trying to determine?

Regards

Wayne Ivory
IT Analyst Programmer
Wespine Industries Pty Ltd

 

Jeff, Wayne,

The only reason I'm using a ucs is that the people I was trying to write
this for KNOW nothing about coordinates and even less about cad.
If I can get a routine that they can just pick points onscreen with a usc
they can do less harm & complete the task needed. Normally I write
everything based with land and its features like alignments, DTM's. These
guys have no idea what an alignment is and never will.

As for the difference. I was using the dblrot to get the viewtwist between
world and the usc to figure the new angle. I was able to have it draw in the
correct angle in world & ucs but it placed the elements 180 degrees out. not
sure why yet.


Thanks for all your help.

John Coon

 

As Jeff said, I think you want to use the TranslateCoordinates method.

Regards

Wayne