Message 1 of 9
add arc to polyline array help

Not applicable
07-07-2006
07:17 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I'm looking for help / sample of how to add an arc to an existing polyline
array. My sample draws a polyline rectangle with an arc drawn from its end
points.
I'm trying to find a way to include the arc as part of the polyline array.
I've looked at the set buldge section but I don't understand how to include
the code to build the polyline along with the straight line segments. It
appeared that I could include a segment to close the polyline then go back
and change the buldge setting for that segment to build the poly array but
I'm not sure I'm interrupting that correctly. I placed a sample drawing in
the customer-files called "pline-test" under post called "polyline vba array
test"
any direction is appreciated,
John Coon
Sub addBulge()
Dim newpt502(2) As Double
newpt502(0) = 1850#: newpt502(1) = 0#: newpt502(2) = 0#
Dim newpt503(2) As Double
newpt503(0) = 1850#: newpt503(1) = 400#: newpt503(2) = 0#
Dim newpt505(2) As Double
newpt505(0) = 0#: newpt505(1) = 0#: newpt505(2) = 0#
Dim newpt506(2) As Double
newpt506(0) = 0#: newpt506(1) = 400#: newpt506(2) = 0#
Dim newpt507(2) As Double
newpt507(0) = 2250: newpt507(1) = 200#: newpt507(2) = 0#
Dim RPt1 As Variant
Dim RPt2 As Variant
Dim RPt3 As Variant
'creates arc from 3 points - written by Josh West
Dim PP1, PP2, PP3, PP4, PP5, CentrPt, CheckPt
Dim Chord1 As AcadLine
Dim Chord2 As AcadLine
Dim Vector1 As AcadXline
Dim Vector2 As AcadXline
Dim StartLin As AcadLine
Dim EndLin As AcadLine
Dim CheckLin As AcadLine
Dim MainArc As AcadArc
Dim AlternateArc As AcadArc
RPt1 = newpt502
RPt2 = newpt507
RPt3 = newpt503
Set Chord1 = ThisDrawing.ModelSpace.AddLine(RPt1, RPt2)
Set Chord2 = ThisDrawing.ModelSpace.AddLine(RPt2, RPt3)
PP1 = ThisDrawing.Utility.PolarPoint(RPt1, Chord1.angle, Chord1.Length / 2)
PP2 = ThisDrawing.Utility.PolarPoint(RPt2, Chord2.angle, Chord2.Length / 2)
PP3 = ThisDrawing.Utility.PolarPoint(PP1, Chord1.angle + ((3.141592654 * 90)
/ 180), 1#)
PP4 = ThisDrawing.Utility.PolarPoint(PP2, Chord2.angle + ((3.141592654 * 90)
/ 180), 1#)
Set Vector1 = ThisDrawing.ModelSpace.AddXline(PP1, PP3)
Set Vector2 = ThisDrawing.ModelSpace.AddXline(PP2, PP4)
CentrPt = Vector1.IntersectWith(Vector2, acExtendNone)
Set StartLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt1)
Set EndLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt3)
Set CheckLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt2)
Set MainArc = ThisDrawing.ModelSpace.AddArc(CentrPt, StartLin.Length,
StartLin.angle, EndLin.angle)
CheckPt = CheckLin.IntersectWith(MainArc, acExtendNone)
On Error Resume Next
If CheckPt(0) = 0 Then CheckPt(0) = 0
If Err Then
Err.Clear
MainArc.Delete
Set AlternateArc = ThisDrawing.ModelSpace.AddArc(CentrPt,
StartLin.Length, EndLin.angle, StartLin.angle)
End If
Chord1.Delete
Chord2.Delete
Vector1.Delete
Vector2.Delete
StartLin.Delete
EndLin.Delete
CheckLin.Delete
Dim DRWPOLYAPPR1 As AcadLWPolyline
Dim approachpoints1(9) As Double
approachpoints1(0) = newpt502(0): approachpoints1(1) = newpt502(1)
approachpoints1(2) = newpt505(0): approachpoints1(3) = newpt505(1)
approachpoints1(4) = newpt506(0): approachpoints1(5) = newpt506(1)
approachpoints1(6) = newpt503(0): approachpoints1(7) = newpt503(1)
approachpoints1(8) = newpt503(0): approachpoints1(9) = newpt503(1)
Set DRWPOLYAPPR1 =
ThisDrawing.ModelSpace.AddLightWeightPolyline(approachpoints1)
End Sub
array. My sample draws a polyline rectangle with an arc drawn from its end
points.
I'm trying to find a way to include the arc as part of the polyline array.
I've looked at the set buldge section but I don't understand how to include
the code to build the polyline along with the straight line segments. It
appeared that I could include a segment to close the polyline then go back
and change the buldge setting for that segment to build the poly array but
I'm not sure I'm interrupting that correctly. I placed a sample drawing in
the customer-files called "pline-test" under post called "polyline vba array
test"
any direction is appreciated,
John Coon
Sub addBulge()
Dim newpt502(2) As Double
newpt502(0) = 1850#: newpt502(1) = 0#: newpt502(2) = 0#
Dim newpt503(2) As Double
newpt503(0) = 1850#: newpt503(1) = 400#: newpt503(2) = 0#
Dim newpt505(2) As Double
newpt505(0) = 0#: newpt505(1) = 0#: newpt505(2) = 0#
Dim newpt506(2) As Double
newpt506(0) = 0#: newpt506(1) = 400#: newpt506(2) = 0#
Dim newpt507(2) As Double
newpt507(0) = 2250: newpt507(1) = 200#: newpt507(2) = 0#
Dim RPt1 As Variant
Dim RPt2 As Variant
Dim RPt3 As Variant
'creates arc from 3 points - written by Josh West
Dim PP1, PP2, PP3, PP4, PP5, CentrPt, CheckPt
Dim Chord1 As AcadLine
Dim Chord2 As AcadLine
Dim Vector1 As AcadXline
Dim Vector2 As AcadXline
Dim StartLin As AcadLine
Dim EndLin As AcadLine
Dim CheckLin As AcadLine
Dim MainArc As AcadArc
Dim AlternateArc As AcadArc
RPt1 = newpt502
RPt2 = newpt507
RPt3 = newpt503
Set Chord1 = ThisDrawing.ModelSpace.AddLine(RPt1, RPt2)
Set Chord2 = ThisDrawing.ModelSpace.AddLine(RPt2, RPt3)
PP1 = ThisDrawing.Utility.PolarPoint(RPt1, Chord1.angle, Chord1.Length / 2)
PP2 = ThisDrawing.Utility.PolarPoint(RPt2, Chord2.angle, Chord2.Length / 2)
PP3 = ThisDrawing.Utility.PolarPoint(PP1, Chord1.angle + ((3.141592654 * 90)
/ 180), 1#)
PP4 = ThisDrawing.Utility.PolarPoint(PP2, Chord2.angle + ((3.141592654 * 90)
/ 180), 1#)
Set Vector1 = ThisDrawing.ModelSpace.AddXline(PP1, PP3)
Set Vector2 = ThisDrawing.ModelSpace.AddXline(PP2, PP4)
CentrPt = Vector1.IntersectWith(Vector2, acExtendNone)
Set StartLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt1)
Set EndLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt3)
Set CheckLin = ThisDrawing.ModelSpace.AddLine(CentrPt, RPt2)
Set MainArc = ThisDrawing.ModelSpace.AddArc(CentrPt, StartLin.Length,
StartLin.angle, EndLin.angle)
CheckPt = CheckLin.IntersectWith(MainArc, acExtendNone)
On Error Resume Next
If CheckPt(0) = 0 Then CheckPt(0) = 0
If Err Then
Err.Clear
MainArc.Delete
Set AlternateArc = ThisDrawing.ModelSpace.AddArc(CentrPt,
StartLin.Length, EndLin.angle, StartLin.angle)
End If
Chord1.Delete
Chord2.Delete
Vector1.Delete
Vector2.Delete
StartLin.Delete
EndLin.Delete
CheckLin.Delete
Dim DRWPOLYAPPR1 As AcadLWPolyline
Dim approachpoints1(9) As Double
approachpoints1(0) = newpt502(0): approachpoints1(1) = newpt502(1)
approachpoints1(2) = newpt505(0): approachpoints1(3) = newpt505(1)
approachpoints1(4) = newpt506(0): approachpoints1(5) = newpt506(1)
approachpoints1(6) = newpt503(0): approachpoints1(7) = newpt503(1)
approachpoints1(8) = newpt503(0): approachpoints1(9) = newpt503(1)
Set DRWPOLYAPPR1 =
ThisDrawing.ModelSpace.AddLightWeightPolyline(approachpoints1)
End Sub