Offset 3D Polyline?

[rhdins]

Is it possible to offset a 3d polyline? Can you off set a 3dpolyline in the z direction? I want to create breaklines for a bridge but I only have two cl points. Is there a way I can create a 3dpoly offset it 10' on both sides so I can use those as breaklines? Thanks.

[itr0045]

Try:Grading menu, Edit Feature Lines, Stepped Offset. There are some variables you can change within that command as well to change elevation and such.

As far as the Z, just use a wall breakline type and specify the height of your wall for that breakline.

[matthew.risch]

Terry Dotson's ToolPac will do this.
www.dotsoft.com
The command is: PTO

[jpkycek]

Here is a sub that I wrote some years back, that may help.

'SubName: Offset3dPoly
'Author: Joe Kycek, Date: 3/24/02
'Scope: Offset a 3dPoly by horizontal and vertical distances onto a layer.
'
'
'Requirements:
'
' a) A 3dpoly object
' b) A horizontal offset distance from the 3dpoly to
' the new 3dpoly.
' c) A vertical offset distance from the 3dpoly to
' the new 3dpoly.
' d) A layer for the new 3dpoly.
'
'Returns:
'
' i) A new 3dpoly object.
'
'Notes:
' 1) A positive horizontal distance value offsets to the Right.
' 2) A positive vertical distance value offsets vertically Up.
' 3) Just like the regular Offset command in AutoCad: Offsets
' that do not mathematically fit, may bring unexpected results.
' This sub uses the AutoCad offset function to achieve a part
' of its goals. So the rules regarding the standard
' AutoCad offset command apply.
'
Sub Offset3dPoly( _
o3dpoly As Acad3DPolyline, _
dDistanceHorizontal As Double, _
dDistanceVertical As Double, _
s3dPolyLayer As String, _
o3dpolynew As Acad3DPolyline)

Dim v2dPoly As Variant
Dim v3dPoly As Variant
Dim v3dPolyFlat As Variant
Dim o2dPoly As AcadPolyline
Dim o2dPolyOffset As AcadPolyline
Dim StartX As Double
Dim StartY As Double
Dim StartZ As Double
Dim EndX As Double
Dim EndY As Double
Dim EndZ As Double
Dim i As Integer

On Error GoTo 10


'Get the 3dpolys' coordinate array.
v3dPoly = o3dpoly.Coordinates
v3dPolyFlat = o3dpoly.Coordinates

'With the 3dpolys' coordinate array; flatten
'the z elevations to 0, so we can create a 2dpoly.
For i = 0 To ((UBound(v3dPolyFlat) + 1) / 3) - 1
v3dPolyFlat(3 * i + 2) = 0
Next


'get the 3dpolys starting and ending coordinates
'to be used later for checking.
StartX = v3dPoly(0)
StartY = v3dPoly(1)
StartZ = v3dPoly(2)
EndX = v3dPoly(UBound(v3dPoly) - 2)
EndY = v3dPoly(UBound(v3dPoly) - 1)
EndZ = v3dPoly(UBound(v3dPoly))

'Create a 2dPoly with the same x,y coordinates as the 3dpoly.
'Use this object later; for offsetting.
Set o2dPoly = ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat)

'If the 3dpoly is closed, or the 3dpoly's start and end coordinates are the same;
'then close the 2dpoly object: for offseting.
If o3dpoly.Closed = True Or StartX = EndX And StartY = EndY And StartZ = EndZ Then
o2dPoly.Closed = True
End If

'The api does not support a zero 2dpoly offset. But we could
'be creating a new 3dpoly that is vertically straight up or down from the
'original 3dpoly, with no offset, so... an if statement is needed here;

If dDistanceHorizontal <> 0 Then

'Create a 2dpoly object array; by the offset distance supplied.
v2dPoly = o2dPoly.offSet(dDistanceHorizontal)

'Create a new 2dPoly object from the object array.
Set o2dPolyOffset = v2dPoly(0)

'Get the offsetted 2dpoly coordinates
v2dPoly = o2dPolyOffset.Coordinates
'delete the offsetted 2dpoly.
o2dPolyOffset.Delete
Set o2dPolyOffset = Nothing

Else

'the horizontal offset is 0, so use the non-offsetted
'coordinates from the the new 2dpoly.
v2dPoly = o2dPoly.Coordinates

End If


