Hi David,
Start with this. It's not tested, but shows what I meant.
Note that it is totally independent of whether either alignment is or isn't
curved at the intersection point.
--
Regards,
Laurie Comerford
www.cadapps.com.au
Sub CrossingAlignments()
Dim oAlign1 As AeccAlignment
Dim oAlign2 As AeccAlignment
Dim dChn1 As Double
Dim dChn2 As Double
Dim dOff1 As Double
Dim dOff2 As Double
Dim dAzi1 As Double
Dim dAzi2 As Double
Dim dEast As Double
Dim dNorth As Double
' Use what ever suitable method you have to set the two alignments
Set oAlign1 = AeccApplication.ActiveProject.Alignments.Item(0)
Set oAlign1 = AeccApplication.ActiveProject.Alignments.Item(1)
''' Set chn1 to a reasonable value here
On Error GoTo ErrorHandler
oAlign1.PointLocation chn1, dOff1, dEast, dNorth, dAzi1
oAlign2.StationOffset dEast, dNorth, chn1, dOff2, dAzi2
Do While dOff2 < 0.001 ' Or whatever tolerance you want
dOff2 = dOff2 / Sin(dAzi1 - dAzi2) ' You might want to sketch the
geometry to confirm my guesswork
chn1 = chn1 + dOff2 ' Since I haven't tested this you may need to
replace the "+" with a "-" or allow for both
oAlign1.PointLocation chn1, dOff1, dEast, dNorth, dAzi1
oAlign2.StationOffset dEast, dNorth, chn1, dOff2, dAzi2
Loop
ErrorHandler:
MsgBox "Possibly the alignments don't intersection in the vicinity of the
starting chainage"
End Sub ' CrossingAlignments
"David Urban" wrote in message
news:424a1ebd$1_3@newsprd01...
> Laurie
>
> I am alittle confused by your suggestion. here is what I came up with. I
> works great if the current alignment crosses the curve or if it ends on
> the inside of the curve but not on the outside of the curve. let me know
> what you think. This code is alittle/alot slow.
>
> thanks
>
> David
>
> the curve is the curve on the intersecting alignment ie align2.
> align is the current alignment and is a global variable.
>
> Private Function curveintersection(curve As AeccAlignCurve, align2 As
> AeccAlignment, crossing As Variant) As Boolean
> Dim dStart(2) As Double, dEnd(2) As Double
> Dim StaOffDirS(2) As Double, Polarpt As Variant
> Dim crossings As Variant, xy(2) As Double
> ReDim crossing(3)
> Dim x As Integer
>
> On Error Resume Next
> For x = curve.StartingStation To curve.EndingStation + 1 Step curve.length
> / 10
> align2.PointLocation x, 0, dStart(0), dStart(1), 0
> align2.PointLocation x + 1, 0, dEnd(0), dEnd(1), 0
> crossings = align.LineIntersection(dStart(0), dStart(1), dEnd(0),
> dEnd(1))
> If Err.number = 0 Then
> Err.clear
> align2.StationOffset crossings(2), crossings(3), StaOffDirS(0),
> StaOffDirS(1), StaOffDirS(2)
> xy(0) = crossings(2): xy(1) = crossings(3)
> Polarpt = pUtil.PolarPoint(xy, crossings(1), StaOffDirS(1))
> xy(0) = Polarpt(0): xy(1) = Polarpt(1)
> align.StationOffset xy(0), xy(1), StaOffDirS(0), StaOffDirS(1),
> StaOffDirS(2)
> If Err.number = 0 Then
> If Abs(StaOffDirS(1)) < 0.1 Then
> crossing(0) = StaOffDirS(0): crossing(1) = StaOffDirS(1):
> crossing(2) = xy(0): crossing(3) = xy(1)
> curveintersection = True
> Exit For
> End If
> End If
> End If
> Err.clear
> Next x
>
>
> End Function
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
