Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations cowski on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Looking for a journal which gives total length of cable 3

Status
Not open for further replies.

NXsupport

Computer
Apr 11, 2008
251
Hi,

NX8.5.3

Iam looking for a journal file which would work for NX8.5 and above , which would allow the user to select a unparametrized cable in 3D and give the total length.

I saw some journal on NXJournaling site, but that is specific for tube feature..

Any help and support is much appreciated..
 
Replies continue below

Recommended for you

Some code close to what you want can be found here:

I modified it slightly to report the length. Code originally written by Frank Swinkels (aka FrankSwinks).

Code:
'Author: Frank Swinkels
'for use only with NX 8 or above
'Create approximate centerline of B-surface "tube"
'user will be prompted to select B-surface, a 'through points' studio spline will be created along the centerline

'  modified June 12, 2014
'  NXJournaling.com
'    Report length of selected tube.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Features
Imports System.IO

Module CableCentreline

    Dim s As Session = Session.GetSession()
    Dim ufs As UFSession = UFSession.GetUFSession()
    Dim workPart As Part = s.Parts.Work
    Dim lw As ListingWindow = s.ListingWindow
    Sub Main()
        Dim no_pts As Integer = Nothing
        Dim pos1 As Integer = Nothing
        Dim junk3(2) As Double
        Dim junk2(1) As Double
        Dim periodic1 As Boolean = False
        Dim theFace As Face = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        Dim type1 As Integer = Nothing
        Dim subtype1 As Integer = Nothing
        Dim bsurface1 As UFModl.Bsurface = Nothing
        lw.Open()
start1:
        response1 = select_a_face("Select a tube extracted face or dumb solid face", theFace)
        If response1 = Selection.Response.Cancel Or response1 = Selection.Response.Back Then GoTo end1
        ' check that it is a bsurface
        Try
            ufs.Modl.AskBsurf(theFace.Tag, bsurface1)
        Catch ex As Exception
            MsgBox("The selected face is not a BSurface")
            GoTo start1
        End Try
        Dim noPolesV As Integer = bsurface1.num_poles_v
        Dim noPolesU As Integer = bsurface1.num_poles_u
        Dim poles1(,) As Double = bsurface1.poles
        Dim knotsU() As Double = bsurface1.knots_u
        Dim knotsV() As Double = bsurface1.knots_v
        Dim orderU As Integer = bsurface1.order_u
        Dim orderV As Integer = bsurface1.order_v
        Dim ptno As Integer = Nothing
        Dim params(1) As Double
        Dim pnt0(2) As Double
        Dim pnt1(2) As Double
        Dim pnt2(2) As Double
        Dim pnt3(2) As Double
        Dim vec0(2) As Double
        Dim vec1(2) As Double
        Dim vec2(2) As Double
        Dim vec3(2) As Double
        Dim rads(1) As Double
        Dim tolerance1 As Double = 0.001
        Dim magnitude1 As Double = Nothing
        Dim degree3 As Integer = orderV - 1
        Dim pointtag As Tag = Tag.Null
        Dim ArrayOfPoints(-1) As Point
        Dim uparm() As Double = {0.0, 0.25, 0.5, 0.75}
        Dim delta1 As Double
        Dim sum1 As Double = Nothing
        Dim distance1 As Double = Nothing
        Dim cnt1 As Integer = 0
        Dim tempcpt(2) As Double
        Dim coordinates1 As Point3d
        ' tube bsurf u around tube, v along the tube
        Dim vparm(noPolesV - 1) As Double
        vparm(0) = 0.0
        vparm(noPolesV - 1) = 1.0
        Dim lengths(noPolesV - 2) As Double
        sum1 = 0.0
        cnt1 = 0
        For i As Integer = noPolesU To noPolesU * noPolesV - 1 Step noPolesU
            pnt1(0) = poles1(i, 0)
            pnt1(1) = poles1(i, 1)
            pnt1(2) = poles1(i, 2)
            pnt2(0) = poles1(i - noPolesU, 0)
            pnt2(1) = poles1(i - noPolesU, 1)
            pnt2(2) = poles1(i - noPolesU, 2)
            ufs.Vec3.Distance(pnt1, pnt2, distance1)
            lengths(cnt1) = distance1
            cnt1 += 1
            sum1 += distance1
        Next
        delta1 = 0.0
        For i As Integer = 0 To noPolesV - 2
            delta1 += lengths(i)
            vparm(i + 1) = delta1 / sum1
        Next
        For i As Integer = 0 To noPolesV - 1
            params(0) = uparm(0)
            params(1) = vparm(i)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt0, vec0, junk3, junk3, junk3, junk3, rads)
            ufs.Vec3.Unitize(vec0, tolerance1, magnitude1, vec0)
            params(0) = uparm(1)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt1, vec1, junk3, junk3, junk3, junk3, rads)
            params(0) = uparm(2)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt2, vec2, junk3, junk3, junk3, junk3, rads)
            params(0) = uparm(3)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt3, vec3, junk3, junk3, junk3, junk3, rads)
            ufs.Vec3.Add(pnt0, pnt1, tempcpt)
            ufs.Vec3.Add(pnt2, tempcpt, tempcpt)
            ufs.Vec3.Add(pnt3, tempcpt, tempcpt)
            tempcpt(0) /= 4.0
            tempcpt(1) /= 4.0
            tempcpt(2) /= 4.0
            coordinates1 = New Point3d(tempcpt(0), tempcpt(1), tempcpt(2))
            ReDim Preserve ArrayOfPoints(i)
            ArrayOfPoints(i) = workPart.Points.CreatePoint(coordinates1)
        Next
        periodic1 = False
        Dim myStudioSpline As Features.StudioSpline
        myStudioSpline = CreateStudioSplineThruPoints(ArrayOfPoints, degree3)
        Dim tubeLength As Double = 0
        For Each tempCurve As Curve In myStudioSpline.GetEntities
            tubeLength += tempCurve.GetLength
        Next
        lw.WriteLine("tube length: " & tubeLength)

        GoTo start1
