Tracing an Arc In a Polyline in line intervals

tristan.jonas8XAAW
Advocate
Advocate

Tracing an Arc In a Polyline in line intervals

tristan.jonas8XAAW
Advocate
Advocate

Hello, 

Hope everyone's doing well today 🙂 I'm creating a script (ARC2PLINE) that's supposed to trace a polyline perfectly at the lines, but when it finds an arc within the polyline, it iterates a straight line segment every 100 units along the arc until the end, and then continues on its merry way to more adventures with more lines and arcs along the polyline.

So I got this script working for just plain arcs (the ARCAA command below demonstrates this), but i'm having some difficulties making it work for arcs within polylines I've gotten all manners of strange iterations (I present two below) when it should be basically tracing, it's not connecting to the line segments that surround the arc properly, I'm just really at a loss for what's going on here. Here's what I got:

 

 

<CommandMethod("ARC2PLINE")>
    Public Sub ArcToPolyline_Main()
        Dim ed = Application.DocumentManager.MdiActiveDocument.Editor

        ' Prompt the user to select a polyline
        Dim plineOptions = New PromptEntityOptions(vbLf & "Select a polyline: ")
        plineOptions.SetRejectMessage(vbLf & "Selected entity must be a Polyline.")
        plineOptions.AddAllowedClass(GetType(Polyline), True)
        Dim plineResult = ed.GetEntity(plineOptions)
        If plineResult.Status <> PromptStatus.OK Then Return

        Dim db = Application.DocumentManager.MdiActiveDocument.Database

        Using tr = db.TransactionManager.StartTransaction()
            ' Get the selected polyline
            Dim selectedPline = CType(tr.GetObject(plineResult.ObjectId, OpenMode.ForRead), Polyline)

            ' Create a new polyline for the output
            Dim newPline As New Polyline()

            ' Iterate through the polyline segments
            For index As Integer = 0 To selectedPline.NumberOfVertices - 2
                Dim startPoint As Point2d = selectedPline.GetPoint2dAt(index)
                Dim endPoint As Point2d = selectedPline.GetPoint2dAt(index + 1)

                If selectedPline.GetSegmentType(index) = SegmentType.Arc Then
                    Dim arcSegment As CircularArc2d = selectedPline.GetArcSegment2dAt(index)
                    Dim arc As New Arc(New Point3d(arcSegment.Center.X, arcSegment.Center.Y, 0), arcSegment.Radius, arcSegment.StartAngle, arcSegment.EndAngle)

                    ' Orient the arc correctly
                    If selectedPline.GetBulgeAt(index) > 0 Then
                        Dim temp = arc.StartAngle
                        arc.StartAngle = arc.EndAngle
                        arc.EndAngle = temp
                    End If

                    Dim arcPoints As List(Of Point2d) = GenerateArcPoints(arc)

                    For i As Integer = 0 To arcPoints.Count - 1
                        newPline.AddVertexAt(newPline.NumberOfVertices, arcPoints(i), 0, 0, 0)
                    Next
                Else
                    ' Add line segment points to the new polyline
                    If newPline.NumberOfVertices = 0 OrElse newPline.GetPoint2dAt(newPline.NumberOfVertices - 1) <> startPoint Then
                        newPline.AddVertexAt(newPline.NumberOfVertices, startPoint, 0, 0, 0)
                    End If
                    newPline.AddVertexAt(newPline.NumberOfVertices, endPoint, 0, 0, 0)
                End If
            Next

            ' Add the new polyline to the current space
            Dim curSpace = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
            curSpace.AppendEntity(newPline)
            tr.AddNewlyCreatedDBObject(newPline, True)

            tr.Commit()
        End Using
    End Sub


    Public Function GenerateArcPoints(arc As Arc) As List(Of Point2d)
        Dim points As New List(Of Point2d)

        Dim startPoint As Point2d = New Point2d(arc.StartPoint.X, arc.StartPoint.Y)
        Dim endPoint As Point2d = New Point2d(arc.EndPoint.X, arc.EndPoint.Y)

        points.Add(startPoint)

        Dim interval As Double = 100.0
        Dim arcLength As Double = arc.Length
        Dim numIntervals As Integer = CInt(Math.Floor(arcLength / interval))

        ' Ensure that the end angle is greater than the start angle
        Dim endAngle As Double = arc.EndAngle
        If endAngle < arc.StartAngle Then
            endAngle += 2 * Math.PI
        End If

        ' Add a small tolerance to account for floating-point arithmetic
        Dim tolerance As Double = 0.0000000001
        If Math.Abs(endAngle - 2 * Math.PI) < tolerance Then
            endAngle -= tolerance
        End If

        For i As Integer = 1 To numIntervals + 1
            Dim angle = arc.StartAngle + (i * (endAngle - arc.StartAngle) / numIntervals)

            ' Ensure the angle stays within bounds
            If angle > endAngle Then
                angle = endAngle
            ElseIf angle < arc.StartAngle Then
                angle = arc.StartAngle
            End If

            ' Convert angle to point on the arc using center, radius, and angle
            Dim pointOnArc = New Point3d(arc.Center.X + arc.Radius * Math.Cos(angle), arc.Center.Y + arc.Radius * Math.Sin(angle), arc.Center.Z)
            Dim pointOnArc2d = New Point2d(pointOnArc.X, pointOnArc.Y)

            points.Add(pointOnArc2d)

            If angle = endAngle Then
                Exit For
            End If
        Next

        Return points
    End Function

    <CommandMethod("ARCAA")>
    Public Sub TestGenerateArcPoints()
        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        Dim ed = doc.Editor

        ' Prompt the user to select an arc
        Dim arcOptions = New PromptEntityOptions(vbLf & "Select an arc: ")
        arcOptions.SetRejectMessage(vbLf & "Selected entity must be an Arc.")
        arcOptions.AddAllowedClass(GetType(Arc), True)
        Dim arcResult = ed.GetEntity(arcOptions)

        If arcResult.Status <> PromptStatus.OK Then Return

        Using tr = db.TransactionManager.StartTransaction()
            ' Get the selected arc
            Dim selectedArc = CType(tr.GetObject(arcResult.ObjectId, OpenMode.ForRead), Arc)

            ' Generate the points on the arc
            Dim points = GenerateArcPoints(selectedArc)

            ' Draw the points on the arc
            Dim curSpace = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
            For Each point In points
                Dim point3d = New Point3d(point.X, point.Y, 0)
                Dim dbPoint = New DBPoint(point3d)

                curSpace.AppendEntity(dbPoint)
                tr.AddNewlyCreatedDBObject(dbPoint, True)
            Next

            tr.Commit()
        End Using
    End Sub

 

 

