Get projected distance at motion(Kinematics)

Dear All,

I'm trying to measure projection distance at motion, I just found out measure method by using Measure on Slove. but this is very slow. so I added uf measure command at articulationControl1.
Joint 1 : Slide
Joint 2 : Revolve
Joint 3 : Slide

but the result of distacnes are same for each position. I think the distance is design position(Orjinal position), so how can I solve this issue? How can I access the each position and measure proejction distance(ex. Y axis)?

Thansk

Imports System
Imports NXOpen
Imports NXOpen.UF

Module NXJournal

Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()
Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim myufs As NXOpen.UF.UFSession = NXOpen.UF.UFSession.GetUFSession
Dim displayPart As NXOpen.Part = theSession.Parts.Display

Sub Main(ByVal args() As String)

Dim height_lower_Limit As Double = -20
Dim height_upper_Limit As Double = 25
Dim Slide_foremost_Limit As Double = 200
Dim Silde_rearmost_Limit As Double = -60

Dim tilt_lower_limit As Double = -3.5
Dim tilt_upper_limit As Double = 3.5

Dim Slide_count_step As Double = 100
Dim Height_count_tep As Double = 45
Dim Tilt_count_step As Double = 3.5

Dim motionSolution1 As NXOpen.Motion.MotionSolution = CType(workPart.MotionManager.MotionSolutions.FindObject("Solution_1"), NXOpen.Motion.MotionSolution)

Dim articulationControl1 As NXOpen.Motion.ArticulationControl = Nothing
articulationControl1 = motionSolution1.GetArticulationControl()
theSession.MotionSession.PostProcess.SetInterferenceOption(False)

theSession.MotionSession.PostProcess.SetMeasureOption(False)
theSession.MotionSession.PostProcess.SetSpeed(100000)
theSession.MotionSession.PostProcess.SetTraceOption(False)

theSession.MotionSession.PostProcess.SetStopOnEventOption(False)

articulationControl1.ActiveView = NXOpen.Motion.ActiveView.All

articulationControl1.Delay = 0

articulationControl1.JointsLimits = True

Dim Select_1() As TaggedObject = Nothing
Dim Select_2() As TaggedObject = Nothing

Select_1 = Nothing
Select_2 = Nothing
SelectObjects("First Objects", Select_1)
SelectObjects("Second Objects", Select_2)

Dim Select_one As TaggedObject = Nothing
Dim Select_two As TaggedObject = Nothing
Select_one = Select_1(0)
Select_two = Select_2(0)

'Track slide joint
Dim TrackSlideTag(0) As NXOpen.Motion.Joint
Dim TrackSlideJoint As NXOpen.Motion.Joint = CType(workPart.MotionManager.Joints.FindObject("J001"), NXOpen.Motion.Joint)
TrackSlideTag(0) = TrackSlideJoint
Dim TrackSlideDisplacement(0) As Double
Dim TrackSlideDisplacementUnit(0) As NXOpen.Unit
Dim unit1 As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), NXOpen.Unit)
TrackSlideDisplacementUnit(0) = unit1

'Height Slide joint
Dim HeightSlideTag(0) As NXOpen.Motion.Joint
Dim HeightSlideJoint As NXOpen.Motion.Joint = CType(workPart.MotionManager.Joints.FindObject("J008"), NXOpen.Motion.Joint)
HeightSlideTag(0) = HeightSlideJoint
Dim HeightSlideDisplacement(0) As Double
Dim HeightSlideDisplacementunit(0) As NXOpen.Unit
Dim unit2 As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), NXOpen.Unit)
HeightSlideDisplacementunit(0) = unit2

'Tilt revolue joint
Dim TiltRotationTag(0) As NXOpen.Motion.Joint
Dim TiltRotationJoint As NXOpen.Motion.Joint = CType(workPart.MotionManager.Joints.FindObject("J006"), NXOpen.Motion.Joint)
TiltRotationTag(0) = TiltRotationJoint
Dim TiltRotationDisplacement(0) As Double
Dim TiltRotationDisplacementunit(0) As NXOpen.Unit
Dim unit3 As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), NXOpen.Unit)

TiltRotationDisplacementunit(0) = unit3
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For Slide As Double = Silde_rearmost_Limit To Slide_foremost_Limit Step Slide_count_step
TrackSlideDisplacement(0) = Slide
articulationControl1.ArticulationSolve(TrackSlideTag, TrackSlideDisplacement, TrackSlideDisplacementUnit)

For height As Double = height_lower_Limit To height_upper_Limit Step Height_count_tep
HeightSlideDisplacement(0) = height
articulationControl1.ArticulationSolve(HeightSlideTag, HeightSlideDisplacement, HeightSlideDisplacementunit)

For Tilt As Double = tilt_lower_limit To tilt_upper_limit Step Tilt_count_step
TiltRotationDisplacement(0) = Tilt
articulationControl1.ArticulationSolve(TiltRotationTag, TiltRotationDisplacement, TiltRotationDisplacementunit)
articulationControl1.Stop()

Dim accuracy As Double = 0.99999
Dim pt1 As Point3d = Nothing
Dim pt2 As Point3d = Nothing

Dim theMeasurement As NXOpen.Measurement = NXOpen.Session.GetSession.Measurement
Dim Measure_result As Double

Measure_result = theMeasurement.GetMinimumDistance(Select_one, Select_two, pt1, pt2, accuracy)

Dim line1 As NXOpen.Line = workPart.Curves.CreateLine(pt1, pt2)
Guide.InfoWriteLine(" First Object Tag : " & Select_one.ToString)
Guide.InfoWriteLine(" Second Tag : " & Select_two.ToString)
Guide.InfoWriteLine("Slide positon : " & Slide)
Guide.InfoWriteLine("Height positon : " & height)
Guide.InfoWriteLine(" Distance: " & Measure_result)

Next Tilt

Next height

Next Slide

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

theSession.MotionSession.PostProcess.ListMeasure()

articulationControl1.Finish()

theSession.CleanUpFacetedFacesAndEdges()

End Sub

Function SelectObjects(ByVal prompt As String, ByRef selObj() As TaggedObject) As Selection.Response

Dim theUI As NXOpen.UI = NXOpen.UI.GetUI
Dim title As String = "Selection"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction =
Selection.SelectionAction.ClearAndEnableSpecific

Dim scope As Selection.SelectionScope = Selection.SelectionScope.AnyInAssembly
Dim selectionMask_array(7) As Selection.MaskTriple

With selectionMask_array(0)
.Type = UFConstants.UF_point_type
.Subtype = 0
.SolidBodySubtype = 0
End With

With selectionMask_array(1)
.Type = UFConstants.UF_line_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With selectionMask_array(2)
.Type = UFConstants.UF_circle_type
.Subtype = 0
.SolidBodySubtype = 0
End With

With selectionMask_array(3)
.Type = UFConstants.UF_face_type
.Subtype = 0
.SolidBodySubtype = 0
End With

With selectionMask_array(4)
.Type = UFConstants.UF_solid_type
.Subtype = 0
.SolidBodySubtype = 0
End With

With selectionMask_array(5)
.Type = UFConstants.UF_plane_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With selectionMask_array(6)
.Type = UFConstants.UF_datum_plane_type
.Subtype = 0
.SolidBodySubtype = 0
End With

With selectionMask_array(7)
.Type = UFConstants.UF_spline_type
.Subtype = 0
.SolidBodySubtype = 0
End With

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObjects(prompt, title, scope, selAction, includeFeatures, keepHighlighted, selectionMask_array, selObj)

If resp = Selection.Response.Ok Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Function Get_infor_line(ByVal input_value As Integer, ByVal nxobject As NXObject) As Point3d
Dim stPt(2) As Double
Dim edPt(2) As Double
Dim junk3(2) As Double
Dim junk1 As Double
myufs.Modl.AskCurveProps(nxobject.Tag, input_value, stPt, junk3, junk3, junk3, junk1, junk1)
Dim newStartPoint As Point3d = New Point3d(stPt(0), stPt(1), stPt(2))
Return newStartPoint

End Function

Structure Original_curves
Dim Type_Str As String
Dim Output_object As Line
Dim Index_cnt As Integer
Dim Start_Point As Point3d
Dim Mid_Point As Point3d
Dim End_Point As Point3d
Dim Checked_status As Boolean
End Structure

End Module