end1:
    End Sub

    Function select_a_face(ByRef prompt As String, ByRef face1 As Face) As Selection.Response
        Dim mask(0) As Selection.MaskTriple
        With mask(0)
            .Type = UFConstants.UF_solid_type
            .Subtype = 0
            .SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
        End With
        Dim cursor As Point3d = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        select_a_face = Nothing
        response1 = UI.GetUI.SelectionManager.SelectTaggedObject(prompt, "Select the Face", _
            Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, False, _
            False, mask, face1, cursor)
        Return response1
    End Function

    Public Function CreateStudioSplineThruPoints(ByRef points() As Point, ByVal degree3 As Integer) As Features.StudioSpline
        Dim markId9 As Session.UndoMarkId
        markId9 = s.SetUndoMark(Session.MarkVisibility.Visible, "Studio Spline Thru Points")
        Dim Pcount As Integer = points.Length - 1
        Dim nullFeatures_StudioSpline As Features.StudioSpline = Nothing
        Dim studioSplineBuilderex1 As Features.StudioSplineBuilderEx
        studioSplineBuilderex1 = workPart.Features.CreateStudioSplineBuilderEx(nullFeatures_StudioSpline)
        studioSplineBuilderex1.OrientExpress.ReferenceOption = GeometricUtilities.OrientXpressBuilder.Reference.ProgramDefined
        studioSplineBuilderex1.Degree = degree3
        studioSplineBuilderex1.OrientExpress.AxisOption = GeometricUtilities.OrientXpressBuilder.Axis.Passive
        studioSplineBuilderex1.OrientExpress.PlaneOption = GeometricUtilities.OrientXpressBuilder.Plane.Passive
        studioSplineBuilderex1.MatchKnotsType = Features.StudioSplineBuilderEx.MatchKnotsTypes.None
        Dim knots1(-1) As Double
        studioSplineBuilderex1.SetKnots(knots1)
        Dim parameters1(-1) As Double
        studioSplineBuilderex1.SetParameters(parameters1)
        Dim nullDirection As Direction = Nothing
        Dim nullScalar As Scalar = Nothing
        Dim nullOffset As Offset = Nothing
        Dim geometricConstraintData(Pcount) As Features.GeometricConstraintData
        For ii As Integer = 0 To Pcount
            geometricConstraintData(ii) = studioSplineBuilderex1.ConstraintManager.CreateGeometricConstraintData()
            geometricConstraintData(ii).Point = points(ii)
            geometricConstraintData(ii).AutomaticConstraintDirection = Features.GeometricConstraintData.ParameterDirection.Iso
            geometricConstraintData(ii).AutomaticConstraintType = Features.GeometricConstraintData.AutoConstraintType.Tangent
            geometricConstraintData(ii).TangentDirection = nullDirection
            geometricConstraintData(ii).TangentMagnitude = nullScalar
            geometricConstraintData(ii).Curvature = nullOffset
            geometricConstraintData(ii).CurvatureDerivative = nullOffset
            geometricConstraintData(ii).HasSymmetricModelingConstraint = False
        Next ii
        studioSplineBuilderex1.ConstraintManager.SetContents(geometricConstraintData)
        Dim feature1 As Features.StudioSpline
        feature1 = studioSplineBuilderex1.CommitFeature()
        studioSplineBuilderex1.Destroy()

        Return feature1

    End Function

    Public Function GetUnloadOption(ByVal dummy As String) As Integer
        'Unloads the image when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
    End Function

End Module

www.nxjournaling.com
 
What you are seeing are "leftovers" from the original design. The current design has been trimmed, the splines are being created according to the original, untrimmed version. Also in this design are a few cylindrical faces, which this journal won't let you select. A solution to both these issues is to extract each face of the tube, using the general B-surface option. Hide the original tube, run the journal and select the new faces. The journal will then create splines of the correct length and let you select all sections.

The journal below has been modified slightly to report a 'running total' as you select multiple sections. Alternately, you can just use Analysis -> measure length and select the splines that the journal creates.


Code:
'Author: Frank Swinkels
'for use only with NX 8 or above
'Create approximate centerline of B-surface "tube"
'user will be prompted to select B-surface, a 'through points' studio spline will be created along the centerline

'  modified June 12, 2014
'  NXJournaling.com
'    Report length of selected tube.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Features
Imports System.IO

Module CableCentreline

    Dim s As Session = Session.GetSession()
    Dim ufs As UFSession = UFSession.GetUFSession()
    Dim workPart As Part = s.Parts.Work
    Dim lw As ListingWindow = s.ListingWindow
    Sub Main()
        Dim no_pts As Integer = Nothing
        Dim pos1 As Integer = Nothing
        Dim junk3(2) As Double
        Dim junk2(1) As Double
        Dim periodic1 As Boolean = False
        Dim theFace As Face = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        Dim type1 As Integer = Nothing
        Dim subtype1 As Integer = Nothing
        Dim bsurface1 As UFModl.Bsurface = Nothing
        Dim totalLength As Double = 0
        lw.Open()
