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