And here is the before and after, notice the exotic shape it makes if I attempt to use it on a very simple filleted polyline:

tristanjonas8XAAW_0-1682028788561.png

And here is what it would look like an earlier version i still have access to:

tristanjonas8XAAW_1-1682028845365.png

 

0 Likes
Reply
Accepted solutions (3)
1,334 Views
10 Replies
Replies (10)

tristan.jonas8XAAW
Advocate
Advocate

Hey all, I actually got it working relatively well, I'm just stuck at one part and I don't really know how to push forward here. I made a little test command called GRRR and it basically does what I wanted the code above to do, and it works when the arc in the polyline is padded between two lines, so in theory it should work. However when there are arcs on the start and end points it really scrambles it up.

Here is the before-and-after of what it looks like when I attempt to use it on polylines that have multiple arcs, and the code:

tristanjonas8XAAW_0-1682103255428.png

 



 

 <CommandMethod("GRRR")>
    Public Sub GRRR_Main()
        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        Dim ed = doc.Editor

        Dim filter = New SelectionFilter({New TypedValue(0, "LWPOLYLINE")})
        Dim selection = ed.GetSelection(filter)
        If selection.Status <> PromptStatus.OK Then Return

        If selection.Value.Count <> 1 Then
            ed.WriteMessage("Please select exactly one polyline." & vbCrLf)
            Return
        End If

        Using tr = db.TransactionManager.StartTransaction()
            Dim polylineObjectId = selection.Value.GetObjectIds()(0)
            ProcessPolylineWithArcs(tr, polylineObjectId)
            tr.Commit()
        End Using
    End Sub
    Private Function ProcessPolylineWithArcs(tr As Transaction, plineObjectId As ObjectId) As Polyline
        Dim inputPline As Polyline = CType(tr.GetObject(plineObjectId, OpenMode.ForRead), Polyline)
        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        ' Create a new polyline for the output
        Dim newPline As Polyline
        Using nestedTr = db.TransactionManager.StartTransaction()
            newPline = New Polyline()
            ' Rest of the code in the ProcessPolylineWithArcs function

            ' Add the new polyline to the current space
            Dim curSpace2 = CType(nestedTr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
            curSpace2.AppendEntity(newPline)
            nestedTr.AddNewlyCreatedDBObject(newPline, True)
            nestedTr.Commit()
        End Using


        Dim isClosed As Boolean = inputPline.Closed
        If isClosed Then
            inputPline.Closed = False
        End If



        ' Iterate through the polyline segments
        For index As Integer = 0 To inputPline.NumberOfVertices - 2
            Dim startPoint As Point2d = inputPline.GetPoint2dAt(index)
            Dim endPoint As Point2d
            doc.Editor.WriteMessage(vbCrLf & "Index: " & index & " SegmentType: " & inputPline.GetSegmentType(index).ToString())
            doc.Editor.WriteMessage(vbCrLf & "InputPline.NumberOfVertices: " & inputPline.NumberOfVertices)

            endPoint = inputPline.GetPoint2dAt(index + 1)

            Dim prevEndPoint As Point2d = Nothing
            If inputPline.GetSegmentType(index) = SegmentType.Arc Then
                Dim arcSegment As CircularArc2d = inputPline.GetArcSegment2dAt(index)

                ' Calculate absolute start and end angles
                Dim center As Point2d = arcSegment.Center
                Dim startAngle As Double = Math.Atan2(startPoint.Y - center.Y, startPoint.X - center.X)
                Dim endAngle As Double = Math.Atan2(endPoint.Y - center.Y, endPoint.X - center.X)

                If index = 0 AndAlso inputPline.NumberOfVertices > 2 Then
                    Dim nextPoint As Point2d = inputPline.GetPoint2dAt(index + 2)
                    If startPoint.GetDistanceTo(nextPoint) < endPoint.GetDistanceTo(nextPoint) Then
                        Dim temp = startAngle
                        startAngle = endAngle
                        endAngle = temp
                    End If
                ElseIf prevEndPoint <> Nothing AndAlso Not startPoint.IsEqualTo(prevEndPoint) AndAlso Not endPoint.IsEqualTo(prevEndPoint) Then
                    Dim temp = startAngle
                    startAngle = endAngle
                    endAngle = temp
                End If

                Dim arc As New Arc(New Point3d(center.X, center.Y, 0), arcSegment.Radius, startAngle, endAngle)

                ' Orient the arc correctly
                If inputPline.GetBulgeAt(index) < 0 Then
                    Dim temp = arc.StartAngle
                    arc.StartAngle = arc.EndAngle
                    arc.EndAngle = temp
                End If

                doc.Editor.WriteMessage(vbCrLf & "StartAngle: " & startAngle & " EndAngle: " & endAngle)
                Dim arcPoints As List(Of Point2d) = GenerateArcPoints(arc)
                doc.Editor.WriteMessage(vbCrLf & "Arc Points: " & String.Join(", ", arcPoints))


                For i As Integer = 0 To arcPoints.Count - 1
                    newPline.AddVertexAt(newPline.NumberOfVertices, arcPoints(i), 0, 0, 0)
                Next

                prevEndPoint = endPoint
                doc.Editor.WriteMessage(vbCrLf & "NewPline.NumberOfVertices: " & newPline.NumberOfVertices)

            Else
                ' Add line segment points to the new polyline
                If newPline.NumberOfVertices = 0 OrElse newPline.GetPoint2dAt(newPline.NumberOfVertices - 1) <> startPoint Then
                    newPline.AddVertexAt(newPline.NumberOfVertices, startPoint, 0, 0, 0)
                End If
                If index < inputPline.NumberOfVertices - 1 Then
                    newPline.AddVertexAt(newPline.NumberOfVertices, endPoint, 0, 0, 0)
                End If
                doc.Editor.WriteMessage(vbCrLf & "Line Start: " & startPoint.ToString() & " End: " & endPoint.ToString())

                prevEndPoint = endPoint
                doc.Editor.WriteMessage(vbCrLf & "NewPline.NumberOfVertices: " & newPline.NumberOfVertices)

            End If
        Next
        doc.Editor.WriteMessage(vbCrLf & "NewPline.NumberOfVertices: " & newPline.NumberOfVertices)

        ' Add the new polyline to the current space
        Dim plineClone As Polyline = newPline.Clone()
        Dim curSpace = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
        curSpace.AppendEntity(plineClone)
        tr.AddNewlyCreatedDBObject(plineClone, True)

        If isClosed Then
            newPline.Closed = True
        End If


        Return newPline


    End Function

    Public Function GenerateArcPoints(arc As Arc) As List(Of Point2d)
        Dim points As New List(Of Point2d)

        Dim startPoint As Point2d = New Point2d(arc.StartPoint.X, arc.StartPoint.Y)
        Dim endPoint As Point2d = New Point2d(arc.EndPoint.X, arc.EndPoint.Y)

        points.Add(startPoint)

        Dim interval As Double = 100.0
        Dim arcLength As Double = arc.Length
        Dim numIntervals As Integer = CInt(Math.Floor(arcLength / interval))

        ' Ensure that the end angle is greater than the start angle
        Dim endAngle As Double = arc.EndAngle
        If endAngle < arc.StartAngle Then
            endAngle += 2 * Math.PI
        End If

        ' Add a small tolerance to account for floating-point arithmetic
        Dim tolerance As Double = 0.0000000001
        If Math.Abs(endAngle - 2 * Math.PI) < tolerance Then
            endAngle -= tolerance
        End If

        For i As Integer = 1 To numIntervals + 1
            Dim angle = arc.StartAngle + (i * (endAngle - arc.StartAngle) / numIntervals)

            ' Ensure the angle stays within bounds
            If angle > endAngle Then
                angle = endAngle
            ElseIf angle < arc.StartAngle Then
                angle = arc.StartAngle
            End If

            ' Convert angle to point on the arc using center, radius, and angle
            Dim pointOnArc = New Point3d(arc.Center.X + arc.Radius * Math.Cos(angle), arc.Center.Y + arc.Radius * Math.Sin(angle), arc.Center.Z)
            Dim pointOnArc2d = New Point2d(pointOnArc.X, pointOnArc.Y)

            points.Add(pointOnArc2d)

            If angle = endAngle Then
                Exit For
            End If
        Next

        Return points
    End Function

 

 

edit: and for the record, I'm aware this is a lot to ask help for, but I want it to be known that if I can just get pointed in the right direction, like a link to what i'm looking for or the name of some method that would be useful, then that's literally all I need, I'm not asking anyone to write an ounce of code for me, to be VERY clear. I just feel like there's a discrepancy between regular arcs and arcs on a polyline and it's hard to make a script work with both but I can't put my finger on exactly what their difference is.

0 Likes

cuongtk2
Advocate
Advocate
Accepted solution

Maybe you should change your approach

 

Public Shared Function PlineToLinear(ByVal pline As Polyline, ByVal Optional interval As Double = 100) As Polyline
    Dim newpline As Polyline = New Polyline()
    Dim onum As Integer = pline.NumberOfVertices
    Dim plan As Plane = New Plane()

    For i As Integer = 0 To onum - 1
        Dim bulge = pline.GetBulgeAt(i)

        If bulge = 0 Or i = onum - 1 Then
            newpline.AddVertexAt(newpline.NumberOfVertices, pline.GetPoint2dAt(i), 0, 0, 0)
        Else
            Dim dist1 As Double = pline.GetDistanceAtParameter(i)
            Dim dist2 As Double = pline.GetDistanceAtParameter(i + 1)
            Dim arcseglength As Double = dist2 - dist1
            Dim num As Integer = CInt((arcseglength / interval))

            For j As Integer = 0 To num
                Dim pt As Point2d = pline.GetPointAtDist(dist1 + j * interval).Convert2d(plan)
                newpline.AddVertexAt(newpline.NumberOfVertices, pt, 0, 0, 0)
            Next
        End If
    Next

    Return newpline
End Function

 

0 Likes

tristan.jonas8XAAW
Advocate
Advocate

That's very good, that seemed to work really well on the first polyline with arc that I posted originally, but unfortunately when I click a polyline with an arc as the end segment this function unfortunately doesn't work. Once again I don't need any code written out I just need the right direction. My suspicion is that it has to do with possibly 2 things:

1. arcs at the beginning and or end of the polyline
2. arcs that cross over the 0 degree threshold, for example an arc where the start angle is 5 and the end angle is 355.
3. the 'rotation' of the angle, meaning depending on the bulge being positive or negative dictates which direction the rendering is applied, meaning if it's positive the end angle will always be greater than the start angle so from the start point it'll always move clockwise. if it's negative then from start to end it'll move counter clockwise.

Am I on the right track?

0 Likes

_gile
Mentor
Mentor
Accepted solution

Hi,

You should use the Polyline parameters (Curve.GetDistanceAtParameter and Curve.GetPointAtParameter)

Here's an example:

 

 

        static void ArcToSegments(Polyline pline, double intervalMax)
        {
            int numberOfSegments = pline.Closed ?
                pline.NumberOfVertices :
                pline.NumberOfVertices - 1;
            var plane = new Plane(Point3d.Origin, pline.Normal);
            for (int i = 0; i < numberOfSegments; i++)
            {
                if (pline.GetSegmentType(i) == SegmentType.Arc)
                {
                    var points = new Point2dCollection();
                    double param = pline.GetParameterAtPoint(pline.GetPoint3dAt(i));
                    double arcLength =
                        pline.GetDistanceAtParameter(param + 1.0) - pline.GetDistanceAtParameter(param);
                    int numIntervals = (int)Math.Ceiling(arcLength / intervalMax);
                    double increment = 1.0 / numIntervals;
                    for (int j = 1; j < numIntervals; j++)
                    {
                        points.Add(pline.GetPointAtParameter(i + j * increment).Convert2d(plane));
                    }
                    pline.SetBulgeAt(i, 0.0);
                    foreach (Point2d pt in points)
                    {
                        i++;
                        numberOfSegments++;
                        pline.AddVertexAt(i, pt, 0.0, 0.0, 0.0);
                    }
                }
            }
        }

 

 



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes

_gile
Mentor
Mentor
Accepted solution

My purpose is similar to @cuongtk2 .

Here's a testing command:

        [CommandMethod("TEST")]
        public static void Test()
        {
            var doc = Application.DocumentManager.MdiActiveDocument;
            var db = doc.Database;
            var ed = doc.Editor;
            var options = new PromptEntityOptions("\nSelect Polyline: ");
            options.SetRejectMessage("\nMust be a Polyline.");
            options.AddAllowedClass(typeof(Polyline), true);
            var result = ed.GetEntity(options);
            if (result.Status != PromptStatus.OK) return;
            using (var tr = db.TransactionManager.StartTransaction())
            {
                var pline = (Polyline)tr.GetObject(result.ObjectId, OpenMode.ForRead);
                if (pline.HasBulges)
                {
                    tr.GetObject(result.ObjectId, OpenMode.ForWrite);
                    ArcToSegments(pline, 100.0);
                }
                tr.Commit();
            }
        }



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

0 Likes

tristan.jonas8XAAW
Advocate
Advocate

Ok Gile I converted it to .NET and made a tweak and it works like a charm. I'll post the final version and explained what I had to change and why:

 <CommandMethod("TEST")>
        Public Shared Sub Test()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim options As New PromptEntityOptions(vbLf & "Select Polyline: ")
            options.SetRejectMessage(vbLf & "Must be a Polyline.")
            options.AddAllowedClass(GetType(Polyline), True)
            Dim result As PromptEntityResult = ed.GetEntity(options)

            If result.Status <> PromptStatus.OK Then Return

            Using tr As Transaction = db.TransactionManager.StartTransaction()
                Dim pline As Polyline = CType(tr.GetObject(result.ObjectId, OpenMode.ForRead), Polyline)

                If pline.HasBulges Then
                    tr.GetObject(result.ObjectId, OpenMode.ForWrite)
                    ArcToSegments(pline, 100.0)
                End If

                tr.Commit()
            End Using
        End Sub

        Private Shared Sub ArcToSegments(ByVal pline As Polyline, ByVal intervalMax As Double)
            Dim numberOfSegments As Integer = If(pline.Closed, pline.NumberOfVertices, pline.NumberOfVertices - 1)
            Dim plane As New Plane(Point3d.Origin, pline.Normal)
            Dim i As Integer = 0

            While i < numberOfSegments
                If pline.GetSegmentType(i) = SegmentType.Arc Then
                    Dim points As New Point2dCollection()
                    Dim param As Double = pline.GetParameterAtPoint(pline.GetPoint3dAt(i))
                    Dim arcLength As Double = pline.GetDistanceAtParameter(param + 1.0) - pline.GetDistanceAtParameter(param)
                    Dim numIntervals As Integer = CInt(Math.Ceiling(arcLength / intervalMax))
                    Dim increment As Double = 1.0 / numIntervals

                    For j As Integer = 1 To numIntervals - 1
                        points.Add(pline.GetPointAtParameter(param + j * increment).Convert2d(plane))
                    Next

                    pline.SetBulgeAt(i, 0.0)

                    For Each pt As Point2d In points
                        i += 1
                        numberOfSegments += 1
                        pline.AddVertexAt(i, pt, 0.0, 0.0, 0.0)
                    Next
                End If
                i += 1
            End While
        End Sub


So when I converted the code and originally tested it it worked very close, the only thing was that when I clicked an object with polylines it would redraw the first arc in the polyline according to my specifications but it would redraw every subsequent arc as arcs, not as the staggered polyline I wanted. I noticed though if I rand the test on it again, it would fix the next arc but leave the one after it again. So it seemed like something may have been going on with the loop.

I replaced the "For i As Integer = 0 To numberOfSegments - 1" loop with a "While i < numberOfSegments" loop, so that the "i" counter can be incremented within the loop itself. After that it seemed to work in all use cases. Bravo, thank you both for your help.

0 Likes

_gile
Mentor
Mentor

This is a difference in behavior between C# and VB with the "for" statement. In C#, the limit condition of the loop is evaluated at each iteration. In VB.NET, it is only evaluated at the loop entry.



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

tristan.jonas8XAAW
Advocate
Advocate

I hate to be a bother but this is the last finish line I need to cross and it's eternally done, once again nobody has to write me code, it's appreciated but I know it's effort and the right direction is all I need.

The basic idea of the functions I wrote is, one of the parameters for ProcessPolylineWithArcs is pointsOnOtherPolylines which is a list of endpoints that may or may not fall on one of the arcs we're iterating through, and if one of those points ends up being the case, we want to insert that vertex in between the most sensible consecutive points on the arc in the polyline supplied by the polylineId. It was working perfectly but adding the new points may have broken it. It was iterating cleanly before but now it seems to "skip" now:




 

 

Private Function ProcessPolylineWithArcs(ByVal tr As Transaction, ByVal polylineId As ObjectId) As ObjectId
        Dim pline As Polyline = CType(tr.GetObject(polylineId, OpenMode.ForRead), Polyline)
        Dim updatedPline As Polyline = CType(pline.Clone(), Polyline)

        If pline.HasBulges Then
            ArcToSegments(updatedPline, 100.0)
        End If

        Dim curSpace As BlockTableRecord = CType(tr.GetObject(pline.Database.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
        curSpace.AppendEntity(updatedPline)
        tr.AddNewlyCreatedDBObject(updatedPline, True)

        Return updatedPline.ObjectId
    End Function



    Private Shared Sub ArcToSegments(ByVal pline As Polyline, ByVal intervalMax As Double)
        Dim numberOfSegments As Integer = If(pline.Closed, pline.NumberOfVertices, pline.NumberOfVertices - 1)
        Dim plane As New Plane(Point3d.Origin, pline.Normal)
        Dim i As Integer = 0
        While i < numberOfSegments
            If pline.GetSegmentType(i) = SegmentType.Arc Then
                Dim points As New Point2dCollection()
                Dim param As Double = pline.GetParameterAtPoint(pline.GetPoint3dAt(i))
                Dim arcLength As Double = pline.GetDistanceAtParameter(param + 1.0) - pline.GetDistanceAtParameter(param)
                Dim numIntervals As Integer = CInt(Math.Ceiling(arcLength / intervalMax))
                Dim increment As Double = 1.0 / numIntervals

                For j As Integer = 1 To numIntervals - 1
                    points.Add(pline.GetPointAtParameter(param + j * increment).Convert2d(plane))
                Next
                pline.SetBulgeAt(i, 0.0)

                For Each pt As Point2d In points
                    i += 1
                    numberOfSegments += 1
                    pline.AddVertexAt(i, pt, 0.0, 0.0, 0.0)
                Next
            End If
            i += 1
        End While
    End Sub

    Private Function PointOnOtherPolylineAndNotEndpoint(point As Point3d, polylineObjectId As ObjectId, selectedPolylineIds As List(Of ObjectId)) As Boolean
        For Each objectId As ObjectId In selectedPolylineIds
            If objectId <> polylineObjectId Then
                Using tr = polylineObjectId.Database.TransactionManager.StartTransaction()
                    Dim otherPline As Polyline = CType(tr.GetObject(objectId, OpenMode.ForRead), Polyline)

                    ' Check if the point is on the polyline
                    If IsPointOnCurveGCP(otherPline, point) Then
                        ' Check if the point is not an endpoint of the polyline
                        If Not point.IsEqualTo(otherPline.StartPoint, Tolerance.Global) AndAlso
                    Not point.IsEqualTo(otherPline.EndPoint, Tolerance.Global) Then
                            Return True
                        End If
                    End If
                End Using
            End If
        Next
        Return False
    End Function

    Private Function IsPointOnCurveGCP(ByVal curve As Curve, ByVal point As Point3d) As Boolean
        Dim param As Double
        Dim closestPoint As Point3d = curve.GetClosestPointTo(point, param)

        Return closestPoint.IsEqualTo(point, Tolerance.Global)
    End Function

 

 

 

I also got a working version of the concept to function below but for the life of me I cannot get it to translate to the above code.




 

 

<CommandMethod("AddPointToArcPline")>
    Public Sub AddPointToArcPline()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        Dim peo As New PromptEntityOptions(vbLf & "Select polyline containing an arc: ")
        peo.SetRejectMessage("Selected entity is not a polyline.")
        peo.AddAllowedClass(GetType(Polyline), True)
        Dim per As PromptEntityResult = ed.GetEntity(peo)

        If per.Status <> PromptStatus.OK Then
            Return
        End If

        Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select a point on the entity: ")

        If ppr.Status <> PromptStatus.OK Then
            Return
        End If

        Dim pickedPoint As Point3d = ppr.Value

        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Dim pline As Polyline = tr.GetObject(per.ObjectId, OpenMode.ForWrite)
            Dim newPline As Polyline = PlineToLinear2(pline, pickedPoint, 100)
            pline.Erase()

            Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
            Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
            btr.AppendEntity(newPline)
            tr.AddNewlyCreatedDBObject(newPline, True)

            tr.Commit()
        End Using
    End Sub




    Public Shared Function PlineToLinear2(ByVal pline As Polyline, ByVal pickedPoint As Point3d, ByVal Optional interval As Double = 100) As Polyline

        Dim newPline As Polyline = New Polyline()
        Dim onum As Integer = pline.NumberOfVertices
        Dim plan As Plane = New Plane()

        For i As Integer = 0 To onum - 1
            Dim bulge = pline.GetBulgeAt(i)

            If bulge = 0 Or i = onum - 1 Then
                newPline.AddVertexAt(newPline.NumberOfVertices, pline.GetPoint2dAt(i), 0, 0, 0)
            Else
                Dim dist1 As Double = pline.GetDistanceAtParameter(i)
                Dim dist2 As Double = pline.GetDistanceAtParameter(i + 1)
                Dim arcseglength As Double = dist2 - dist1
                Dim num As Integer = CInt((arcseglength / interval))
                Dim pickedPointInserted As Boolean = False

                For j As Integer = 0 To num
                    Dim currentDist As Double = Math.Min(dist1 + j * interval, pline.Length)
                    Dim pt As Point2d = pline.GetPointAtDist(currentDist).Convert2d(plan)
                    Dim nextDist As Double = Math.Min(dist1 + (j + 1) * interval, pline.Length)
                    Dim nextPt As Point2d = pline.GetPointAtDist(nextDist).Convert2d(plan)

                    newPline.AddVertexAt(newPline.NumberOfVertices, pt, 0, 0, 0)

                    If Not pickedPointInserted AndAlso IsPointBetween(pickedPoint.Convert2d(plan), pt, nextPt) Then
                        newPline.AddVertexAt(newPline.NumberOfVertices, pickedPoint.Convert2d(plan), 0, 0, 0)
                        pickedPointInserted = True
                    End If
                Next

            End If
        Next
        Return newPline
    End Function

    Public Shared Function IsPointBetween(testPoint As Point2d, startPoint As Point2d, endPoint As Point2d) As Boolean
        Dim vec1 As Vector2d = testPoint - startPoint
        Dim vec2 As Vector2d = endPoint - startPoint

        ' Check if the test point is in the same direction as the endPoint relative to the startPoint
        If vec1.DotProduct(vec2) < 0 Then
            Return False
        End If

        ' Check if the test point is closer to the startPoint than the endPoint is
        If vec1.Length > vec2.Length Then
            Return False
        End If

        Return True
    End Function


Lastly I'm sorry if this is code overload but I'm trying to be thorough, here's the main command, basically you click the entities and press enter and it will draw 6 offset lines that meld pretty nicely into one another. But yes here is the main code, the portion above is for writing the 'skeleton' of what will be artificially lengthened and offset and connected together into said lines:



    <CommandMethod("BRDRS")>
    Public Sub BRDRS_Main()

        Dim layerName As String = "MVIEW"

        If Not LayerExists(layerName) Then
            Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage("Error: Layer """ & layerName & """ does not exist." & vbCrLf)
            Return
        End If

        Dim doc = Application.DocumentManager.MdiActiveDocument
        Dim db = doc.Database
        Dim ed = doc.Editor

        Dim filter = New SelectionFilter({New TypedValue(0, "ARC,LINE,LWPOLYLINE")})
        Dim selection = ed.GetSelection(filter)
        If selection.Status <> PromptStatus.OK Then Return

        Dim baseOffsetDistance As Double = 100.0
        Dim numOffsets As Integer = 6
        Dim offsetStep As Double = 50.0

        Using tr = db.TransactionManager.StartTransaction()
            Dim curSpace = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

            Dim polylineIds As New List(Of ObjectId)()

            Dim pointsOnOtherPolylines As New List(Of Point3d)()
            Dim overlappingEndpoints As New List(Of Point3d)()

            For Each objectId In selection.Value.GetObjectIds()
                Dim entity As Entity = tr.GetObject(objectId, OpenMode.ForRead)
                Dim pline As Polyline

                If TypeOf entity Is Line OrElse TypeOf entity Is Arc Then
                    pline = ConvertToPolyline(CType(entity, Curve))
                Else
                    pline = CType(entity, Polyline)
                End If

                ' Process the polyline with the new function by determind whether or not the polyline selected has an arc inside it
                Dim hasArc As Boolean = False

                Dim otherPolylineEndpoints As New List(Of Point3d)()

                For Each otherObjectId In polylineIds
                    If objectId <> otherObjectId Then
                        Dim otherPline As Polyline = tr.GetObject(otherObjectId, OpenMode.ForRead)
                        otherPolylineEndpoints.Add(otherPline.StartPoint)
                        otherPolylineEndpoints.Add(otherPline.EndPoint)
                    End If
                Next

                For index As Integer = 0 To pline.NumberOfVertices - 2
                    If pline.GetSegmentType(index) = SegmentType.Arc Then
                        hasArc = True
                        Exit For
                    End If
                Next

                If hasArc Then
                    For Each otherEndpoint In otherPolylineEndpoints
                        If pline.IsPointOnPolyline(otherEndpoint) AndAlso Not IsEndpoint(otherEndpoint, pline) Then
                            pointsOnOtherPolylines.Add(otherEndpoint)
                        End If
                    Next
                End If

                ' Check if the endpoints have the same coordinates as another polyline's endpoint
                For Each otherObjectId In polylineIds
                    If objectId <> otherObjectId Then
                        Dim otherPline As Polyline = tr.GetObject(otherObjectId, OpenMode.ForRead)

                        If pline.StartPoint.IsEqualTo(otherPline.StartPoint, Tolerance.Global) OrElse
            pline.StartPoint.IsEqualTo(otherPline.EndPoint, Tolerance.Global) Then
                            overlappingEndpoints.Add(pline.StartPoint)
                        End If

                        If pline.EndPoint.IsEqualTo(otherPline.StartPoint, Tolerance.Global) OrElse
            pline.EndPoint.IsEqualTo(otherPline.EndPoint, Tolerance.Global) Then
                            overlappingEndpoints.Add(pline.EndPoint)
                        End If
                    End If
                Next

                ' Print the lists of coordinates
                For Each point In pointsOnOtherPolylines
                    ed.WriteMessage(vbLf & "Endpoint on another polyline:  {0}", point.ToString())
                Next

                For Each point In overlappingEndpoints
                    ed.WriteMessage(vbLf & "Overlapping endpoint:  {0}", point.ToString())
                Next

                Dim processedPlineId As ObjectId
                If hasArc Then
                    processedPlineId = ProcessPolylineWithArcs(tr, pline.ObjectId)
                Else
                    processedPlineId = pline.ObjectId
                End If
                polylineIds.Add(processedPlineId)

            Next

            Dim polylineIntersections As New Dictionary(Of ObjectId, List(Of Point3d))()

            For Each objectId In polylineIds
                Dim pline As Polyline = tr.GetObject(objectId, OpenMode.ForRead)
                Dim otherEndpoints = FindIntersections(pline, polylineIds.ToArray())
                polylineIntersections.Add(objectId, otherEndpoints)
            Next

            For i = 0 To numOffsets - 1
                Dim offsetDistance = baseOffsetDistance + (i * offsetStep)
                Dim region = polylineIds.Select(Function(id) CType(tr.GetObject(id, OpenMode.ForRead), Polyline)).Select(Function(originalPline)
                                                                                                                             Dim cleanedPoints = GetCleanedPointsFromPolyline(originalPline)
                                                                                                                             Dim newPline As New Polyline()
                                                                                                                             For index As Integer = 0 To cleanedPoints.Count - 1
                                                                                                                                 newPline.AddVertexAt(index, cleanedPoints(index), 0, 0, 0)
                                                                                                                             Next

                                                                                                                             Dim otherCurvesEndpoints = polylineIntersections(originalPline.ObjectId)
                                                                                                                             Dim extendedPline = ExtendCurve(newPline, offsetDistance, otherCurvesEndpoints)

                                                                                                                             Return CreateRegionFromCurves(CreateBoundary(extendedPline, offsetDistance))
                                                                                                                         End Function).Aggregate(Function(r1, r2)
                                                                                                                                                     r1.BooleanOperation(BooleanOperationType.BoolUnite, r2)
                                                                                                                                                     r2.Dispose()
                                                                                                                                                     Return r1
                                                                                                                                                 End Function)

                Dim pline = RegionToPolyline(region)

                curSpace.AppendEntity(pline)
                tr.AddNewlyCreatedDBObject(pline, True)
            Next

            tr.Commit()
        End Using
    End Sub





 

 




0 Likes

cuongtk2
Advocate
Advocate

Sorry I can't communicate in English. I can only express through c# code how to do it.

0 Likes

tristan.jonas8XAAW
Advocate
Advocate

Sorry, didn't mean to make it sound like you aren't allowed to use code, you may if that's your preference 🙂

0 Likes