start1:
        response1 = select_a_face("Select a tube extracted face or dumb solid face", theFace)
        If response1 = Selection.Response.Cancel Or response1 = Selection.Response.Back Then GoTo end1
        ' check that it is a bsurface
        Try
            ufs.Modl.AskBsurf(theFace.Tag, bsurface1)
        Catch ex As Exception
            MsgBox("The selected face is not a BSurface")
            GoTo start1
        End Try
        Dim noPolesV As Integer = bsurface1.num_poles_v
        Dim noPolesU As Integer = bsurface1.num_poles_u
        Dim poles1(,) As Double = bsurface1.poles
        Dim knotsU() As Double = bsurface1.knots_u
        Dim knotsV() As Double = bsurface1.knots_v
        Dim orderU As Integer = bsurface1.order_u
        Dim orderV As Integer = bsurface1.order_v
        Dim ptno As Integer = Nothing
        Dim params(1) As Double
        Dim pnt0(2) As Double
        Dim pnt1(2) As Double
        Dim pnt2(2) As Double
        Dim pnt3(2) As Double
        Dim vec0(2) As Double
        Dim vec1(2) As Double
        Dim vec2(2) As Double
        Dim vec3(2) As Double
        Dim rads(1) As Double
        Dim tolerance1 As Double = 0.001
        Dim magnitude1 As Double = Nothing
        Dim degree3 As Integer = orderV - 1
        Dim pointtag As Tag = Tag.Null
        Dim ArrayOfPoints(-1) As Point
        Dim uparm() As Double = {0.0, 0.25, 0.5, 0.75}
        Dim delta1 As Double
        Dim sum1 As Double = Nothing
        Dim distance1 As Double = Nothing
        Dim cnt1 As Integer = 0
        Dim tempcpt(2) As Double
        Dim coordinates1 As Point3d
        ' tube bsurf u around tube, v along the tube
        Dim vparm(noPolesV - 1) As Double
        vparm(0) = 0.0
        vparm(noPolesV - 1) = 1.0
        Dim lengths(noPolesV - 2) As Double
        sum1 = 0.0
        cnt1 = 0
        For i As Integer = noPolesU To noPolesU * noPolesV - 1 Step noPolesU
            pnt1(0) = poles1(i, 0)
            pnt1(1) = poles1(i, 1)
            pnt1(2) = poles1(i, 2)
            pnt2(0) = poles1(i - noPolesU, 0)
            pnt2(1) = poles1(i - noPolesU, 1)
            pnt2(2) = poles1(i - noPolesU, 2)
            ufs.Vec3.Distance(pnt1, pnt2, distance1)
            lengths(cnt1) = distance1
            cnt1 += 1
            sum1 += distance1
        Next
        delta1 = 0.0
        For i As Integer = 0 To noPolesV - 2
            delta1 += lengths(i)
            vparm(i + 1) = delta1 / sum1
        Next
        For i As Integer = 0 To noPolesV - 1
            params(0) = uparm(0)
            params(1) = vparm(i)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt0, vec0, junk3, junk3, junk3, junk3, rads)
            ufs.Vec3.Unitize(vec0, tolerance1, magnitude1, vec0)
            params(0) = uparm(1)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt1, vec1, junk3, junk3, junk3, junk3, rads)
            params(0) = uparm(2)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt2, vec2, junk3, junk3, junk3, junk3, rads)
            params(0) = uparm(3)
            ufs.Modl.AskFaceProps(theFace.Tag, params, pnt3, vec3, junk3, junk3, junk3, junk3, rads)
            ufs.Vec3.Add(pnt0, pnt1, tempcpt)
            ufs.Vec3.Add(pnt2, tempcpt, tempcpt)
            ufs.Vec3.Add(pnt3, tempcpt, tempcpt)
            tempcpt(0) /= 4.0
            tempcpt(1) /= 4.0
            tempcpt(2) /= 4.0
            coordinates1 = New Point3d(tempcpt(0), tempcpt(1), tempcpt(2))
            ReDim Preserve ArrayOfPoints(i)
            ArrayOfPoints(i) = workPart.Points.CreatePoint(coordinates1)
        Next
        periodic1 = False
        Dim myStudioSpline As Features.StudioSpline
        myStudioSpline = CreateStudioSplineThruPoints(ArrayOfPoints, degree3)
        Dim tubeLength As Double = 0
        For Each tempCurve As Curve In myStudioSpline.GetEntities
            tubeLength += tempCurve.GetLength
        Next
        totalLength += tubeLength
        lw.WriteLine("section length: " & tubeLength.ToString)
        lw.WriteLine("total length: " & totalLength.ToString)
        lw.WriteLine("")

        GoTo start1
end1:
    End Sub

    Function select_a_face(ByRef prompt As String, ByRef face1 As Face) As Selection.Response
        Dim mask(0) As Selection.MaskTriple
        With mask(0)
            .Type = UFConstants.UF_solid_type
            .Subtype = 0
            .SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
        End With
        Dim cursor As Point3d = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        select_a_face = Nothing
        response1 = UI.GetUI.SelectionManager.SelectTaggedObject(prompt, "Select the Face", _
            Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, False, _
            False, mask, face1, cursor)
        Return response1
    End Function

    Public Function CreateStudioSplineThruPoints(ByRef points() As Point, ByVal degree3 As Integer) As Features.StudioSpline
        Dim markId9 As Session.UndoMarkId
        markId9 = s.SetUndoMark(Session.MarkVisibility.Visible, "Studio Spline Thru Points")
        Dim Pcount As Integer = points.Length - 1
        Dim nullFeatures_StudioSpline As Features.StudioSpline = Nothing
        Dim studioSplineBuilderex1 As Features.StudioSplineBuilderEx
        studioSplineBuilderex1 = workPart.Features.CreateStudioSplineBuilderEx(nullFeatures_StudioSpline)
        studioSplineBuilderex1.OrientExpress.ReferenceOption = GeometricUtilities.OrientXpressBuilder.Reference.ProgramDefined
        studioSplineBuilderex1.Degree = degree3
        studioSplineBuilderex1.OrientExpress.AxisOption = GeometricUtilities.OrientXpressBuilder.Axis.Passive
        studioSplineBuilderex1.OrientExpress.PlaneOption = GeometricUtilities.OrientXpressBuilder.Plane.Passive
        studioSplineBuilderex1.MatchKnotsType = Features.StudioSplineBuilderEx.MatchKnotsTypes.None
        Dim knots1(-1) As Double
        studioSplineBuilderex1.SetKnots(knots1)
        Dim parameters1(-1) As Double
        studioSplineBuilderex1.SetParameters(parameters1)
        Dim nullDirection As Direction = Nothing
        Dim nullScalar As Scalar = Nothing
        Dim nullOffset As Offset = Nothing
        Dim geometricConstraintData(Pcount) As Features.GeometricConstraintData
        For ii As Integer = 0 To Pcount
            geometricConstraintData(ii) = studioSplineBuilderex1.ConstraintManager.CreateGeometricConstraintData()
            geometricConstraintData(ii).Point = points(ii)
            geometricConstraintData(ii).AutomaticConstraintDirection = Features.GeometricConstraintData.ParameterDirection.Iso
            geometricConstraintData(ii).AutomaticConstraintType = Features.GeometricConstraintData.AutoConstraintType.Tangent
            geometricConstraintData(ii).TangentDirection = nullDirection
            geometricConstraintData(ii).TangentMagnitude = nullScalar
            geometricConstraintData(ii).Curvature = nullOffset
            geometricConstraintData(ii).CurvatureDerivative = nullOffset
            geometricConstraintData(ii).HasSymmetricModelingConstraint = False
        Next ii
        studioSplineBuilderex1.ConstraintManager.SetContents(geometricConstraintData)
        Dim feature1 As Features.StudioSpline
        feature1 = studioSplineBuilderex1.CommitFeature()
        studioSplineBuilderex1.Destroy()

        Return feature1

    End Function

    Public Function GetUnloadOption(ByVal dummy As String) As Integer
        'Unloads the image when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
    End Function

