Offset Polyline

I am trying to write a routine that will offset a polyline a given distance,
then move it to a desired elevation. I have created a userform that lets the
user insert the horizontal distance and the vertical offset. I am writting
this routine to allow the user to do 3d offsets for contours. An example
would be to offset contours on a 3:1 slope.

I can not figure out how to let the user select the polyline and tell
AutoCAD what side to offset to. I tried the following lines but it will not
let you select a side for offset.

ThisDrawing.Utility.GetEntity UserObj, basePnt, "Select polyline"
offsetObj = UserObj.Offset(TxtHorz.Value)

I also tried to use the send command, but then I can't figure out how to get
the last entity to change its elevation.

Any help would be appriciated. AutoCAD 2004.

Thanks,

Pat

 

You need to mimic AutoCAD's internal commands, something like:

Dim dDist As Double
With ThisDrawing.Utility
.GetEntity UserObj, basePnt, "Select polyline"
dDist = .GetDistance(basePnt, "Offset distance")
End With
offsetObj = UserObj.Offset(dDist)

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

Mike,

Thanks for the quick reply. I have a dialog box that the user enters the
offset distance and I have that part working correctly. What I need is a way
to let the user select wich side to offset to. The UserObj.Offset only lets
me offset to one side depending on what direction the polyline was drawn. I
would like to be able to change the direction from a user selected point.
Any additional help is greatly appreciated.

Thanks,

Pat

 

sounds like you need to solicit a getpoint from the user
then calculate whether point is inside or outside the pline
and calculate whether pline is cw or ccw
then use that to determine whether dist is + or -
(if offset method allows negative input, don't know, haven't used it)

 

This is a old sample that Jeff Mishler (I think) gave me.
This offsets right & left of a selected polyline run from a userForm.

Hope this helps. Have a great day.

John Coon


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 UserForm_Initialize()
UserForm1.ComboBox1.AddItem "75'"
UserForm1.ComboBox1.AddItem "100'"
UserForm1.ComboBox1.AddItem "150'"
UserForm1.ComboBox1.AddItem "200'"
End Sub

 

I have a routine that works pretty good as long as the lwpoly selection points
is on a segment with bulge factor of 0. In this routine the offset distance
has already been entered. The user then selects the lwpoly (at the pickpoint)
and a point (sidepoint) showing direction to offset.
Because the pickpoint returned when selecting an entity may not be actually on
the entity I add a temporary line from the sidepoint to the pickpoint and get
the intersection of this line and the lwpoly (new pickpoint). The routine erases
the temporary line and then steps through the lwpoly to find the segment on
which the new pickpoint is located. I send the endpoints of that segement and
the sidepoint to the Whichside function that has been published here earlier.
Note, very large coordinates can cause the offset method to crash in R2004. When
I run into large coordinates (state plane coordinates usually) I move the lwpoly
down to 0,0. then offset as described above and then move the original lwpoly
back to its original location with the new created offset lwpoly tagging along.

Tom

 

I want to thank everyone who replied. With your help I was able to figure it
out and I have the routine working. All I have to do is add some error
checking and I can put it out for use. Again, thanks for all the replies.

Pat