NX1872 - Journal fix please

[Kenja824]

I had a journal to import a part file. I was able to adjust it to bring in a part from Team Center easily enough. I stole some functions from another journal I had to make it so the user selects where the part file is placed in drafting. There are two things I cant figure out.

1) How to make it so you have to select an existing point inside a drafting view to place the part file. (Currently it is set to cursor point)

2) To make it loop so the user can keep selecting existing points and keep importing the same part file repeatedly.

If anyone can help with this, it would be appreciated.


Current Journal Code...

Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF

Module NXJournal
    Sub Main(ByVal args() As String)

        Dim theSession As Session = Session.GetSession()
        Dim theUfSession As UFSession = UFSession.GetUFSession
        Dim workPart As Part = theSession.Parts.Work

        Dim displayPart As Part = theSession.Parts.Display
        ' ----------------------------------------------
        '   Menu: File->Import->Part...
        ' ----------------------------------------------
        Dim markId1 As Session.UndoMarkId
        markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Import Part")

        workPart.Layers.WorkLayer = 253

        Dim partImporter1 As PartImporter
        partImporter1 = workPart.ImportManager.CreatePartImporter()

        ' partImporter1.FileName = "R:\hms_tools\NX1872\Tooling\part\Notes\break_corners.prt"
        partImporter1.FileName = "@DB/ANK37226/001"

        partImporter1.Scale = 1.0

        partImporter1.CreateNamedGroup = False

        partImporter1.ImportViews = False

        partImporter1.ImportCamObjects = False

        partImporter1.LayerOption = PartImporter.LayerOptionType.Work

        partImporter1.DestinationCoordinateSystemSpecification = PartImporter.DestinationCoordinateSystemSpecificationType.Work

        Dim element1 As Matrix3x3
        element1.Xx = 1.0
        element1.Xy = 0.0
        element1.Xz = 0.0
        element1.Yx = 0.0
        element1.Yy = 1.0
        element1.Yz = 0.0
        element1.Zx = 0.0
        element1.Zy = 0.0
        element1.Zz = 1.0
        Dim nXMatrix1 As NXMatrix
        nXMatrix1 = workPart.NXMatrices.Create(element1)

        partImporter1.DestinationCoordinateSystem = nXMatrix1

        Dim destinationPoint1 As Point3d = SelectScreenPoint() '= New Point3d(0.0, 0.0, 0.0)
        partImporter1.DestinationPoint = destinationPoint1

        Dim markId2 As Session.UndoMarkId
        markId2 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Import Part Commit")

        Dim nXObject1 As NXObject
        nXObject1 = partImporter1.Commit()

        theSession.DeleteUndoMark(markId2, Nothing)

        partImporter1.Destroy()

        ' ----------------------------------------------
        '   Menu: Tools->Journal->Stop Recording
        ' ----------------------------------------------
    End Sub

    Function SelectScreenPoint() As Point3d

        'Allow user to interactively pick the point where the annotation
        'will be placed.

        'This Function needs Sub MotionCallback() to work properly.
        Dim theSession As Session = Session.GetSession()
        Dim theUfSession As UFSession = UFSession.GetUFSession
        Dim myScreenPos(2) As Double
        Dim theViewTag As Tag = theSession.Parts.Display.Views.WorkView.Tag
        Dim theResponse As Integer

        theUfSession.Ui.LockUgAccess(UFConstants.UF_UI_FROM_CUSTOM)

        theUfSession.Ui.SpecifyScreenPosition("pick a point", AddressOf MotionCallback, Nothing, myScreenPos, theViewTag, theResponse)

        theUfSession.Ui.UnlockUgAccess(UFConstants.UF_UI_FROM_CUSTOM)

        If theResponse = UFConstants.UF_UI_PICK_RESPONSE Then
            Return New Point3d(myScreenPos(0), myScreenPos(1), myScreenPos(2))
        Else
            Return Nothing
        End If
    End Function


    Sub MotionCallback(ByVal pos() As Double,
               ByRef motion_cb_data As UFUi.MotionCbData,
               ByVal client_data As System.IntPtr)

        'This sub will be called every time a cursor move is detected during the
        'SpecifyScreenPosition function.

        'The parameters motion_cb_data and client_data are not used in this implementation,
        'but the Sub must have the same signature as UFUI.MotionFnT to work properly.

        'disable (for now)
        'Return
        Dim theSession As Session = Session.GetSession()
        Dim theUfSession As UFSession = UFSession.GetUFSession
        Dim wView As NXOpen.View = theSession.Parts.Display.Views.WorkView
        Dim topLeft(2) As Double
        Dim topRight(2) As Double
        Dim botLeft(2) As Double
        Dim botRight(2) As Double
     End Sub

    Function mask_for_curves(ByVal select_ As IntPtr, ByVal userdata As IntPtr) As Integer
        Dim theUfSession As UFSession = UFSession.GetUFSession
        Dim num_triples As Integer = 4
        Dim mask_triples(3) As UFUi.Mask

        mask_triples(0).object_type = UFConstants.UF_line_type
        mask_triples(0).object_subtype = 0
        mask_triples(0).solid_type = 0

        mask_triples(1).object_type = UFConstants.UF_circle_type
        mask_triples(1).object_subtype = 0
        mask_triples(1).solid_type = 0

        mask_triples(2).object_type = UFConstants.UF_conic_type
        mask_triples(2).object_subtype = 0
        mask_triples(2).solid_type = 0

        mask_triples(3).object_type = UFConstants.UF_spline_type
        mask_triples(3).object_subtype = 0
        mask_triples(3).solid_type = 0

        theUfSession.Ui.SetSelMask(select_,
                UFUi.SelMaskAction.SelMaskClearAndEnableSpecific,
                                          num_triples, mask_triples)
        Return UFConstants.UF_UI_SEL_SUCCESS

    End Function
End Module

Ken

http://www.OneGodLogic.com

My brain is like a sponge. A sopping wet sponge. When I use it, I seem to lose more than I soak in.