End Module

www.nxjournaling.com
 
Hi Cowski,

Can a macro to extract the faces as General B surface be integrated into this Journal? That would make it totally automated..

I know Siemens does not have this tool ( Extract 3D centerline of Spline or cylindrical faces ) in NX..

Thanks..

 
Hi Coswski,

I tried to insert the extract faces as general B surfaces journal into the above journal.. So that It becomes more automated..

Can you please help in this?

Thanks for all the hard work you are doing for me.. :))
 
 http://files.engineering.com/getfile.aspx?folder=3f2c6422-1554-4fb2-805d-f9eddb6ece4e&file=EXTRACTFACES.vb
I agree that it would be a good addition. However, with my current schedule, I cannot make any commitments.

Perhaps if FrankSwinks (the original author of the code) sees this thread he can make some recommendations.

www.nxjournaling.com
 
To create the BSurface make the following changes to your journal

1. Add the following dim lines

Dim extractedfeat1 As Feature = Nothing
Dim extractedbodyfeat1 As BodyFeature = Nothing
Dim extractedbody1() As Body = Nothing
Dim faces() As Face

2. Change the first try catch in main to read

Try
ufs.Modl.AskBsurf(theFace.Tag, bsurface1)
Catch ex As Exception
createExtractedBSurface(theFace, extractedfeat1)
extractedbodyfeat1 = DirectCast(extractedfeat1, BodyFeature)
extractedbody1 = extractedbodyfeat1.GetBodies
faces = extractedbody1(0).GetFaces
ufs.Modl.AskBsurf(faces(0).Tag, bsurface1)
End Try

3. Add the sub

Public Sub createExtractedBSurface(ByVal face1 As Face, ByRef extractedfeat1 As Feature)
Dim nullFeatures_Feature As Features.Feature = Nothing
Dim extractFaceBuilder1 As Features.ExtractFaceBuilder
extractFaceBuilder1 = workPart.Features.CreateExtractFaceBuilder(nullFeatures_Feature)
extractFaceBuilder1.Associative = True
extractFaceBuilder1.FixAtCurrentTimestamp = True
extractFaceBuilder1.SurfaceType = Features.ExtractFaceBuilder.FaceSurfaceType.PolynomialCubic
Dim added1 As Boolean
added1 = extractFaceBuilder1.ObjectToExtract.Add(face1)
extractedfeat1 = extractFaceBuilder1.Commit()
End Sub

Frank Swinkels
 
Hi Frank,

Thanks for the input..But When I tried to follow the steps, the program is erring out.. Iam extremely sorry to bother you.. Please can you help in making the changes in the journal file I have provided?

Appreciate all your help and support..

 
Here is the complete journal.

Code:
'Author: Frank Swinkels
'for use only with NX 8.5 or above
'Create approximate centerline of B-surface "tube"
'user will be prompted to select B-surface, a 'through points' studio spline will be created along the centerline

'  modified June 19, 2014 to include creating the bsurface and allow for faces with other then 0 to 1 parameters 
' (typically cylinders or extended cylinders)
' 
'  NXJournaling.com
'    Report length of selected tube.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Features
Imports System.IO

Module CableCentreline

    Dim s As Session = Session.GetSession()
    Dim ufs As UFSession = UFSession.GetUFSession()
    Dim workPart As Part = s.Parts.Work
    Dim lw As ListingWindow = s.ListingWindow
    Sub Main()
        Dim no_pts As Integer = Nothing
        Dim pos1 As Integer = Nothing
        Dim junk3(2) As Double
        Dim junk2(1) As Double
        Dim periodic1 As Boolean = False
        Dim theFace As Face = Nothing
        Dim totalLength As Double = 0
        Dim response1 As Selection.Response = Selection.Response.Cancel
        Dim type1 As Integer = Nothing
        Dim subtype1 As Integer = Nothing
        Dim bsurface1 As UFModl.Bsurface = Nothing
        Dim extractedfeat1 As Feature = Nothing
        Dim extractedbodyfeat1 As BodyFeature = Nothing
        Dim extractedbody1() As Body = Nothing
        Dim faces() As Face
        Dim testface As Face
        lw.Open()