'Next, Modify the offsetted 2dpolys' coordinates; by adding the original
'3dpoly z elevations plus the supplied Vertical additive.
For i = 0 To ((UBound(v2dPoly) + 1) / 3) - 1
v2dPoly(3 * i + 2) = v3dPoly(3 * i + 2) + dDistanceVertical
Next

'Create the new 3dPoly.
Set o3dpolynew = ThisDrawing.ModelSpace.Add3DPoly(v2dPoly)

'if the 2dpoly is closed, then close the new 3dpoly
If o2dPoly.Closed = True Then
o3dpolynew.Closed = True
End If


'Set the layer for the new 3dPoly.
o3dpolynew.Layer = s3dPolyLayer

10:

'delete the 2dpoly.
o2dPoly.Delete
Set o2dPoly = Nothing


End Sub Edited by: jpkycek on Jan 28, 2009 8:36 AM

[jpkycek]

For some reason a line of code is not showing up
correctly. The not equal to arrows "< >" are not showing.

The line:
If dDistanceHorizontal 0 Then

should be:
If dDistanceHorizontal <> 0 Then '(If dDistanceHorizontal is not equal to 0)

Edited by: jpkycek on Jan 28, 2009 8:43 AM Edited by: jpkycek on Jan 28, 2009 8:49 AM

[Civil3DReminders_com]

Try the html code for the symbols:



< & lt > & gt (put the & and lt, gt together)

Edited by: Civil3DReminders.com on Jan 28, 2009 6:58 AM Edited by: Civil3DReminders.com on Jan 28, 2009 6:59 AM

[kdepfyffer]

itr0045 has it right, don't bother with code or third party stuff civil 3D can do this for you. You can also convert those 3D poly's to feature lines and edit the elevations. You'll have more control if you use what is provided with Civil. Now if you want to do this with just plain AutoCAD you will have to use one of the other options

[Anonymous]

Hi jpkycek,

As you can see from the text below you message is hopelessly garbled.

You can fix it by placing it between code markers


Put code here and it retains its formatting


The Autodesk web site indicates you can use
{code}

{code}

but this certainly doesn't work for code viewed in Thunderbird.

Regards


Laurie Comerford