start1:
        response1 = select_a_face("Select a tube extracted face or dumb solid face", theFace)
        If response1 = Selection.Response.Cancel Or response1 = Selection.Response.Back Then GoTo end1
        ' check that it is a bsurface
        Try
            ufs.Modl.AskBsurf(theFace.Tag, bsurface1)
            testface = theFace
        Catch ex As Exception
            createExtractedBSurface(theFace, extractedfeat1)
            extractedbodyfeat1 = DirectCast(extractedfeat1, BodyFeature)
            extractedbody1 = extractedbodyfeat1.GetBodies
          faces = extractedbody1(0).GetFaces
           ufs.Modl.AskBsurf(faces(0).Tag, bsurface1)
            testface = faces(0)
        End Try
        
        Dim noPolesV As Integer = bsurface1.num_poles_v
        Dim noPolesU As Integer = bsurface1.num_poles_u
        Dim poles1(,) As Double = bsurface1.poles
        Dim knotsU() As Double = bsurface1.knots_u
        Dim knotsV() As Double = bsurface1.knots_v
        Dim orderU As Integer = bsurface1.order_u
        Dim orderV As Integer = bsurface1.order_v
        Dim ptno As Integer = Nothing
        Dim params(1) As Double
        Dim pnt0(2) As Double
        Dim pnt1(2) As Double
        Dim pnt2(2) As Double
        Dim pnt3(2) As Double
        Dim vec0(2) As Double
        Dim vec1(2) As Double
        Dim vec2(2) As Double
        Dim vec3(2) As Double
        Dim rads(1) As Double
        Dim tolerance1 As Double = 0.001
        Dim magnitude1 As Double = Nothing
        Dim degree3 As Integer = orderV - 1
        Dim pointtag As Tag = Tag.Null
        Dim ArrayOfPoints(-1) As Point
        Dim uparm() As Double = {0.0, 0.25, 0.5, 0.75}
        Dim delta1 As Double
        Dim sum1 As Double = Nothing
        Dim distance1 As Double = Nothing
        Dim cnt1 As Integer = 0
        Dim tempcpt(2) As Double
        Dim coordinates1 As Point3d
        Dim temptag As Tag = Tag.Null
        ' tube bsurf u around tube, v along the tube
        Dim vparm(noPolesV - 1) As Double
        vparm(0) = 0.0
        vparm(noPolesV - 1) = 1.0
        Dim lengths(noPolesV - 2) As Double
        sum1 = 0.0
        cnt1 = 0
        For i As Integer = noPolesU To noPolesU * noPolesV - 1 Step noPolesU
            pnt1(0) = poles1(i, 0)
            pnt1(1) = poles1(i, 1)
            pnt1(2) = poles1(i, 2)
            pnt2(0) = poles1(i - noPolesU, 0)
            pnt2(1) = poles1(i - noPolesU, 1)
            pnt2(2) = poles1(i - noPolesU, 2)
            ufs.Vec3.Distance(pnt1, pnt2, distance1)
            lengths(cnt1) = distance1
            cnt1 += 1
            sum1 += distance1
        Next
        delta1 = 0.0
        For i As Integer = 0 To noPolesV - 2
            delta1 += lengths(i)
            vparm(i + 1) = delta1 / sum1
        Next
        Dim uvminmax(3) As Double
        ufs.Modl.AskFaceUvMinmax(testface.Tag, uvminmax)
        Dim total2 As Double = uvminmax(3) - uvminmax(2)
        Dim delta2 As Double = total2 / (noPolesV - 1)
        Dim zero1 As Double = uvminmax(2)
        For i As Integer = 0 To noPolesV - 1
            If i = 0 Then
                vparm(i) = zero1
            Else
                vparm(i) = vparm(i - 1) + delta2
            End If

        Next
         For i As Integer = 0 To noPolesV - 1
            params(0) = uparm(0)
            params(1) = vparm(i)
            ufs.Modl.AskFaceProps(testface.Tag, params, pnt0, junk3, vec0, junk3, junk3, junk3, rads)
            ufs.Vec3.Unitize(vec0, tolerance1, magnitude1, vec0)
           params(0) = uparm(1)
            ufs.Modl.AskFaceProps(testface.Tag, params, pnt1, junk3, vec1, junk3, junk3, junk3, rads)
             params(0) = uparm(2)
            ufs.Modl.AskFaceProps(testface.Tag, params, pnt2, junk3, vec2, junk3, junk3, junk3, rads)
            params(0) = uparm(3)
            ufs.Modl.AskFaceProps(testface.Tag, params, pnt3, junk3, vec3, junk3, junk3, junk3, rads)
            ufs.Vec3.Add(pnt0, pnt1, tempcpt)
            ufs.Vec3.Add(pnt2, tempcpt, tempcpt)
            ufs.Vec3.Add(pnt3, tempcpt, tempcpt)
            tempcpt(0) /= 4.0
            tempcpt(1) /= 4.0
            tempcpt(2) /= 4.0
            coordinates1 = New Point3d(tempcpt(0), tempcpt(1), tempcpt(2))

            ReDim Preserve ArrayOfPoints(i)
            ArrayOfPoints(i) = workPart.Points.CreatePoint(coordinates1)
        Next

        periodic1 = False
        Dim myStudioSpline As Features.StudioSpline
        myStudioSpline = CreateStudioSplineThruPoints(ArrayOfPoints, degree3)
        Dim tubeLength As Double = 0
        For Each tempCurve As Curve In myStudioSpline.GetEntities
            tubeLength += tempCurve.GetLength
        Next
        totalLength += tubeLength
        lw.WriteLine("section length: " & tubeLength.ToString)
        lw.WriteLine("total length: " & totalLength.ToString)
        lw.WriteLine("")
        GoTo start1
end1:
    End Sub
    Public Sub createExtractedBSurface(ByVal face1 As Face, ByRef extractedfeat1 As Feature)
        Dim nullFeatures_Feature As Features.Feature = Nothing
        Dim extractFaceBuilder1 As Features.ExtractFaceBuilder
        extractFaceBuilder1 = workPart.Features.CreateExtractFaceBuilder(nullFeatures_Feature)
        extractFaceBuilder1.ParentPart = Features.ExtractFaceBuilder.ParentPartType.WorkPart
        extractFaceBuilder1.Associative = True
        extractFaceBuilder1.FixAtCurrentTimestamp = True
        extractFaceBuilder1.HideOriginal = False
        extractFaceBuilder1.Type = Features.ExtractFaceBuilder.ExtractType.Face
        extractFaceBuilder1.InheritDisplayProperties = False
        extractFaceBuilder1.SurfaceType = Features.ExtractFaceBuilder.FaceSurfaceType.PolynomialCubic
        Dim added1 As Boolean
        added1 = extractFaceBuilder1.ObjectToExtract.Add(face1)
        extractedfeat1 = extractFaceBuilder1.Commit
    End Sub
    Function select_a_face(ByRef prompt As String, ByRef face1 As Face) As Selection.Response
        Dim mask(0) As Selection.MaskTriple
        With mask(0)
            .Type = UFConstants.UF_solid_type
            .Subtype = 0
            .SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
        End With
        Dim cursor As Point3d = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        select_a_face = Nothing
        response1 = UI.GetUI.SelectionManager.SelectTaggedObject(prompt, "Select the Face", _
            Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, False, _
            False, mask, face1, cursor)
        Return response1
    End Function

    Public Function CreateStudioSplineThruPoints(ByRef points() As Point, ByVal degree3 As Integer) As Features.StudioSpline
        Dim markId9 As Session.UndoMarkId
        markId9 = s.SetUndoMark(Session.MarkVisibility.Visible, "Studio Spline Thru Points")
        Dim Pcount As Integer = points.Length - 1
        Dim nullFeatures_StudioSpline As Features.StudioSpline = Nothing
        Dim studioSplineBuilderex1 As Features.StudioSplineBuilderEx
        studioSplineBuilderex1 = workPart.Features.CreateStudioSplineBuilderEx(nullFeatures_StudioSpline)
        studioSplineBuilderex1.OrientExpress.ReferenceOption = GeometricUtilities.OrientXpressBuilder.Reference.ProgramDefined
        studioSplineBuilderex1.Degree = degree3
        studioSplineBuilderex1.OrientExpress.AxisOption = GeometricUtilities.OrientXpressBuilder.Axis.Passive
        studioSplineBuilderex1.OrientExpress.PlaneOption = GeometricUtilities.OrientXpressBuilder.Plane.Passive
        studioSplineBuilderex1.MatchKnotsType = Features.StudioSplineBuilderEx.MatchKnotsTypes.None
        Dim knots1(-1) As Double
        studioSplineBuilderex1.SetKnots(knots1)
        Dim parameters1(-1) As Double
        studioSplineBuilderex1.SetParameters(parameters1)
        Dim nullDirection As Direction = Nothing
        Dim nullScalar As Scalar = Nothing
        Dim nullOffset As Offset = Nothing
        Dim geometricConstraintData(Pcount) As Features.GeometricConstraintData
        For ii As Integer = 0 To Pcount
            geometricConstraintData(ii) = studioSplineBuilderex1.ConstraintManager.CreateGeometricConstraintData()
            geometricConstraintData(ii).Point = points(ii)
            geometricConstraintData(ii).AutomaticConstraintDirection = Features.GeometricConstraintData.ParameterDirection.Iso
            geometricConstraintData(ii).AutomaticConstraintType = Features.GeometricConstraintData.AutoConstraintType.Tangent
            geometricConstraintData(ii).TangentDirection = nullDirection
            geometricConstraintData(ii).TangentMagnitude = nullScalar
            geometricConstraintData(ii).Curvature = nullOffset
            geometricConstraintData(ii).CurvatureDerivative = nullOffset
            geometricConstraintData(ii).HasSymmetricModelingConstraint = False
        Next ii
        studioSplineBuilderex1.ConstraintManager.SetContents(geometricConstraintData)
        Dim feature1 As Features.StudioSpline
        feature1 = studioSplineBuilderex1.CommitFeature()
        studioSplineBuilderex1.Destroy()

        Return feature1

    End Function

    Public Function GetUnloadOption(ByVal dummy As String) As Integer
        'Unloads the image when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
    End Function

End Module

Frank Swinkels
 
Hi Frank and Cowski,

You guys rock.. This is fantastic..

Thanks a ton for helping me on this..

 
Hi Frank and Cowski,

When I click on the Ok or Apply Button, I get a error message. How can this be cleared?

If you can help on this , it will be awesome..

Thanks for all the support..
 
Below is the changed code so that Apply or OK does not cause an error.

When I write journals they are typically concept journals to demonstrate that a user requirement is possible. I NEVER include all necessary code to cover all conditions or user methods. For example this updated journal does not use Apply or OK in the normal NX approach. Ideally what should happen is that one or a number of faces are selected and then Apply is selected to create, in this case, the centrelines and the dialog is left to enable further face selection. In this ideal approach when OK is selected the centrelines should be created and the dialog dismissed. I do not include all appropriate error checking. For example in this program if a user selects an open face, the journal should indicate an incorrect selection.

Code:
'Author: Frank Swinkels
'for use only with NX 8.5 or above
'Create approximate centerline of B-surface "tube"
'user will be prompted to select B-surface, a 'through points' studio spline will be created along the centerline

'  modified June 19, 2014 to include creating the bsurface and allow for faces with other then 0 to 1 parameters 
' (typically cylinders or extended cylinders)
'
' modified June 24 to change for selecting apply or OK
' 
'  NXJournaling.com
'    Report length of selected tube.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Features
Imports System.IO