jpkycek wrote:
> Here is a sub that I wrote some years back, that may help. 'SubName:
> Offset3dPoly 'Author: Joe Kycek, Date: 3/24/02 'Scope: Offset a 3dPoly
> by horizontal and vertical distances onto a layer. ' ' 'Requirements: '
> ' a) A 3dpoly object ' b) A horizontal offset distance from the 3dpoly
> to ' the new 3dpoly. ' c) A vertical offset distance from the 3dpoly to
> ' the new 3dpoly. ' d) A layer for the new 3dpoly. ' 'Returns: ' ' i) A
> new 3dpoly object. ' 'Notes: ' 1) A positive horizontal distance value
> offsets to the Right. ' 2) A positive vertical distance value offsets
> vertically Up. ' 3) Just like the regular Offset command in AutoCad:
> Offsets ' that do not mathematically fit, may bring unexpected results.
> ' This sub uses the AutoCad offset function to achieve a part ' of its
> goals. So the rules regarding the standard ' AutoCad offset command
> apply. ' Sub Offset3dPoly( _ o3dpoly As Acad3DPolyline, _
> dDistanceHorizontal As Double, _ dDistanceVertical As Double, _
> s3dPolyLayer As String, _ o3dpolynew As Acad3DPolyline) Dim v2dPoly As
> Variant Dim v3dPoly As Variant Dim v3dPolyFlat As Variant Dim o2dPoly As
> AcadPolyline Dim o2dPolyOffset As AcadPolyline Dim StartX As Double Dim
> StartY As Double Dim StartZ As Double Dim EndX As Double Dim EndY As
> Double Dim EndZ As Double Dim i As Integer On Error GoTo 10 'Get the
> 3dpolys' coordinate array. v3dPoly = o3dpoly.Coordinates v3dPolyFlat =
> o3dpoly.Coordinates 'With the 3dpolys' coordinate array; flatten 'the z
> elevations to 0, so we can create a 2dpoly. For i = 0 To
> ((UBound(v3dPolyFlat) + 1) / 3) - 1 v3dPolyFlat(3 * i + 2) = 0 Next 'get
> the 3dpolys starting and ending coordinates 'to be used later for
> checking. StartX = v3dPoly(0) StartY = v3dPoly(1) StartZ = v3dPoly(2)
> EndX = v3dPoly(UBound(v3dPoly) - 2) EndY = v3dPoly(UBound(v3dPoly) - 1)
> EndZ = v3dPoly(UBound(v3dPoly)) 'Create a 2dPoly with the same x,y
> coordinates as the 3dpoly. 'Use this object later; for offsetting. Set
> o2dPoly = ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat) 'If the 3dpoly
> is closed, or the 3dpoly's start and end coordinates are the same; 'then
> close the 2dpoly object: for offseting. If o3dpoly.Closed = True Or
> StartX = EndX And StartY = EndY And StartZ = EndZ Then o2dPoly.Closed =
> True End If 'The api does not support a zero 2dpoly offset. But we could
> 'be creating a new 3dpoly that is vertically straight up or down from
> the 'original 3dpoly, with no offset, so... an if statement is needed
> here; If dDistanceHorizontal <> 0 Then 'Create a 2dpoly object array; by
> the offset distance supplied. v2dPoly =
> o2dPoly.offSet(dDistanceHorizontal) 'Create a new 2dPoly object from the
> object array. Set o2dPolyOffset = v2dPoly(0) 'Get the offsetted 2dpoly
> coordinates v2dPoly = o2dPolyOffset.Coordinates 'delete the offsetted
> 2dpoly. o2dPolyOffset.Delete Set o2dPolyOffset = Nothing Else 'the
> horizontal offset is 0, so use the non-offsetted 'coordinates from the
> the new 2dpoly. v2dPoly = o2dPoly.Coordinates End If 'Next, Modify the
> offsetted 2dpolys' coordinates; by adding the original '3dpoly z
> elevations plus the supplied Vertical additive. For i = 0 To
> ((UBound(v2dPoly) + 1) / 3) - 1 v2dPoly(3 * i + 2) = v3dPoly(3 * i + 2)
> + dDistanceVertical Next 'Create the new 3dPoly. Set o3dpolynew =
> ThisDrawing.ModelSpace.Add3DPoly(v2dPoly) 'if the 2dpoly is closed, then
> close the new 3dpoly If o2dPoly.Closed = True Then o3dpolynew.Closed =
> True End If 'Set the layer for the new 3dPoly. o3dpolynew.Layer =
> s3dPolyLayer 10: 'delete the 2dpoly. o2dPoly.Delete Set o2dPoly =
> Nothing End Sub Edited by: jpkycek on Jan 28, 2009 8:36 AM

[jpkycek]

Thanks Laurie,

I have not posted code in a long while, so I am getting
re-aquainted with the changed format.
I hope this re-post is readable.

>

'SubName: Offset3dPoly
'Author: Joe Kycek, Date: 3/24/02
'Scope: Offset a 3dPoly with horizontal and vertical distances.
'
'
' Requirements:
'
' a) A 3dpoly object
' b) A horizontal offset distance from the 3dpoly to
' the new 3dpoly.
' c) A vertical offset distance from the 3dpoly to
' the new 3dpoly.
' d) A layer for the new 3dpoly.
'
' Returns:
'
' i) A new 3dpoly object.
'
'Notes:
' 1) A positive horizontal distance value offsets to the Right.
' 2) A positive vertical distance value offsets vertically Up.
' 3) Just like the regular Offset command in AutoCad: Offsets
' that do not mathematically fit, may bring unexpected results.
' This sub uses the AutoCad offset function to achieve a part
' of its goals. So the rules regarding the standard
' AutoCad offset command apply.
'
Sub Offset3dPoly( _
o3dpoly As Acad3DPolyline, _
dDistanceHorizontal As Double, _
dDistanceVertical As Double, _
s3dPolyLayer As String, _
o3dpolynew As Acad3DPolyline)

Dim v2dPoly As Variant
Dim v3dPoly As Variant
Dim v3dPolyFlat As Variant
Dim o2dPoly As AcadPolyline
Dim o2dPolyOffset As AcadPolyline
Dim StartX As Double
Dim StartY As Double
Dim StartZ As Double
Dim EndX As Double
Dim EndY As Double
Dim EndZ As Double
Dim i As Integer

On Error GoTo 10


'Get the 3dpolys' coordinate array.
v3dPoly = o3dpoly.Coordinates
v3dPolyFlat = o3dpoly.Coordinates

'With the 3dpolys' coordinate array; flatten
'the z elevations to 0, so we can create a 2dpoly.
For i = 0 To ((UBound(v3dPolyFlat) + 1) / 3) - 1
v3dPolyFlat(3 * i + 2) = 0
Next


'get the 3dpolys starting and ending coordinates
'to be used later for checking.
StartX = v3dPoly(0)
StartY = v3dPoly(1)
StartZ = v3dPoly(2)
EndX = v3dPoly(UBound(v3dPoly) - 2)
EndY = v3dPoly(UBound(v3dPoly) - 1)
EndZ = v3dPoly(UBound(v3dPoly))

'Create a 2dPoly with the same x,y coordinates as the 3dpoly.
'Use this object later; for offsetting.
Set o2dPoly = ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat)

'If the 3dpoly is closed, or the 3dpoly's start and end
'coordinates are the same;
'then close the 2dpoly object: for offseting.
If o3dpoly.Closed = True _
Or _
StartX = EndX And StartY = EndY And StartZ = EndZ Then
o2dPoly.Closed = True
End If

'The api does not support a zero 2dpoly offset. But we could
'be creating a new 3dpoly that is vertically straight up or
'down from the original 3dpoly, with no offset,
'so... an if statement is needed here;
If dDistanceHorizontal <> 0 Then

'Create a 2dpoly object array; by the offset distance supplied.
v2dPoly = o2dPoly.offSet(dDistanceHorizontal)

'Create a new 2dPoly object from the object array.
Set o2dPolyOffset = v2dPoly(0)

'Get the offsetted 2dpoly coordinates
v2dPoly = o2dPolyOffset.Coordinates
'delete the offsetted 2dpoly.
o2dPolyOffset.Delete
Set o2dPolyOffset = Nothing

Else

'the horizontal offset is 0, so use the non-offsetted
'coordinates from the the new 2dpoly.
v2dPoly = o2dPoly.Coordinates

End If


'Next, Modify the offsetted 2dpolys' coordinates; by adding the original
'3dpoly z elevations plus the supplied Vertical additive.
For i = 0 To ((UBound(v2dPoly) + 1) / 3) - 1
v2dPoly(3 * i + 2) = v3dPoly(3 * i + 2) + dDistanceVertical
Next

'Create the new 3dPoly.
Set o3dpolynew = ThisDrawing.ModelSpace.Add3DPoly(v2dPoly)

'if the 2dpoly is closed, then close the new 3dpoly
If o2dPoly.Closed = True Then
o3dpolynew.Closed = True
End If


'Set the layer for the new 3dPoly.
o3dpolynew.Layer = s3dPolyLayer

10:

'delete the 2dpoly.
o2dPoly.Delete
Set o2dPoly = Nothing


End Sub

<

Thanks, Joe Edited by: jpkycek on Jan 28, 2009 10:41 PM

[Anonymous]

Hi Joe,

Just for the record, this is what I get to look at in Windows
Mail (Vista's Outlook Express). I really don't think you can do anything else to
make this look right here.....it is squarely on the shoulders of the folks who
run this place, and they don't seem to be too concerned about fixing it.

Too bad, too, because when I get to a post like yours I just
immediately close it rather than try to decode it.....I did try for a while, but
there is just so much time in a day.

Jeff

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"jpkycek" wrote in message
href="news:6113754@discussion.autodesk.com">news:6113754@discussion.autodesk.com...

Thanks
Laurie, I have not posted code in a long while, so I am getting re-aquainted
with the changed format. I hope this re-post is readable. > 'SubName:
Offset3dPoly 'Author: Joe Kycek, Date: 3/24/02 'Scope: Offset a 3dPoly with
horizontal and vertical distances. ' ' ' Requirements: ' ' a) A 3dpoly object
' b) A horizontal offset distance from the 3dpoly to ' the new 3dpoly. ' c) A
vertical offset distance from the 3dpoly to ' the new 3dpoly. ' d) A layer for
the new 3dpoly. ' ' Returns: ' ' i) A new 3dpoly object. ' 'Notes: ' 1) A
positive horizontal distance value offsets to the Right. ' 2) A positive
vertical distance value offsets vertically Up. ' 3) Just like the regular
Offset command in AutoCad: Offsets ' that do not mathematically fit, may bring
unexpected results. ' This sub uses the AutoCad offset function to achieve a
part ' of its goals. So the rules regarding the standard ' AutoCad offset
command apply. ' Sub Offset3dPoly( _ o3dpoly As Acad3DPolyline, _
dDistanceHorizontal As Double, _ dDistanceVertical As Double, _ s3dPolyLayer
As String, _ o3dpolynew As Acad3DPolyline) Dim v2dPoly As Variant Dim v3dPoly
As Variant Dim v3dPolyFlat As Variant Dim o2dPoly As AcadPolyline Dim
o2dPolyOffset As AcadPolyline Dim StartX As Double Dim StartY As Double Dim
StartZ As Double Dim EndX As Double Dim EndY As Double Dim EndZ As Double Dim
i As Integer On Error GoTo 10 'Get the 3dpolys' coordinate array. v3dPoly =
o3dpoly.Coordinates v3dPolyFlat = o3dpoly.Coordinates 'With the 3dpolys'
coordinate array; flatten 'the z elevations to 0, so we can create a 2dpoly.
For i = 0 To ((UBound(v3dPolyFlat) + 1) / 3) - 1 v3dPolyFlat(3 * i + 2) = 0
Next 'get the 3dpolys starting and ending coordinates 'to be used later for
checking. StartX = v3dPoly(0) StartY = v3dPoly(1) StartZ = v3dPoly(2) EndX =
v3dPoly(UBound(v3dPoly) - 2) EndY = v3dPoly(UBound(v3dPoly) - 1) EndZ =
v3dPoly(UBound(v3dPoly)) 'Create a 2dPoly with the same x,y coordinates as the
3dpoly. 'Use this object later; for offsetting. Set o2dPoly =
ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat) 'If the 3dpoly is closed, or
the 3dpoly's start and end 'coordinates are the same; 'then close the 2dpoly
object: for offseting. If o3dpoly.Closed = True _ Or _ StartX = EndX And
StartY = EndY And StartZ = EndZ Then o2dPoly.Closed = True End If 'The api
does not support a zero 2dpoly offset. But we could 'be creating a new 3dpoly
that is vertically straight up or 'down from the original 3dpoly, with no
offset, 'so... an if statement is needed here; If dDistanceHorizontal <>
0 Then 'Create a 2dpoly object array; by the offset distance supplied. v2dPoly
= o2dPoly.offSet(dDistanceHorizontal) 'Create a new 2dPoly object from the
object array. Set o2dPolyOffset = v2dPoly(0) 'Get the offsetted 2dpoly
coordinates v2dPoly = o2dPolyOffset.Coordinates 'delete the offsetted 2dpoly.
o2dPolyOffset.Delete Set o2dPolyOffset = Nothing Else 'the horizontal offset
is 0, so use the non-offsetted 'coordinates from the the new 2dpoly. v2dPoly =
o2dPoly.Coordinates End If 'Next, Modify the offsetted 2dpolys' coordinates;
by adding the original '3dpoly z elevations plus the supplied Vertical
additive. For i = 0 To ((UBound(v2dPoly) + 1) / 3) - 1 v2dPoly(3 * i + 2) =
v3dPoly(3 * i + 2) + dDistanceVertical Next 'Create the new 3dPoly. Set
o3dpolynew = ThisDrawing.ModelSpace.Add3DPoly(v2dPoly) 'if the 2dpoly is
closed, then close the new 3dpoly If o2dPoly.Closed = True Then
o3dpolynew.Closed = True End If 'Set the layer for the new 3dPoly.
o3dpolynew.Layer = s3dPolyLayer 10: 'delete the 2dpoly. o2dPoly.Delete Set
o2dPoly = Nothing End Sub < Thanks, Joe Edited by: jpkycek on Jan 28, 2009
10:41 PM

[Anonymous]

Hi Joe,

It's just as unreadable as the first lot.

I'm like Jeff. I really can't be bothered trying to interpret the
Autodesk hashing of people's code, but in this case I spent the time to
more of less format it and post it enclosed as I suggested.


Regards


Laurie Comerford



'SubName: Offset3dPoly
'Author: Joe Kycek, Date: 3/24/02
'Scope: Offset a 3dPoly with horizontal and vertical distances. ' ' '
Requirements: '
' a) A 3dpoly object ' b) A horizontal offset distance from the 3dpoly to
' the new 3dpoly. ' c) A vertical offset distance from the 3dpoly to
' the new 3dpoly. ' d) A layer for the new 3dpoly. ' ' Returns: '
' i) A new 3dpoly object. '
'Notes: ' 1) A positive horizontal distance value offsets to the Right.
' 2) A positive vertical distance value offsets vertically Up.
' 3) Just like the regular Offset command in AutoCad: Offsets
' that do not mathematically fit, may bring unexpected results.
' This sub uses the AutoCad offset function to achieve a part
' of its goals. So the rules regarding the standard
' AutoCad offset command apply. '
Sub Offset3dPoly( _
o3dpoly As Acad3DPolyline, _
dDistanceHorizontal As Double, _
dDistanceVertical As Double, _
s3dPolyLayer As String, _
o3dpolynew As Acad3DPolyline)
Dim v2dPoly As Variant
Dim v3dPoly As Variant
Dim v3dPolyFlat As V
ariant
Dim o2dPoly As AcadPolyline
Dim o2dPolyOffset As AcadPolyline
Dim StartX As Double
Dim StartY As Double
Dim StartZ As Double
Dim EndX As Double
Dim EndY As Double
Dim EndZ As Double
Dim i As Integer
On Error GoTo 10 'Get the 3dpolys' coordinate array.
v3dPoly = o3dpoly.Coordinates
v3dPolyFlat = o3dpoly.Coordinates 'With the 3dpolys' coordinate
array; flatten
'the z elevations to 0, so we can create a 2dpoly.
For i = 0 To ((UBound(v3dPolyFlat) + 1) / 3) - 1
v3dPolyFlat(3 * i + 2) = 0
Next 'get the 3dpolys starting and ending coordinates 'to be used
later for checking.
StartX = v3dPoly(0)
StartY = v3dPoly(1)
StartZ = v3dPoly(2)
EndX = v3dPoly(UBound(v3dPoly) - 2)
EndY = v3dPoly(UBound(v3dPoly) - 1)
EndZ = v3dPoly(UBound(v3dPoly))
'Create a 2dPoly with the same x,y coordinates as the 3dpoly.
'Use this object later; for offsetting.
Set o2dPoly = ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat)
'If the 3dpoly is closed, or the 3dpoly's start and end 'coordinates are
the same;
'then close the 2dpoly object: for offseting.
If o3dpoly.Closed = True _
Or _
StartX = EndX And StartY = EndY And StartZ = EndZ Then
o2dPoly.Closed = True
End If
'The api does not support a zero 2dpoly offset. But we could
'be creating a new 3dpoly that is vertically straight up or
'down from the original 3dpoly, with no offset,
'so... an if statement is needed here;
If dDistanceHorizontal <> 0 Then
'Create a 2dpoly object array; by the offset distance supplied.
v2dPoly = o2dPoly.Offset(dDistanceHorizontal)
'Create a new 2dPoly object from the object array.
Set o2dPolyOffset = v2dPoly(0)
'Get the offsetted 2dpoly coordinates
v2dPoly = o2dPolyOffset.Coordinates
'delete the offsetted 2dpoly.
o2dPolyOffset.Delete
Set o2dPolyOffset = Nothing
Else
'the horizontal offset is 0, so use the non-offsetted 'coordinates from
the the new 2dpoly.
v2dPoly = o2dPoly.Coordinates
End If
'Next, Modify the offsetted 2dpolys' coordinates; by adding the original
'3dpoly z elevations plus the supplied Vertical additive.
For i = 0 To ((UBound(v2dPoly) + 1) / 3) - 1
v2dPoly(3 * i + 2) = v3dPoly(3 * i + 2) + dDistanceVertical
Next 'Create the new 3dPoly.
Set o3dpolynew = ThisDrawing.ModelSpace.Add3DPoly(v2dPoly)
'if the 2dpoly is closed, then close the new 3dpoly
If o2dPoly.Closed = True Then
o3dpolynew.Closed = True
End If
'Set the layer for the new 3dPoly.
o3dpolynew.Layer = s3dPolyLayer
10: 'delete the 2dpoly.
o2dPoly.Delete
Set o2dPoly = Nothing
End Sub


> Thanks Laurie, I have not posted code in a long while, so I am getting
> re-aquainted with the changed format. I hope this re-post is readable. >
> 'SubName: Offset3dPoly 'Author: Joe Kycek, Date: 3/24/02 'Scope: Offset
> a 3dPoly with horizontal and vertical distances. ' ' ' Requirements: ' '
> a) A 3dpoly object ' b) A horizontal offset distance from the 3dpoly to
> ' the new 3dpoly. ' c) A vertical offset distance from the 3dpoly to '
> the new 3dpoly. ' d) A layer for the new 3dpoly. ' ' Returns: ' ' i) A
> new 3dpoly object. ' 'Notes: ' 1) A positive horizontal distance value
> offsets to the Right. ' 2) A positive vertical distance value offsets
> vertically Up. ' 3) Just like the regular Offset command in AutoCad:
> Offsets ' that do not mathematically fit, may bring unexpected results.
> ' This sub uses the AutoCad offset function to achieve a part ' of its
> goals. So the rules regarding the standard ' AutoCad offset command
> apply. ' Sub Offset3dPoly( _ o3dpoly As Acad3DPolyline, _
> dDistanceHorizontal As Double, _ dDistanceVertical As Double, _
> s3dPolyLayer As String, _ o3dpolynew As Acad3DPolyline) Dim v2dPoly As
> Variant Dim v3dPoly As Variant Dim v3dPolyFlat As Variant Dim o2dPoly As
> AcadPolyline Dim o2dPolyOffset As AcadPolyline Dim StartX As Double Dim
> StartY As Double Dim StartZ As Double Dim EndX As Double Dim EndY As
> Double Dim EndZ As Double Dim i As Integer On Error GoTo 10 'Get the
> 3dpolys' coordinate array. v3dPoly = o3dpoly.Coordinates v3dPolyFlat =
> o3dpoly.Coordinates 'With the 3dpolys' coordinate array; flatten 'the z
> elevations to 0, so we can create a 2dpoly. For i = 0 To
> ((UBound(v3dPolyFlat) + 1) / 3) - 1 v3dPolyFlat(3 * i + 2) = 0 Next 'get
> the 3dpolys starting and ending coordinates 'to be used later for
> checking. StartX = v3dPoly(0) StartY = v3dPoly(1) StartZ = v3dPoly(2)
> EndX = v3dPoly(UBound(v3dPoly) - 2) EndY = v3dPoly(UBound(v3dPoly) - 1)
> EndZ = v3dPoly(UBound(v3dPoly)) 'Create a 2dPoly with the same x,y
> coordinates as the 3dpoly. 'Use this object later; for offsetting. Set
> o2dPoly = ThisDrawing.ModelSpace.AddPolyline(v3dPolyFlat) 'If the 3dpoly
> is closed, or the 3dpoly's start and end 'coordinates are the same;
> 'then close the 2dpoly object: for offseting. If o3dpoly.Closed = True _
> Or _ StartX = EndX And StartY = EndY And StartZ = EndZ Then
> o2dPoly.Closed = True End If 'The api does not support a zero 2dpoly
> offset. But we could 'be creating a new 3dpoly that is vertically
> straight up or 'down from the original 3dpoly, with no offset, 'so... an
> if statement is needed here; If dDistanceHorizontal <> 0 Then 'Create a
> 2dpoly object array; by the offset distance supplied. v2dPoly =
> o2dPoly.offSet(dDistanceHorizontal) 'Create a new 2dPoly object from the
> object array. Set o2dPolyOffset = v2dPoly(0) 'Get the offsetted 2dpoly
> coordinates v2dPoly = o2dPolyOffset.Coordinates 'delete the offsetted
> 2dpoly. o2dPolyOffset.Delete Set o2dPolyOffset = Nothing Else 'the
> horizontal offset is 0, so use the non-offsetted 'coordinates from the
> the new 2dpoly. v2dPoly = o2dPoly.Coordinates End If 'Next, Modify the
> offsetted 2dpolys' coordinates; by adding the original '3dpoly z
> elevations plus the supplied Vertical additive. For i = 0 To
> ((UBound(v2dPoly) + 1) / 3) - 1 v2dPoly(3 * i + 2) = v3dPoly(3 * i + 2)
> + dDistanceVertical Next 'Create the new 3dPoly. Set o3dpolynew =
> ThisDrawing.ModelSpace.Add3DPoly(v2dPoly) 'if the 2dpoly is closed, then
> close the new 3dpoly If o2dPoly.Closed = True Then o3dpolynew.Closed =
> True End If 'Set the layer for the new 3dPoly. o3dpolynew.Layer =
> s3dPolyLayer 10: 'delete the 2dpoly. o2dPoly.Delete Set o2dPoly =
> Nothing End Sub < Thanks, Joe Edited by: jpkycek on Jan 28, 2009 10:41 PM

[Anonymous]

Sorry this is somewhat off topic. For those of you who try to decode garbled code. Would it work to copy the code into AutoCAD's lisp editor and have the program reset the formatting? I am no expert it is just a thought. I tried it with the code above and was told there were 8 unbalanced brackets found. That code does not look like the regular lisp code I have seen so that may be the problem. Sorry for interrupting just trying to help 🙂

[Anonymous]

Thanks for trying, Anthony. But see, there's part of the
problem. Because the formatting is blown you thought it might be lisp.....it's
actually VBA code. But even taking lisp code and formatting it in the VLIDE
doesn't work most of the time because once a semi-colon is hit it thinks
everything after that point is a comment.

The point is, these groups were working great until they
(Autodesk) decided to "upgrade" them to some new-fangled software. They shoud
have tested it just a wee bit before unleashing it on the masses, and then
pulled it immediately once the huge problems were uncovered.

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

"anthonylrhodes" wrote in message
href="news:6114128@discussion.autodesk.com">news:6114128@discussion.autodesk.com...

Sorry
this is somewhat off topic. For those of you who try to decode garbled code.
Would it work to copy the code into AutoCAD's lisp editor and have the program
reset the formatting? I am no expert it is just a thought. I tried it with the
code above and was told there were 8 unbalanced brackets found. That code does
not look like the regular lisp code I have seen so that may be the problem.
Sorry for interrupting just trying to help 🙂

[Anonymous]

I tried. You win some you lose some. Thanks for letting me know.

[AllenJessup]

This is what I can see. Since I'm not terribly familiar with VBA I can't spot any small errors. But at least it isn't a jumble.

Allen

[jpkycek]

Hi folks,

I am re-posting the code as an attachment text file.
Perhaps I should have done this right off the bat as I saw
that the vb 'not equal to' arrows were 'deleted' when I first
posted the code and then checked the uploaded post against
my original code.

I then was amazed that others saw my post as garbled.

Thanks for all of your posts. I was unaware that there was a posting
problem. I hope they fix it.

Thanks AllenJessup for descrambling the garbled post.
But.... your text file contains the original
error (non recognition of the vba 'not equal to' arrows) that I
posted about, just after, I posted the original code.

So use my text file. Which was just a copy/paste
from the vbaide.

Thanks, Joe Edited by: jpkycek on Jan 30, 2009 6:34 AM

[jpkycek]

Private Sub CreateAWall()
Dim o3dpoly As Acad3DPolyline
Dim o3dpolynew As Acad3DPolyline
Dim i As Integer


'This is just one example on how to use the
'Offset3dPoly sub, from a form: I have also
'attached this code as a text file if the post
' is unreadable.

'Lets create a 10' foot high wall that is 1' foot thick and is
'5' feet away from the original 3dpoly picked; and follows
'the picked 3dpolys' elevations.


frmMain.hide

On Error GoTo 10

'Pick the 3dpoly (I am using my own custom getentity utility)
Set o3dpoly = GetEntityByFilter("3D PolyLine", "3DPOLYLINE")

'let the Offset3dPoly sub do the work:
Offset3dPoly o3dpoly, 5, 0, "0", o3dpolynew
Offset3dPoly o3dpolynew, 0, 10, "0", o3dpolynew
Offset3dPoly o3dpolynew, 1, 0, "0", o3dpolynew
Offset3dPoly o3dpolynew, 0, -10, "0", o3dpolynew


10:

Set o3dpoly = Nothing
Set o3dpolynew = Nothing

frmMain.Show

End Sub Edited by: jpkycek on Jan 30, 2009 11:25 AM

[AllenJessup]

Thank you for posting the corrected file. I didn't really descramble anything. I noticed that in some of the posts I could see recognizable text and in some it looked scrambled. I'm just too stubborn to give up.



Allen



BTW The way I usually offset a 3D polyline in the Z direction is to use the Stepped Offset command. I use 0.00011 as the offset distance and then specify the elevation difference or grade.

You can't use a smaller distance than 0.0001 but because you don't want breaklines directly over one another anyway you need a little X,Y offset anyway.

ASJ Edited by: AllenJessup on Jan 30, 2009 8:52 AM

[jpkycek]

Hi Allen,

I agree, as a civil 3d user, I use the stepped offset command also; and you
are also correct that a surface will not recognize 2 3dpolys directly on top
of each other as breaklines. So a small xy offset from one to the other,
like you said, is needed. I shared the Offset3dpoly code and example as
just another tool to get things done.


Thanks, Joe