Module CableCentreline

    Dim s As Session = Session.GetSession()
    Dim ufs As UFSession = UFSession.GetUFSession()
    Dim workPart As Part = s.Parts.Work
    Dim lw As ListingWindow = s.ListingWindow
    Sub Main()
        Dim no_pts As Integer = Nothing
        Dim pos1 As Integer = Nothing
        Dim junk3(2) As Double
        Dim junk2(1) As Double
        Dim periodic1 As Boolean = False
        Dim theFace As Face = Nothing
        Dim totalLength As Double = 0
        Dim response1 As Selection.Response = Selection.Response.Cancel
        Dim type1 As Integer = Nothing
        Dim subtype1 As Integer = Nothing
        Dim bsurface1 As UFModl.Bsurface = Nothing
        Dim extractedfeat1 As Feature = Nothing
        Dim extractedbodyfeat1 As BodyFeature = Nothing
        Dim extractedbody1() As Body = Nothing
        Dim faces() As Face
        Dim testface As Face
        lw.Open()
        While select_a_face("Select a tube extracted face or dumb solid face", theFace) = Selection.Response.Ok


            'response1 = select_a_face("Select a tube extracted face or dumb solid face", theFace)
            'If response1 = Selection.Response.Cancel Or response1 = Selection.Response.Back Then GoTo end1
            ' check that it is a bsurface
            Try
                ufs.Modl.AskBsurf(theFace.Tag, bsurface1)
                testface = theFace
            Catch ex As Exception
                createExtractedBSurface(theFace, extractedfeat1)
                extractedbodyfeat1 = DirectCast(extractedfeat1, BodyFeature)
                extractedbody1 = extractedbodyfeat1.GetBodies
                faces = extractedbody1(0).GetFaces
                ufs.Modl.AskBsurf(faces(0).Tag, bsurface1)
                testface = faces(0)
            End Try

            Dim noPolesV As Integer = bsurface1.num_poles_v
            Dim noPolesU As Integer = bsurface1.num_poles_u
            Dim poles1(,) As Double = bsurface1.poles
            Dim knotsU() As Double = bsurface1.knots_u
            Dim knotsV() As Double = bsurface1.knots_v
            Dim orderU As Integer = bsurface1.order_u
            Dim orderV As Integer = bsurface1.order_v
            Dim ptno As Integer = Nothing
            Dim params(1) As Double
            Dim pnt0(2) As Double
            Dim pnt1(2) As Double
            Dim pnt2(2) As Double
            Dim pnt3(2) As Double
            Dim vec0(2) As Double
            Dim vec1(2) As Double
            Dim vec2(2) As Double
            Dim vec3(2) As Double
            Dim rads(1) As Double
            Dim tolerance1 As Double = 0.001
            Dim magnitude1 As Double = Nothing
            Dim degree3 As Integer = orderV - 1
            Dim pointtag As Tag = Tag.Null
            Dim ArrayOfPoints(-1) As Point
            Dim uparm() As Double = {0.0, 0.25, 0.5, 0.75}
            Dim delta1 As Double
            Dim sum1 As Double = Nothing
            Dim distance1 As Double = Nothing
            Dim cnt1 As Integer = 0
            Dim tempcpt(2) As Double
            Dim coordinates1 As Point3d
            Dim temptag As Tag = Tag.Null
            ' tube bsurf u around tube, v along the tube
            Dim vparm(noPolesV - 1) As Double
            vparm(0) = 0.0
            vparm(noPolesV - 1) = 1.0
            Dim lengths(noPolesV - 2) As Double
            sum1 = 0.0
            cnt1 = 0
            For i As Integer = noPolesU To noPolesU * noPolesV - 1 Step noPolesU
                pnt1(0) = poles1(i, 0)
                pnt1(1) = poles1(i, 1)
                pnt1(2) = poles1(i, 2)
                pnt2(0) = poles1(i - noPolesU, 0)
                pnt2(1) = poles1(i - noPolesU, 1)
                pnt2(2) = poles1(i - noPolesU, 2)
                ufs.Vec3.Distance(pnt1, pnt2, distance1)
                lengths(cnt1) = distance1
                cnt1 += 1
                sum1 += distance1
            Next
            delta1 = 0.0
            For i As Integer = 0 To noPolesV - 2
                delta1 += lengths(i)
                vparm(i + 1) = delta1 / sum1
            Next
            Dim uvminmax(3) As Double
            ufs.Modl.AskFaceUvMinmax(testface.Tag, uvminmax)
            Dim total2 As Double = uvminmax(3) - uvminmax(2)
            Dim delta2 As Double = total2 / (noPolesV - 1)
            Dim zero1 As Double = uvminmax(2)
            For i As Integer = 0 To noPolesV - 1
                If i = 0 Then
                    vparm(i) = zero1
                Else
                    vparm(i) = vparm(i - 1) + delta2
                End If

            Next
            For i As Integer = 0 To noPolesV - 1
                params(0) = uparm(0)
                params(1) = vparm(i)
                ufs.Modl.AskFaceProps(testface.Tag, params, pnt0, junk3, vec0, junk3, junk3, junk3, rads)
                ufs.Vec3.Unitize(vec0, tolerance1, magnitude1, vec0)
                params(0) = uparm(1)
                ufs.Modl.AskFaceProps(testface.Tag, params, pnt1, junk3, vec1, junk3, junk3, junk3, rads)
                params(0) = uparm(2)
                ufs.Modl.AskFaceProps(testface.Tag, params, pnt2, junk3, vec2, junk3, junk3, junk3, rads)
                params(0) = uparm(3)
                ufs.Modl.AskFaceProps(testface.Tag, params, pnt3, junk3, vec3, junk3, junk3, junk3, rads)
                ufs.Vec3.Add(pnt0, pnt1, tempcpt)
                ufs.Vec3.Add(pnt2, tempcpt, tempcpt)
                ufs.Vec3.Add(pnt3, tempcpt, tempcpt)
                tempcpt(0) /= 4.0
                tempcpt(1) /= 4.0
                tempcpt(2) /= 4.0
                coordinates1 = New Point3d(tempcpt(0), tempcpt(1), tempcpt(2))

                ReDim Preserve ArrayOfPoints(i)
                ArrayOfPoints(i) = workPart.Points.CreatePoint(coordinates1)
            Next

            periodic1 = False
            Dim myStudioSpline As Features.StudioSpline
            myStudioSpline = CreateStudioSplineThruPoints(ArrayOfPoints, degree3)
            Dim tubeLength As Double = 0
            For Each tempCurve As Curve In myStudioSpline.GetEntities
                tubeLength += tempCurve.GetLength
            Next
            totalLength += tubeLength
            lw.WriteLine("section length: " & tubeLength.ToString)
            lw.WriteLine("total length: " & totalLength.ToString)
            lw.WriteLine("")
        End While
end1:
    End Sub
    Public Sub createExtractedBSurface(ByVal face1 As Face, ByRef extractedfeat1 As Feature)
        Dim nullFeatures_Feature As Features.Feature = Nothing
        Dim extractFaceBuilder1 As Features.ExtractFaceBuilder
        extractFaceBuilder1 = workPart.Features.CreateExtractFaceBuilder(nullFeatures_Feature)
        extractFaceBuilder1.ParentPart = Features.ExtractFaceBuilder.ParentPartType.WorkPart
        extractFaceBuilder1.Associative = True
        extractFaceBuilder1.FixAtCurrentTimestamp = True
        extractFaceBuilder1.HideOriginal = False
        extractFaceBuilder1.Type = Features.ExtractFaceBuilder.ExtractType.Face
        extractFaceBuilder1.InheritDisplayProperties = False
        extractFaceBuilder1.SurfaceType = Features.ExtractFaceBuilder.FaceSurfaceType.PolynomialCubic
        Dim added1 As Boolean
        added1 = extractFaceBuilder1.ObjectToExtract.Add(face1)
        extractedfeat1 = extractFaceBuilder1.Commit
    End Sub
    Function select_a_face(ByRef prompt As String, ByRef face1 As Face) As Selection.Response
        Dim mask(0) As Selection.MaskTriple
        With mask(0)
            .Type = UFConstants.UF_solid_type
            .Subtype = 0
            .SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
        End With
        Dim cursor As Point3d = Nothing
        Dim response1 As Selection.Response = Selection.Response.Cancel
        select_a_face = Nothing
        response1 = UI.GetUI.SelectionManager.SelectTaggedObject(prompt, "Select the Face", _
            Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, False, _
            False, mask, face1, cursor)
        If response1 = Selection.Response.ObjectSelected Or _
            response1 = Selection.Response.ObjectSelectedByName Then
            Return Selection.Response.Ok
        ElseIf response1 = Selection.Response.Back Then
            Return Selection.Response.Back
        Else
            Return Selection.Response.Cancel
        End If
    End Function

    Public Function CreateStudioSplineThruPoints(ByRef points() As Point, ByVal degree3 As Integer) As Features.StudioSpline
        Dim markId9 As Session.UndoMarkId
        markId9 = s.SetUndoMark(Session.MarkVisibility.Visible, "Studio Spline Thru Points")
        Dim Pcount As Integer = points.Length - 1
        Dim nullFeatures_StudioSpline As Features.StudioSpline = Nothing
        Dim studioSplineBuilderex1 As Features.StudioSplineBuilderEx
        studioSplineBuilderex1 = workPart.Features.CreateStudioSplineBuilderEx(nullFeatures_StudioSpline)
        studioSplineBuilderex1.OrientExpress.ReferenceOption = GeometricUtilities.OrientXpressBuilder.Reference.ProgramDefined
        studioSplineBuilderex1.Degree = degree3
        studioSplineBuilderex1.OrientExpress.AxisOption = GeometricUtilities.OrientXpressBuilder.Axis.Passive
        studioSplineBuilderex1.OrientExpress.PlaneOption = GeometricUtilities.OrientXpressBuilder.Plane.Passive
        studioSplineBuilderex1.MatchKnotsType = Features.StudioSplineBuilderEx.MatchKnotsTypes.None
        Dim knots1(-1) As Double
        studioSplineBuilderex1.SetKnots(knots1)
        Dim parameters1(-1) As Double
        studioSplineBuilderex1.SetParameters(parameters1)
        Dim nullDirection As Direction = Nothing
        Dim nullScalar As Scalar = Nothing
        Dim nullOffset As Offset = Nothing
        Dim geometricConstraintData(Pcount) As Features.GeometricConstraintData
        For ii As Integer = 0 To Pcount
            geometricConstraintData(ii) = studioSplineBuilderex1.ConstraintManager.CreateGeometricConstraintData()
            geometricConstraintData(ii).Point = points(ii)
            geometricConstraintData(ii).AutomaticConstraintDirection = Features.GeometricConstraintData.ParameterDirection.Iso
            geometricConstraintData(ii).AutomaticConstraintType = Features.GeometricConstraintData.AutoConstraintType.Tangent
            geometricConstraintData(ii).TangentDirection = nullDirection
            geometricConstraintData(ii).TangentMagnitude = nullScalar
            geometricConstraintData(ii).Curvature = nullOffset
            geometricConstraintData(ii).CurvatureDerivative = nullOffset
            geometricConstraintData(ii).HasSymmetricModelingConstraint = False
        Next ii
        studioSplineBuilderex1.ConstraintManager.SetContents(geometricConstraintData)
        Dim feature1 As Features.StudioSpline
        feature1 = studioSplineBuilderex1.CommitFeature()
        studioSplineBuilderex1.Destroy()

        Return feature1

    End Function

    Public Function GetUnloadOption(ByVal dummy As String) As Integer
        'Unloads the image when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
    End Function

End Module

Frank Swinkels
 
Hi Frank,

Thanks so much for helping me out on this..

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor