Submit Your Own Journal

In the 15 years that I have been a mechanical engineer, I have found that many routines we do daily are repetitive. Since my earliest career days, I have been writing programs, code snippets and macros to provide accurate, quick solutions to these mundane tasks. If you have written a journal that would be useful to others, we would love for you to submit it for others to use as well. By submitting you would be granting others free use of your journal.
Please post below.
Feel free to email questions, comments, journals you'd like to share, or journal ideas to: info@nxjournaling.com
Please note that my email provider is very suspicious of .vb files and will block them (even if they reside in a .zip file). Please change the extension of journal files from ".vb" to ".txt" before sending. Thanks!

Comments

hole dimensioning will resolve the requirement

nagalakshmi rajeswari majeti

for a particular requirements ,we need to create a library

nagalakshmi rajeswari majeti

i have a need to lock views in a drawing sheet.

nagalakshmi rajeswari majeti

I have a huge list of Expressions to be renamed. I am doing it manually now. Is there any macro to do it automatically?

Stay Hungry
Stay Foolish

I don't have code on hand for that task, but I don't think that it would be too difficult to get something working.

For starters, I'd suggest recording a journal while renaming an expression. This will show what code is required for that part of the task.

You say that you have a "huge list of expressions to be renamed". What form is this list in? I imagine that it is a text file with an old name and new name on each line, something like the following?

oldName1; newName1
oldName2; newName2
.
.
.
oldName_n; newName_n

If so, you can make use of the "read text file" code found at:
http://nxjournaling.com/content/read-text-file
an array or list can be created to hold the old and new names and finally you can iterate through the list of old names, find the expression and rename it to the new name.

Is there a way to get updated emails when someone creates a new thread, post NX code or makes a comment to an existing thread.

The short answer is: "unfortunately, no".

You can get updates for replies to your thread or post, but there is currently no mechanism to get updates for "any new post".

' NX Add Hardware
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System.Drawing
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports System.Windows.Forms.MessageBox
Imports System.IO
Imports System.Collections
Imports System.Environment
Imports Microsoft.VisualBasic

Module AddHardware1
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()

Dim form As UserSymbolForm = New UserSymbolForm(theSession, theUI)
Dim Partno As String = Nothing
' lw.Open()
Do
Try
If form.ShowDialog = DialogResult.Cancel Then Exit Sub
If form.Getthehardwareno(Partno) = True Then
form.Close()
Call Addpart(Partno)
End If
Catch err1 As ObjectDisposedException
' lw.WriteLine(err1.ToString)
Exit Do
End Try
Loop
' form.Close()
' lw.Close()

End Sub
Sub Addpart(Partno As String)

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Add Component")
theSession.SetUndoMarkName(markId1, "Add Component")

'theSession.Parts.SetNonmasterSeedPartData("@DB/" & PartNo & "/" & PartRev)
'Dim basePart1 As BasePart = Nothing
'Try
' Dim partLoadStatus1 As PartLoadStatus = Nothing
' basePart1 = theSession.Parts.Open("@DB/" & PartNo & "/" & PartRev, partLoadStatus1)
' partLoadStatus1.Dispose()

'Catch exc As Exception
' basePart1 = theSession.Parts.FindObject("@DB/" & PartNo & "/" & PartRev)
'End Try

'Dim part1 As Part = CType(basePart1, Part)

Dim basePoint1 As Point3d = Nothing
UserSelectScreenPos("Select screen position to add Hardware", basePoint1)
'New Point3d(0.0, 0.0, 0.0)
Dim orientation1 As Matrix3x3
orientation1.Xx = 1.0
orientation1.Xy = 0.0
orientation1.Xz = 0.0
orientation1.Yx = 0.0
orientation1.Yy = 1.0
orientation1.Yz = 0.0
orientation1.Zx = 0.0
orientation1.Zy = 0.0
orientation1.Zz = 1.0
Dim partLoadStatus2 As PartLoadStatus = Nothing

Dim component1 As Assemblies.Component
Dim PreviewComponentOnAdd1 As Boolean
PreviewComponentOnAdd1 = theSession.Preferences.Assemblies.PreviewComponentOnAdd
PreviewComponentOnAdd1 = True

component1 = workPart.ComponentAssembly.AddComponent("@DB/" & Partno, "MODEL", Partno, basePoint1, orientation1, -1, partLoadStatus2)
partLoadStatus2.Dispose()

Dim constrain1 As Positioning.Constraint = Nothing
Dim constraintReference1 As Positioning.ConstraintReference
Dim mycomp As Object = Nothing
If SelectComponent("Select a reference Component where the Hardware need to constraint with ", mycomp) = Selection.Response.Cancel Then
Return
End If
Dim component2 As Assemblies.Component = mycomp
Dim componentPositioner1 As Positioning.ComponentPositioner
componentPositioner1 = workPart.ComponentAssembly.Positioner
componentPositioner1.ClearNetwork()
componentPositioner1.BeginAssemblyConstraints()
constrain1 = componentPositioner1.CreateConstraint()
Dim Edgeonparent As Object = Nothing
Dim P1 As Point3d
If UserSelectEdge("Select edge to attach Hardware", Edgeonparent, P1) = Selection.Response.Cancel Then
Return
End If
Dim edge1 As Edge = Edgeonparent
Dim componentConstraint1 As Positioning.ComponentConstraint = CType(constrain1, Positioning.ComponentConstraint)
componentConstraint1.ConstraintType = Positioning.Constraint.Type.Concentric
constraintReference1 = componentConstraint1.CreateConstraintReference(component2, edge1, False, False, False)
Dim EdgeonHardware As Object = Nothing
Dim P2 As Point3d
If UserSelectEdge("Select edge on Hardware to constrain", EdgeonHardware, P2) = Selection.Response.Cancel Then
Return
End If
Dim edge2 As Edge = EdgeonHardware
' Dim edge2 As Edge = CType(component1.FindObject("PROTO#.Features|REVOLVED(2)|EDGE * [CURVE 5 0] * [CURVE 6 0] {(0.0475,0.0822724133595,-0.048)(-0.095,0,-0.048)(0.0475,-0.0822724133595,-0.048) REVOLVED(2)}"), Edge)
Dim constraintReference2 As Positioning.ConstraintReference
constraintReference2 = componentConstraint1.CreateConstraintReference(component1, edge2, False, False, False)
constrain1.GetConstraintStatus()

End Sub

Function UserSelectEdge(ByVal prompt As String, ByRef selObj As TaggedObject, ByRef selPoint As Point3d) As Selection.Response

'Allow user to interactively select an edge

Dim title As String = "Select an edge"
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(6) As Selection.MaskTriple

'Set the selection criteria to any edge
'TODO: Add point on surface
selectionMask_array(0).Type = UFConstants.UF_solid_type
selectionMask_array(0).Subtype = UFConstants.UF_UI_SEL_FEATURE_ANY_EDGE
selectionMask_array(0).SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_EDGE

selectionMask_array(1).Type = UFConstants.UF_line_type
selectionMask_array(1).Subtype = UFConstants.UF_all_subtype

selectionMask_array(2).Type = UFConstants.UF_circle_type
selectionMask_array(2).Subtype = UFConstants.UF_all_subtype

selectionMask_array(3).Type = UFConstants.UF_conic_type
selectionMask_array(3).Subtype = UFConstants.UF_all_subtype

selectionMask_array(4).Type = UFConstants.UF_spline_type
selectionMask_array(4).Subtype = UFConstants.UF_all_subtype

selectionMask_array(5).Type = UFConstants.UF_solid_silhouette_type
selectionMask_array(5).Subtype = UFConstants.UF_all_subtype

selectionMask_array(6).Type = UFConstants.UF_section_edge_type
selectionMask_array(6).Subtype = UFConstants.UF_all_subtype

'This line allows the user to select from any view:
ufs.Ui.SetCursorView(0)

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, selPoint)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function
Function UserSelectScreenPos(ByVal prompt As String, ByRef selPoint As Point3d) As Selection.DialogResponse
'Allow user to interactively select a screen position
Dim view As NXOpen.View = Nothing
Return theUI.SelectionManager.SelectScreenPosition(prompt, view, selPoint)
End Function

Function SelectComponent(ByVal prompt As String, ByRef selObj As NXObject) As Selection.Response

Dim title As String = "Select a component"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.AnyInAssembly
Dim selectionMask_array(0) As Selection.MaskTriple

With selectionMask_array(0)
.Type = UFConstants.UF_component_type
.Subtype = UFConstants.UF_all_subtype
End With

Dim resp As Selection.Response = theUI.SelectionManager.SelectObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

End Module

_
Partial Class UserSymbolForm
Inherits System.Windows.Forms.Form

Public Sub New(ByVal session As Session, ByVal ui As UI)
MyBase.New()
Dim theSession As Session = session
Dim theUI As UI = ui

'This call is required by the Windows Form Designer.
InitializeComponent()

'Add any initialization after the InitializeComponent() call
Me.Button1.Text = "Ok"
Me.BringToFront()

End Sub

Public Function Getthehardwareno(ByRef Partno As String) As Boolean
If Me.DialogResult = Windows.Forms.DialogResult.OK Then
Partno = Me.ComboBox4.Text
End If
Return True
End Function

'Form overrides dispose to clean up the component list.
_
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub

'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer

'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
_
Private Sub InitializeComponent()
Me.Button1 = New System.Windows.Forms.Button()
Me.Button2 = New System.Windows.Forms.Button()
Me.ComboBox1 = New System.Windows.Forms.ComboBox()
Me.Label1 = New System.Windows.Forms.Label()
Me.PictureBox1 = New System.Windows.Forms.PictureBox()
Me.Label2 = New System.Windows.Forms.Label()
Me.ComboBox2 = New System.Windows.Forms.ComboBox()
Me.Label3 = New System.Windows.Forms.Label()
Me.ComboBox3 = New System.Windows.Forms.ComboBox()
Me.Label4 = New System.Windows.Forms.Label()
Me.Label5 = New System.Windows.Forms.Label()
Me.Button3 = New System.Windows.Forms.Button()
Me.ComboBox4 = New System.Windows.Forms.ComboBox()
Me.Button4 = New System.Windows.Forms.Button()
CType(Me.PictureBox1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'Button1
'
Me.Button1.DialogResult = System.Windows.Forms.DialogResult.OK
Me.Button1.Location = New System.Drawing.Point(28, 253)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(75, 23)
Me.Button1.TabIndex = 0
Me.Button1.Text = "Ok"
Me.Button1.UseVisualStyleBackColor = True
'
'Button2
'
Me.Button2.DialogResult = System.Windows.Forms.DialogResult.Cancel
Me.Button2.Location = New System.Drawing.Point(191, 253)
Me.Button2.Name = "Button2"
Me.Button2.Size = New System.Drawing.Size(75, 23)
Me.Button2.TabIndex = 1
Me.Button2.Text = "Cancel"
Me.Button2.UseVisualStyleBackColor = True
'
'ComboBox1
'
Me.ComboBox1.FormattingEnabled = True
Me.ComboBox1.Items.AddRange(New Object() {"SCREWS", "INSERTS", "WASHERS", "RIVETS"})
Me.ComboBox1.Location = New System.Drawing.Point(25, 25)
Me.ComboBox1.Name = "ComboBox1"
Me.ComboBox1.Size = New System.Drawing.Size(156, 21)
Me.ComboBox1.TabIndex = 2
'
'Label1
'
Me.Label1.AutoSize = True
Me.Label1.Location = New System.Drawing.Point(22, 9)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(81, 13)
Me.Label1.TabIndex = 3
Me.Label1.Text = "Select category"
'
'PictureBox1
'
Me.PictureBox1.Location = New System.Drawing.Point(210, 47)
Me.PictureBox1.Name = "PictureBox1"
Me.PictureBox1.Size = New System.Drawing.Size(200, 179)
Me.PictureBox1.TabIndex = 4
Me.PictureBox1.TabStop = False
' Me.PictureBox1.Image = Image.FromFile("C:\Users\Joe\Desktop\Study\Images\IntialImage.Jpg")
Me.PictureBox1.Image = Image.FromFile("C:\Users\Joe\Desktop\Study\Images\IntialImage.Jpg")
'Label2
'
Me.Label2.AutoSize = True
Me.Label2.Location = New System.Drawing.Point(223, 25)
Me.Label2.Name = "Label2"
Me.Label2.Size = New System.Drawing.Size(94, 13)
Me.Label2.TabIndex = 5
Me.Label2.Text = "Hardware Preview"
'
'ComboBox2
'
Me.ComboBox2.FormattingEnabled = True
Me.ComboBox2.Location = New System.Drawing.Point(25, 77)
Me.ComboBox2.Name = "ComboBox2"
Me.ComboBox2.Size = New System.Drawing.Size(156, 21)
Me.ComboBox2.TabIndex = 6
'
'Label3
'
Me.Label3.AutoSize = True
Me.Label3.Location = New System.Drawing.Point(22, 58)
Me.Label3.Name = "Label3"
Me.Label3.Size = New System.Drawing.Size(97, 13)
Me.Label3.TabIndex = 7
Me.Label3.Text = "Select Subcategoy"
'
'ComboBox3
'
Me.ComboBox3.FormattingEnabled = True
Me.ComboBox3.Location = New System.Drawing.Point(25, 139)
Me.ComboBox3.Name = "ComboBox3"
Me.ComboBox3.Size = New System.Drawing.Size(156, 21)
Me.ComboBox3.TabIndex = 8
'
'Label4
'
Me.Label4.AutoSize = True
Me.Label4.Location = New System.Drawing.Point(22, 110)
Me.Label4.Name = "Label4"
Me.Label4.Size = New System.Drawing.Size(86, 13)
Me.Label4.TabIndex = 9
Me.Label4.Text = "Select Hardware"
'
'Label5
'
Me.Label5.AutoSize = True
Me.Label5.Location = New System.Drawing.Point(27, 178)
Me.Label5.Name = "Label5"
Me.Label5.Size = New System.Drawing.Size(60, 13)
Me.Label5.TabIndex = 10
Me.Label5.Text = "Select Size"
'
'Button3
'
Me.Button3.Location = New System.Drawing.Point(272, 253)
Me.Button3.Name = "Button3"
Me.Button3.Size = New System.Drawing.Size(75, 23)
Me.Button3.TabIndex = 11
Me.Button3.Text = "Help"
Me.Button3.UseVisualStyleBackColor = True
'
'ComboBox4
'
Me.ComboBox4.FormattingEnabled = True
Me.ComboBox4.Location = New System.Drawing.Point(30, 205)
Me.ComboBox4.Name = "ComboBox4"
Me.ComboBox4.Size = New System.Drawing.Size(151, 21)
Me.ComboBox4.TabIndex = 12
'
'Button4
'
Me.Button4.Location = New System.Drawing.Point(110, 253)
Me.Button4.Name = "Button4"
Me.Button4.Size = New System.Drawing.Size(75, 23)
Me.Button4.TabIndex = 13
Me.Button4.Text = "Apply"
Me.Button4.UseVisualStyleBackColor = True
'
'UserSymbolForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(428, 298)
Me.Controls.Add(Me.Button4)
Me.Controls.Add(Me.ComboBox4)
Me.Controls.Add(Me.Button3)
Me.Controls.Add(Me.Label5)
Me.Controls.Add(Me.Label4)
Me.Controls.Add(Me.ComboBox3)
Me.Controls.Add(Me.Label3)
Me.Controls.Add(Me.ComboBox2)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.PictureBox1)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.ComboBox1)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Button1)
Me.Name = "UserSymbolForm"
Me.Text = "Hardware Selection"
CType(Me.PictureBox1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
Me.PerformLayout()

End Sub
Friend WithEvents Button1 As System.Windows.Forms.Button
Friend WithEvents Button2 As System.Windows.Forms.Button
Friend WithEvents ComboBox1 As System.Windows.Forms.ComboBox
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents PictureBox1 As System.Windows.Forms.PictureBox
Friend WithEvents Label2 As System.Windows.Forms.Label
Friend WithEvents ComboBox2 As System.Windows.Forms.ComboBox
Friend WithEvents Label3 As System.Windows.Forms.Label
Friend WithEvents ComboBox3 As System.Windows.Forms.ComboBox
Friend WithEvents Label4 As System.Windows.Forms.Label
Friend WithEvents Label5 As System.Windows.Forms.Label
Friend WithEvents Button3 As System.Windows.Forms.Button
Friend WithEvents ComboBox4 As System.Windows.Forms.ComboBox
Friend WithEvents Button4 As System.Windows.Forms.Button

Private Sub ComboBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged

Dim Screwslist() As String = {"HEXHEAD", "CSK"}
Dim Insertslist() As String = {"ADD Inserts TYPE HERE", "C"}
Dim Helicoilslist() As String = {"ADD Helicoils TYPE HERE", "C"}
Dim Rivetslist() As String = {"ADD Rivets TYPE HERE", "C"}

ComboBox2.Items.Clear()
If ComboBox1.SelectedIndex = 0 Then
ComboBox2.Items.AddRange(Screwslist)
ElseIf ComboBox1.SelectedIndex = 1 Then
ComboBox2.Items.AddRange(Insertslist)
ElseIf ComboBox1.SelectedIndex = 2 Then
ComboBox2.Items.AddRange(Helicoilslist)
ElseIf ComboBox1.SelectedIndex = 3 Then
ComboBox2.Items.AddRange(Rivetslist)
End If

End Sub

Dim hexhead() As String = {"NAS1801-3", "NAS1801-3"}
Dim CSK() As String = {"ADD SCREWS TYPE HERE", "C"}

Private Sub ComboBox2_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox2.SelectedIndexChanged

ComboBox3.Items.Clear()
If ComboBox2.SelectedIndex = 0 Then
ComboBox3.Items.AddRange(hexhead)
ElseIf ComboBox2.SelectedIndex = 1 Then
ComboBox3.Items.AddRange(CSK)
End If
End Sub

Private Sub ComboBox3_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox3.SelectedIndexChanged

Dim NAS1801length() As String = {"NAS1801-3-6/3", "NAS1801-3-10/3"}
Dim CSK1() As String = {"ADD SCREWS length HERE", "C"}

ComboBox4.Items.Clear()
If ComboBox3.SelectedIndex = 0 Then
PictureBox1.Image = Image.FromFile("C:\Users\Joe\Desktop\Study\Images\" & hexhead(0) & ".jpg")
ComboBox4.Items.AddRange(NAS1801length)
ElseIf ComboBox3.SelectedIndex = 1 Then
ComboBox4.Items.AddRange(CSK1)
PictureBox1.ImageLocation = "C:\Users\Joe\Desktop\Study\Images\" & hexhead(1) & "jpg"
End If
End Sub
Private Sub ComboBox4_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox4.SelectedIndexChanged

End Sub

Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
PictureBox1.ImageLocation = "C:\Users\Joe\Desktop\Study\Images\"
End Sub
End Class

' NX Add Associative callout by manual mode
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.Annotations
Imports System.Windows.Forms
Imports NXOpen.UF
Imports NXOpen.Annotations.Annotation
Imports NXOpen.Assemblies
Module NXJournal

Dim theUI As UI = UI.GetUI
Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession

Sub Main()
Call Mysub1()
Call Mysub2()
End Sub

Sub Mysub1()

If IsNothing(theSession.Parts.Work) Then
'active part required
Return
End If

Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()

Const undoMarkName As String = "NXJ journal"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, undoMarkName)

Dim myComponent As Assemblies.Component = Nothing
If SelectComponent("Select component", myComponent) = Selection.Response.Cancel Then
Return
End If

'$$$ specify attribute title to get from component
Const myAttrTitle As String = "CALLOUT"

Dim myAttrValue As String
Dim output As String

Try
myAttrValue = myComponent.GetStringAttribute(myAttrTitle)
output = ""
Clipboard.SetText(output)

Catch ex As NXException
If ex.ErrorCode = 512008 Then
'attribute not found
MessageBox.Show("Attribute '" & myAttrTitle & "' not found, journal exiting", "Attribute not found", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
Else
theSession.UndoToMark(markId1, undoMarkName)
MessageBox.Show(ex.Message, "Error: " & ex.ErrorCode, MessageBoxButtons.OK, MessageBoxIcon.Error)
End If

Finally

End Try

lw.Close()

End Sub

Sub Mysub2()

'Dim myEdge As Object
Dim myPoint As Point3d
Dim myPointBalloon As Point3d

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI()
' Dim response As Selection.DialogResponse

Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing

Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder
Dim leaderData1 As Annotations.LeaderData
idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.Circle
idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
idSymbolBuilder1.UpperText = Clipboard.GetText
idSymbolBuilder1.Size = 0.35
leaderData1 = workPart.Annotations.CreateLeaderData()
leaderData1.StubSize = 0.25
leaderData1.Arrowhead = Annotations.LeaderData.ArrowheadType.FilledArrow
idSymbolBuilder1.Leader.Leaders.Append(leaderData1)
leaderData1.StubSide = Annotations.LeaderSide.Inferred
idSymbolBuilder1.Origin.SetInferRelativeToGeometry(True)

Dim myedge As object = Nothing
If UserSelectEdge("Select edge to attach balloon", myedge, myPoint) = Selection.Response.Cancel Then
Return
End If
'MsgBox(myPoint.ToString())

Dim nullview As NXOpen.View = Nothing
Dim point1_1 As Point3d = New Point3d(myPoint.X, myPoint.Y, 0)
Dim point2_1 As Point = workPart.Points.CreatePoint(point1_1)
Dim point3_1 As Point3d = New Point3d(myPoint.X, myPoint.Y, 0.0)
leaderData1.Leader.SetValue(point2_1, workPart.Views.WorkView, point3_1)

Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData = Nothing
assocOrigin1.View = nullview
assocOrigin1.ViewOfGeometry = nullview
assocOrigin1.XOffsetFactor = 0.0
assocOrigin1.YOffsetFactor = 0.0
idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)

Dim response2 As Selection.DialogResponse = UserSelectScreenPos("Place balloon", myPointBalloon)
If response2 <> Selection.DialogResponse.Pick Then
Return
End If

Dim point4_1 As Point3d = New Point3d(myPointBalloon.X, myPointBalloon.Y, 0.0)
idSymbolBuilder1.Origin.Origin.SetValue(Nothing, nullview, point4_1)

Dim nXObject1 As NXObject
nXObject1 = idSymbolBuilder1.Commit()
idSymbolBuilder1.Destroy()

End Sub

Function UserSelectEdge(ByVal prompt As String, ByRef selObj As TaggedObject, ByRef selPoint As Point3d) As Selection.Response

'Allow user to interactively select an edge

Dim title As String = "Select an edge"
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(6) As Selection.MaskTriple

'Set the selection criteria to any edge
'TODO: Add point on surface
selectionMask_array(0).Type = UFConstants.UF_solid_type
selectionMask_array(0).Subtype = UFConstants.UF_UI_SEL_FEATURE_ANY_EDGE
selectionMask_array(0).SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_EDGE

selectionMask_array(1).Type = UFConstants.UF_line_type
selectionMask_array(1).Subtype = UFConstants.UF_all_subtype

selectionMask_array(2).Type = UFConstants.UF_circle_type
selectionMask_array(2).Subtype = UFConstants.UF_all_subtype

selectionMask_array(3).Type = UFConstants.UF_conic_type
selectionMask_array(3).Subtype = UFConstants.UF_all_subtype

selectionMask_array(4).Type = UFConstants.UF_spline_type
selectionMask_array(4).Subtype = UFConstants.UF_all_subtype

selectionMask_array(5).Type = UFConstants.UF_solid_silhouette_type
selectionMask_array(5).Subtype = UFConstants.UF_all_subtype

selectionMask_array(6).Type = UFConstants.UF_section_edge_type
selectionMask_array(6).Subtype = UFConstants.UF_all_subtype

'This line allows the user to select from any view:
ufs.Ui.SetCursorView(0)

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, selPoint)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Function UserSelectScreenPos(ByVal prompt As String, ByRef selPoint As Point3d) As Selection.DialogResponse
'Allow user to interactively select a screen position
Dim view As NXOpen.View = Nothing
Return theUI.SelectionManager.SelectScreenPosition(prompt, view, selPoint)
End Function

Function SelectComponent(ByVal prompt As String, ByRef selObj As NXObject) As Selection.Response

Dim title As String = "Select a component"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.AnyInAssembly
Dim selectionMask_array(0) As Selection.MaskTriple

With selectionMask_array(0)
.Type = UFConstants.UF_component_type
.Subtype = UFConstants.UF_all_subtype
End With

Dim resp As Selection.Response = theUI.SelectionManager.SelectObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination

'----Other unload options-------
'Unloads the image immediately after execution within NX
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

'Unloads the image explicitly, via an unload dialog
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Explicitly
'-------------------------------

End Function
End Module

' NX Get the model check result to excel
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports System.IO
Imports Microsoft.Office.Interop.Excel
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Collections
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports NXOpenUI
Imports System.Collections.Generic
Imports System.Threading

Module Checklist
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession

Sub Main()
Dim allParts() As Part = theSession.Parts.ToArray()
Dim ModelParts As New ArrayList
Dim AssyParts As New ArrayList
Dim myPart As Part = Nothing
Dim wbook As Object = Nothing 'Microsoft.Office.Interop.Excel.Workbook = Nothing
Dim wsheet As Object = Nothing 'Worksheet = Nothing
Dim excelFileName As String
Dim excelFileExists As Boolean = False
Dim row As Long = 1
Dim column As Long = 1
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()
Dim PartNo As String = Nothing

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Open a Part")
theSession.SetUndoMarkName(markId1, "Open a Part")

Dim Filename As String = "Checklist"

Dim SaveFileDialog1 As New SaveFileDialog
With SaveFileDialog1
.Title = "Save BoM to Excel File"
.InitialDirectory = "C:\Users\Joe\Desktop\New NX Role\Checklist Codes"
.Filter = "Excel files (*.xlsx)|*.xlsx|Macro enabled Excel files (*.xlsm)|*.xlsm|All files (*.*)|*.*"
.FilterIndex = 1
.RestoreDirectory = True
.OverwritePrompt = False

.FileName = Filename
If .ShowDialog() = DialogResult.OK Then
excelFileName = .FileName
Else
Exit Sub
End If
End With

Dim AppExcel = CreateObject("Excel.Application")
If AppExcel Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not start Excel, journal exiting")
theSession.UndoToMark(markId1, "journal")
Exit Sub
End If

AppExcel.Visible = False

If File.Exists(excelFileName) Then
'Open the Excel file
excelFileExists = True
wbook = AppExcel.Workbooks.Open(excelFileName)
Else
'Create the Excel file
wbook = AppExcel.Workbooks.Add
wbook.SaveAs(excelFileName)
End If
If wbook Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not open Excel file: " & excelFileName & ControlChars.NewLine & "journal exiting.")
theSession.UndoToMark(markId1, "journal")
Exit Sub
End If
wsheet = wbook.Worksheets.Add()

''Add Column Titles and Check point details

wsheet.Cells(1, 1).Value = "Check Points"
wsheet.Cells(1, 2).Value = "Result"
wsheet.Cells(2, 1).Value = "Model view is ISO?"

'wsheet.Cells.AutoFit()
'wsheet.Cells.AutoOutline()

If workPart.ModelingViews.WorkView.Name = "TFR-ISO" And workPart.ModelingViews.WorkView.RenderingStyle = NXOpen.View.RenderingStyleType.StaticWireframe Then

wsheet.Cells(2, 2).Value = "PASSED "
Else
wsheet.Cells(2, 2).Value = "FAILED"

End If

lw.Close()
wbook.Save()
wbook.Close()
AppExcel.Quit()
wsheet = Nothing
wbook = Nothing
AppExcel = Nothing

End Sub

End Module

' NX Get the Part attributes of the component to excel
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Collections
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports NXOpenUI
Imports System.Collections.Generic
Imports System.Threading

Module Exportpartdetails
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession

Sub Main()
Dim allParts() As Part = theSession.Parts.ToArray()
Dim ModelParts As New ArrayList
Dim AssyParts As New ArrayList
Dim myPart As Part = Nothing
Dim wbook As Object = Nothing
Dim wsheet As Object = Nothing
Dim excelFileName As String
Dim excelFileExists As Boolean = False
Dim row As Long = 1
Dim column As Long = 1
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()
Dim PartNo As String = Nothing

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Open a Part")
theSession.SetUndoMarkName(markId1, "Open a Part")

PartNo = InputBox("Please enter the part No /Part rev to open", "Open Part", PartNo)
Dim Filename As String = Left(PartNo, 8)
theSession.Parts.SetNonmasterSeedPartData("@DB/" & PartNo)
Dim basePart1 As BasePart = Nothing

Try
Dim partLoadStatus1 As PartLoadStatus = Nothing
basePart1 = theSession.Parts.Open("@DB/" & PartNo, partLoadStatus1)
partLoadStatus1.Dispose()
Dim partLoadStatus2 As PartLoadStatus = Nothing
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(basePart1, False, True, partLoadStatus2)
partLoadStatus2.Dispose()
Catch exc As NXException
lw.WriteLine(exc.Message)
End Try

' End Sub
'End Module
'Allow the user to create a new excel file or add to an existing one.
Dim SaveFileDialog1 As New SaveFileDialog
With SaveFileDialog1
.Title = "Save BoM to Excel File"
.InitialDirectory = "C:\Users\Joe\Desktop\Study"
.Filter = "Excel files (*.xlsx)|*.xlsx|Macro enabled Excel files (*.xlsm)|*.xlsm|All files (*.*)|*.*"
.FilterIndex = 1
.RestoreDirectory = True
.OverwritePrompt = False

.FileName = Filename
If .ShowDialog() = DialogResult.OK Then
excelFileName = .FileName
Else
Exit Sub
End If
End With

Dim AppExcel = CreateObject("Excel.Application")
If AppExcel Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not start Excel, journal exiting")
theSession.UndoToMark(markId1, "journal")
Exit Sub
End If

AppExcel.Visible = False

If File.Exists(excelFileName) Then
'Open the Excel file
excelFileExists = True
wbook = AppExcel.Workbooks.Open(excelFileName)
Else
'Create the Excel file
wbook = AppExcel.Workbooks.Add
wbook.SaveAs(excelFileName)
End If
If wbook Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not open Excel file: " & excelFileName & ControlChars.NewLine & "journal exiting.")
theSession.UndoToMark(markId1, "journal")
Exit Sub
End If
wsheet = wbook.Worksheets.Add()

''Add Column Titles
'wsheet.Cells(1, 1).Value = "Item ID"
'wsheet.Cells(1, 2).Value = "Description"
'wsheet.Cells(1, 3).Value = "Rev"
'wsheet.Cells(1, 4).Value = "LMD"

Try

For Each myPart In allParts
Dim thisTag As NXOpen.Tag = ufs.Assem.AskRootPartOcc(myPart.Tag)
If thisTag = NXOpen.Tag.Null Then
ModelParts.Add(myPart)
Else
AssyParts.Add(myPart)
End If
Next

For Nextrow As Integer = 1 To ModelParts.Count - 1
Dim Component1 As Part = ModelParts(Nextrow)
Dim Partno1 As String = Nothing
Dim PartDes1 As String = Nothing
Dim PartRev1 As String = Nothing
Dim Material As String = Nothing
Dim Weight As String = Nothing
Dim LastsavedDate As String = Nothing

Dim Text1 As String = Component1.GetHistory(1).ToString()
Dim text2 As String = Text1.Split(",")(3)
LastsavedDate = Right(text2, 17)
Partno1 = Component1.GetStringAttribute("DB_PART_No")
PartDes1 = Component1.GetStringAttribute("DB_PART_Name")
PartRev1 = Component1.GetStringAttribute("DB_PART_Rev")
' Try
' Weight = Component1.GetStringAttribute("$MASS")
' Catch Materror As NXException
' lw.WriteLine(Materror.ToString)
' Weight = "WEIGHT NOT FOUND"
' End Try

Try
Material = Component1.GetStringAttribute("MATERIAL")
Catch Materror As NXException
lw.WriteLine(Materror.ToString)
Material = "MATERIAL NOT ASSIGNED"
End Try

wsheet.Cells(Nextrow, 1).value = Partno1
wsheet.Cells(Nextrow, 2).value = PartDes1
wsheet.Cells(Nextrow, 3).Value = PartRev1
wsheet.Cells(Nextrow, 4).Value = LastsavedDate
wsheet.cells(Nextrow, 5).Value = Material
' wsheet.cells(Nextrow, 6).Value = Weight
lw.WriteLine(Partno1 & text2)
wsheet.Cells.EntireColumn.AutoFit()
Next

wsheet = wbook.Worksheets.Add()

For Nextrow As Integer = 1 To AssyParts.Count - 1
Dim Component2 As Part = AssyParts(Nextrow)
Dim Partno2 As String = Nothing
Dim PartDes2 As String = Nothing
Dim PartRev2 As String = Nothing
Dim Material As String = Nothing
Dim LastsavedDate As String = Nothing

Dim Text1 As String = Component2.GetHistory(1).ToString()
Dim text2 As String = Text1.Split(",")(3)
LastsavedDate = Right(text2, 17)
Partno2 = Component2.GetStringAttribute("DB_PART_No")
PartDes2 = Component2.GetStringAttribute("DB_PART_Name")
PartRev2 = Component2.GetStringAttribute("DB_PART_Rev")

wsheet.Cells(Nextrow, 1).value = Partno2
wsheet.Cells(Nextrow, 2).value = PartDes2
wsheet.Cells(Nextrow, 3).Value = PartRev2
wsheet.Cells(Nextrow, 4).Value = LastsavedDate
lw.WriteLine(Partno2 & Text1)
wsheet.Cells.EntireColumn.AutoFit()
Next
Catch e As Exception
theSession.ListingWindow.WriteLine("Failed: " & e.ToString)
End Try
lw.Close()
wbook.Save()
wbook.Close()
AppExcel.Quit()
wsheet = Nothing
wbook = Nothing
AppExcel = Nothing

End Sub

End Module

' NX Delete ID Symbols of type from current session
' Journal created by Alto on 10-06-2015

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

Module delete_ID_symbols

Sub Main()

Dim theSession As Session = Session.GetSession()

If IsNothing(theSession.Parts.Work) Then
Return
End If

Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()

Const undoMarkName As String = "Delete ID symbols: triangle up"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, undoMarkName)

If workPart.Annotations.IdSymbols.ToArray.Length = 0 Then
lw.WriteLine("No ID symbols found in current work part")
Return
End If

Dim triangleUp As New List(Of Annotations.IdSymbol)

'loop through all the ID symbols in the part
For Each tempID As Annotations.IdSymbol In workPart.Annotations.IdSymbols

Dim oldIdBuilder As Annotations.IdSymbolBuilder

oldIdBuilder = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(tempID)

'type of symbol to change
If oldIdBuilder.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp Then
triangleUp.Add(tempID)
End If

oldIdBuilder.Destroy()

Next

Try

theSession.UpdateManager.ClearErrorList()

Dim markId2 As Session.UndoMarkId
markId2 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Delete ID symbols")

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(triangleUp.ToArray)

Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId2)

Catch ex As NXException
theSession.UndoToMark(markId1, undoMarkName)
MsgBox(ex.Message)

End Try

lw.Close()

End Sub

End Module

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
Imports System.Collections.Generic
Imports NXOpen.UF.UFDraw
Imports NXOpen.Drawings
Imports System.Windows.Forms.MessageBox
Imports System.IO
Imports System.Collections

' Add drawing Stamp in NX
' Journal created by Alto on 10-06-2015

Module NXJournal

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim ufs As UFSession = UFSession.GetUFSession()
Dim ui As UI = ui.GetUI()
Dim fontIndex1 As Integer
Sub Main()
Dim dwgs As Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim shts As New ArrayList()
For Each sheet In dwgs
shts.Add(sheet.Name)
Next
If shts.Count > 1 Then
Call Stamponmultiplesheet()
ElseIf shts.Count = 1 Then
Call Stamponsinglesheet()
End If
End Sub
Sub Stamponsinglesheet()
' Create the tabular note
Dim taborgin As Point3d = New Point3d(9.72414748499, 2.55025773063, 0)
Dim newcolumns As Integer = 3
Dim newrows As Integer = 5
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(newrows, newcolumns, taborgin)

' Get the column tags
Dim columns(newcolumns - 1) As NXOpen.Tag
Dim rows(newrows) As NXOpen.Tag
Dim i As Integer
Dim j As Integer
Dim height As Double = Nothing
Dim width As Double = Nothing
For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.7
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next

For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.22
ufs.Tabnot.SetRowHeight(rows(j), height)
Next

Dim pt1 As Point = Nothing
Dim cell1 As NXOpen.Tag
Dim cellprefes As UFTabnot.CellPrefs = Nothing
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(2), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
Dim cell3 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell3)
Dim cell4 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(2), cell4)
ufs.Tabnot.MergeCells(cell3, cell4)

ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "IN REVIEW PROCESS CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "E CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "NOG")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "CM")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "CERT")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "ENG APVD")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "METHODS")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "FLAM")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "DESIGN ENG")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "(IN ACCORDANCE WITH ALL APPLICABLE PROCESSES AND PROCEDURES)")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodWrap
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeText
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
For i = 0 To newrows - 1
For j = 0 To newcolumns - 1
ufs.Tabnot.AskCellAtRowCol(rows(i), columns(j), cell1)
ufs.Tabnot.AskCellPrefs(cell1, cellprefes)
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
cellprefes.format = UFTabnot.Format.FormatText
cellprefes.text_font = fontIndex1
cellprefes.text_height = 0.05
cellprefes.text_aspect_ratio = 1.0 '
cellprefes.text_angle = 0.0
cellprefes.text_slant = 0.0
cellprefes.line_space_factor = 1.0
cellprefes.char_space_factor = 1.0
cellprefes.text_color = 6
cellprefes.horiz_just = UFTabnot.Just.JustLeft
cellprefes.vert_just = UFTabnot.Just.JustTop
ufs.Tabnot.SetCellPrefs(cell1, cellprefes)

Next
Next

For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.75
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next

For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.23238
ufs.Tabnot.SetRowHeight(rows(j), height)
Next
ufs.Tabnot.AskRowHeight(rows(0), height)
height = 0.1
ufs.Tabnot.SetRowHeight(rows(0), height)
ufs.Tabnot.AskRowHeight(rows(4), height)
height = 0.2
ufs.Tabnot.SetRowHeight(rows(4), height)

Dim notifyOnDelete1 As Boolean
notifyOnDelete1 = theSession.Preferences.Modeling.NotifyOnDelete

theSession.UpdateManager.ClearErrorList()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete")

Dim objects1(0) As NXObject
Dim view1 As NXOpen.View = CType(workPart.Views.FindObject("SH02@0"), NXOpen.View)

objects1(0) = view1
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)

Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = theSession.Preferences.Modeling.NotifyOnDelete

Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)

Call Printpdf()

Dim notifyOnDelete3 As Boolean
notifyOnDelete3 = theSession.Preferences.Modeling.NotifyOnDelete

theSession.UpdateManager.ClearErrorList()

Dim markId2 As Session.UndoMarkId
markId2 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete")

Dim objects2(0) As NXObject
Dim displayableObject1 As DisplayableObject = CType(workPart.FindObject("ENTITY 165 9 1"), DisplayableObject)

objects2(0) = displayableObject1
Dim nErrs3 As Integer
nErrs3 = theSession.UpdateManager.AddToDeleteList(objects2)

Dim notifyOnDelete4 As Boolean
notifyOnDelete4 = theSession.Preferences.Modeling.NotifyOnDelete

Dim nErrs4 As Integer
nErrs4 = theSession.UpdateManager.DoUpdate(markId2)
End Sub

Sub Stamponmultiplesheet()
' Create the tabular note
Dim taborgin As Point3d = New Point3d(9.72414748499, 2.55025773063, 0)
Dim newcolumns As Integer = 3
Dim newrows As Integer = 5
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(newrows, newcolumns, taborgin)

' Get the column tags
Dim columns(newcolumns - 1) As NXOpen.Tag
Dim rows(newrows) As NXOpen.Tag
Dim i As Integer
Dim j As Integer
Dim height As Double = Nothing
Dim width As Double = Nothing
For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.7
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next

For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.22
ufs.Tabnot.SetRowHeight(rows(j), height)
Next

Dim pt1 As Point = Nothing
Dim cell1 As NXOpen.Tag
Dim cellprefes As UFTabnot.CellPrefs = Nothing
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(2), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
Dim cell3 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell3)
Dim cell4 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(2), cell4)
ufs.Tabnot.MergeCells(cell3, cell4)

ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "check1")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "check2")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "check3")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "check4")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "check5")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "check6")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "check7")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "check8")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "check9")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "check10")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1," check11")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodWrap
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeText
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
For i = 0 To newrows - 1
For j = 0 To newcolumns - 1
ufs.Tabnot.AskCellAtRowCol(rows(i), columns(j), cell1)
ufs.Tabnot.AskCellPrefs(cell1, cellprefes)
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
cellprefes.format = UFTabnot.Format.FormatText
cellprefes.text_font = fontIndex1
cellprefes.text_height = 0.05
cellprefes.text_aspect_ratio = 1.0 '
cellprefes.text_angle = 0.0
cellprefes.text_slant = 0.0
cellprefes.line_space_factor = 1.0
cellprefes.char_space_factor = 1.0
cellprefes.text_color = 6
cellprefes.horiz_just = UFTabnot.Just.JustLeft
cellprefes.vert_just = UFTabnot.Just.JustTop
ufs.Tabnot.SetCellPrefs(cell1, cellprefes)

Next
Next

For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.75
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next

For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.23238
ufs.Tabnot.SetRowHeight(rows(j), height)
Next
ufs.Tabnot.AskRowHeight(rows(0), height)
height = 0.1
ufs.Tabnot.SetRowHeight(rows(0), height)
ufs.Tabnot.AskRowHeight(rows(4), height)
height = 0.2
ufs.Tabnot.SetRowHeight(rows(4), height)

Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing

Call Printpdf()

Dim notifyOnDelete1 As Boolean
notifyOnDelete1 = theSession.Preferences.Modeling.NotifyOnDelete

theSession.UpdateManager.ClearErrorList()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete")

Dim objects1(0) As NXObject
Dim displayableObject1 As DisplayableObject = CType(workPart.FindObject("ENTITY 165 9 1"), DisplayableObject)

objects1(0) = displayableObject1
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)

Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = theSession.Preferences.Modeling.NotifyOnDelete

Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
End Sub

Sub Printpdf()

Dim dwgs As Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim i As Integer
Dim pdfFile As String = Nothing
Dim currentPath As String = Nothing
Dim currentFile As String = Nothing
Dim exportFile As String = Nothing
Dim partUnits As Integer = Nothing
Dim strOutputFolder As String = Nothing
Dim strRevision As String = Nothing
Dim rspFileExists
Dim rspAdvancePrint = Nothing

Dim IsTcEng As Boolean = False
Dim UFSes As UFSession = UFSession.GetUFSession()
UFSes.UF.IsUgmanagerActive(IsTcEng)

partUnits = displayPart.PartUnits

'Read TCE attributes
If IsTcEng Then
currentFile = workPart.GetStringAttribute("DB_PART_NO")
strRevision = workPart.GetStringAttribute("DB_PART_REV")
End If
exportFile = currentFile

strOutputFolder = OutputPath()
'if we don't have a valid directory (ie the user pressed 'cancel') exit the journal
If Not Directory.Exists(strOutputFolder) Then
Exit Sub
End If
strOutputFolder = strOutputFolder & "\"

Dim shts As New ArrayList()
For Each sheet In dwgs
shts.Add(sheet.Name)
Next
shts.Sort()

i = 0
Dim sht As String
For Each sht In shts

For Each sheet In dwgs
If sheet.Name = sht Then
i = i + 1

If strRevision <> "" Then
pdfFile = strOutputFolder & "ECHECK_" & exportFile & "_" & strRevision & ".pdf"
Else
pdfFile = strOutputFolder & exportFile & ".pdf"

End If

If i = 1 Then
If File.Exists(pdfFile) Then
rspFileExists = MsgBox("The file: '" & pdfFile & "' Already exists; overwrite?", vbYesNo + vbQuestion)
If rspFileExists = vbYes Then
Try
File.Delete(pdfFile)
Catch ex As Exception
MsgBox(ex.Message & vbCrLf & "Journal exiting", vbCritical + vbOKOnly, "Error")
Exit Sub
End Try
Else
Exit Sub
End If
End If
End If

'update any views that are out of date
theSession.Parts.Work.DraftingViews.UpdateViews(Drawings.DraftingViewCollection.ViewUpdateOption.OutOfDate, sheet)

Try
ExportPDF(sheet, pdfFile, partUnits, rspAdvancePrint)
Catch ex As Exception
MsgBox("Error occurred in PDF export" & vbCrLf & ex.Message & vbCrLf & "journal exiting", vbCritical + vbOKOnly, "Error")
Exit Sub
End Try
Exit For
End If
Next

Next

If i = 0 Then
MessageBox.Show("This part has no drawing sheets to export", "PDF export failure", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Else
MessageBox.Show("Exported: " & i & " sheet(s) to pdf file" & vbCrLf & pdfFile, "PDF export success", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If

End Sub

Function OutputPath()

Dim strLastPath As String = Nothing

Try
strLastPath = GetSetting("NX journal", "Export pdf", "ExportPath")
Catch e As ArgumentException
Catch e As Exception
MsgBox(e.GetType.ToString)
Finally
End Try

Dim FolderBrowserDialog1 As New FolderBrowserDialog

With FolderBrowserDialog1
.RootFolder = Environment.SpecialFolder.Desktop
If Directory.Exists(strLastPath) Then
.SelectedPath = strLastPath
Else
.SelectedPath = "H:\"
End If
.Description = "Select the directory to export .pdf file"
If .ShowDialog = DialogResult.OK Then
OutputPath = .SelectedPath
SaveSetting("NX journal", "Export pdf", "ExportPath", .SelectedPath)
Else
OutputPath = 0
End If
End With

End Function

Sub ExportPDF(dwg As Drawings.DrawingSheet, outputFile As String, units As Integer, advancePrint As Integer)

Dim printPDFBuilder1 As PrintPDFBuilder

printPDFBuilder1 = workPart.PlotManager.CreatePrintPdfbuilder()
printPDFBuilder1.Scale = 1.0
printPDFBuilder1.Action = PrintPDFBuilder.ActionOption.Native
printPDFBuilder1.Colors = PrintPDFBuilder.Color.BlackOnWhite
printPDFBuilder1.Size = PrintPDFBuilder.SizeOption.ScaleFactor
If units = 0 Then
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.English
Else
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.Metric
End If
printPDFBuilder1.XDimension = dwg.Height
printPDFBuilder1.YDimension = dwg.Length
printPDFBuilder1.OutputText = PrintPDFBuilder.OutputTextOption.Polylines
printPDFBuilder1.RasterImages = True
printPDFBuilder1.ImageResolution = PrintPDFBuilder.ImageResolutionOption.Medium
printPDFBuilder1.Append = True

Dim sheets1(0) As NXObject
Dim drawingSheet1 As Drawings.DrawingSheet = CType(dwg, Drawings.DrawingSheet)

sheets1(0) = drawingSheet1
printPDFBuilder1.SourceBuilder.SetSheets(sheets1)

printPDFBuilder1.Filename = outputFile

Dim nXObject1 As NXObject
nXObject1 = printPDFBuilder1.Commit()

printPDFBuilder1.Destroy()

End Sub

Public Function CreateTabnoteWithSize( _
ByVal nRows As Integer, ByVal nColumns As Integer, ByVal loc As Point3d) As NXOpen.Tag
Dim secPrefs As UFTabnot.SectionPrefs = Nothing
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim cellPrefs As UFTabnot.CellPrefs = Nothing
Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows - 1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns - 1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next

Dim columns(nColumns - 1) As NXOpen.Tag
For ii As Integer = 0 To nColumns - 1
If ii = 0 Then
ufs.Tabnot.CreateColumn(20, columns(ii))
Else
ufs.Tabnot.CreateColumn(40, columns(ii))
End If
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next

Dim rows(nRows - 1) As NXOpen.Tag
For ii As Integer = 0 To nRows - 1
ufs.Tabnot.CreateRow(10, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next
Return tabnote

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module

' NX Export Step File
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
Imports System.Collections.Generic
Imports NXOpen.UF.UFDraw
Imports NXOpen.Drawings

Module Stepexport

Dim theSession As Session = Session.GetSession()
Dim lw As ListingWindow = theSession.ListingWindow
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession

Sub Main(ByVal args() As String)

Dim myPart As Part = Nothing
Dim lw As ListingWindow = theSession.ListingWindow
Dim PartNo As String = Nothing

lw.Open()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Open a Part")
theSession.SetUndoMarkName(markId1, "Open a Part")

PartNo = InputBox("Please enter the part No /Part rev to open", "Open Part", PartNo)
Dim Filename As String = Left(PartNo, 8)
theSession.Parts.SetNonmasterSeedPartData("@DB/" & PartNo)
Dim basePart1 As BasePart = Nothing

Try
Dim partLoadStatus1 As PartLoadStatus = Nothing
basePart1 = theSession.Parts.Open("@DB/" & PartNo, partLoadStatus1)
partLoadStatus1.Dispose()
Dim partLoadStatus2 As PartLoadStatus = Nothing
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(basePart1, False, True, partLoadStatus2)
partLoadStatus2.Dispose()
Catch exc As NXException
lw.WriteLine("NX Exception" & exc.Message)
Catch exc1 As AccessViolationException
lw.WriteLine("Access Violation" & exc1.Message)
Catch exc2 As ArgumentNullException
lw.WriteLine("NullException" & exc2.Message)
Catch exc3 As ArgumentOutOfRangeException
lw.WriteLine("Outof range" & exc3.Message)

End Try

Dim stepExportFileName As String = Environ("USERPROFILE") & "\Desktop\" & Filename & ".stp"
Dim step214Creator1 As Step214Creator
Do
step214Creator1 = theSession.DexManager.CreateStep214Creator()
With step214Creator1
.ExportFrom = Step214Creator.ExportFromOption.DisplayPart
.SettingsFile = "C:\apps\nx075\step214ug\ugstep214.def"
.ObjectTypes.Curves = False
.ObjectTypes.Surfaces = False
.ObjectTypes.Solids = True
.ObjectTypes.Csys = True
.ObjectTypes.ProductData = False
.ObjectTypes.Annotations = False
.ObjectTypes.Structures = False
.InputFile = "@DB/" & PartNo
.OutputFile = stepExportFileName
.FileSaveFlag = False
.BsplineTol = 0.001
.LayerMask = "1-256"
End With

Dim nXObject1 As NXObject
nXObject1 = step214Creator1.Commit()
Loop
step214Creator1.Destroy()

theSession.Parts.CloseAll(BasePart.CloseModified.CloseModified, Nothing)
workPart = Nothing
displayPart = Nothing

End Sub

End Module

' NX Font Update
' Journal created by Alto on 20-05-2015

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
Imports System.Collections.Generic
Imports NXOpen.UF.UFDraw
Imports NXOpen.Drawings

Module Fontupdate
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Sub Main()
Dim fontIndex1 As Integer
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")

'Update Note Dimension
For Each note1 As Annotations.Note In workPart.Notes
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = note1.GetLineAndArrowPreferences()
Dim letteringPreferences1 As Annotations.LetteringPreferences
letteringPreferences1 = note1.GetLetteringPreferences()
Dim generalText1 As Annotations.Lettering
generalText1.Size = 0.1
generalText1.CharacterSpaceFactor = 1.0
generalText1.AspectRatio = 1.0
generalText1.LineSpaceFactor = 1.0
generalText1.Cfw.Color = 6
generalText1.Cfw.Font = fontIndex1
generalText1.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences1.SetGeneralText(generalText1)
note1.SetLetteringPreferences(letteringPreferences1)
note1.RedisplayObject()
Next

'Update Special Notes of
For Each note2 As Annotations.Note In workPart.Notes
Dim Text1(50) As String
Text1 = note2.GetText

'Update part mark symbol in Title Block
If Text1(0) = "" Then
Dim lineAndArrowPreferences2 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences2 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences2 As Annotations.LetteringPreferences
letteringPreferences2 = note2.GetLetteringPreferences()
Dim generalText2 As Annotations.Lettering
generalText2.Size = 0.06
generalText2.CharacterSpaceFactor = 1.0
generalText2.AspectRatio = 1.0
generalText2.LineSpaceFactor = 1.0
generalText2.Cfw.Color = 2
generalText2.Cfw.Font = fontIndex1
generalText2.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences2.SetGeneralText(generalText2)
note2.SetLetteringPreferences(letteringPreferences2)
note2.RedisplayObject()

'Update NRE job No and the Sheet no font
ElseIf Text1(0) = "" Or Text1(0) = " " Then
Dim lineAndArrowPreferences3 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences3 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences3 As Annotations.LetteringPreferences
letteringPreferences3 = note2.GetLetteringPreferences()
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.09
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = fontIndex1
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences3.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences3)
note2.RedisplayObject()
'Update HARDCOPIES ARE TO BE CONSIDERED UNCONTROLLED font
ElseIf Text1(0) = "HARDCOPIES ARE TO BE CONSIDERED UNCONTROLLED" Then
Dim lineAndArrowPreferences3 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences3 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences3 As Annotations.LetteringPreferences
letteringPreferences3 = note2.GetLetteringPreferences()
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.07
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 6
generalText3.Cfw.Font = fontIndex1
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences3.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences3)
note2.RedisplayObject()

'Update Title of the Dwg In Title Block
ElseIf Text1(0) = "" Then

Dim lineAndArrowPreferences4 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences4 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences4 As Annotations.LetteringPreferences
letteringPreferences4 = note2.GetLetteringPreferences()
Dim generalText3 As Annotations.Lettering
generalText3.Size = 0.125
generalText3.CharacterSpaceFactor = 1.0
generalText3.AspectRatio = 1.0
generalText3.LineSpaceFactor = 1.0
generalText3.Cfw.Color = 2
generalText3.Cfw.Font = fontIndex1
generalText3.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences4.SetGeneralText(generalText3)
note2.SetLetteringPreferences(letteringPreferences4)
note2.RedisplayObject()

'Update Section View letters in Parent view
ElseIf Text1(0).Contains("SX_SEG") Then

Dim lineAndArrowPreferences7 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences7 = note2.GetLineAndArrowPreferences()
Dim letteringPreferences7 As Annotations.LetteringPreferences
letteringPreferences7 = note2.GetLetteringPreferences()
Dim generalText2 As Annotations.Lettering
generalText2.Size = 0.25
generalText2.CharacterSpaceFactor = 1.0
generalText2.AspectRatio = 1.0
generalText2.LineSpaceFactor = 1.0
generalText2.Cfw.Color = 6
generalText2.Cfw.Font = fontIndex1
generalText2.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences7.SetGeneralText(generalText2)
note2.SetLetteringPreferences(letteringPreferences7)
note2.RedisplayObject()

'Update View lable style for view labels and Label on Parent
ElseIf Text1(0).Contains("VWLETTER") Then

Dim Tag1 As NXOpen.Tag = note2.Tag
Dim Labelparms1 As UFDraw.ViewLabelParms = Nothing
ufs.Draw.AskViewLabelParms(Tag1, Labelparms1)
Labelparms1.letter_size_factor = 2.0
ufs.Draw.SetViewLabelParms(Tag1, Labelparms1)

End If
'Update old flagnote Symbols to newone
For Each Line As String In Text1

Replace(Line.ToUpper, "<%5>", "<%FLAG_5>")

Next

Next

'Update All the Dimension Fonts
For Each Dimension1 As Dimension In workPart.Dimensions
Dim dimensionPreferences1 As Annotations.DimensionPreferences
dimensionPreferences1 = Dimension1.GetDimensionPreferences()
Dim letteringPreferences5 As Annotations.LetteringPreferences
letteringPreferences5 = Dimension1.GetLetteringPreferences()
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Dimension1.GetLineAndArrowPreferences()
Dim dimensionText1 As Annotations.Lettering
dimensionText1.Size = 0.1
dimensionText1.CharacterSpaceFactor = 2.0
dimensionText1.AspectRatio = 1.0
dimensionText1.LineSpaceFactor = 1.0
dimensionText1.Cfw.Color = 6
dimensionText1.Cfw.Font = fontIndex1
dimensionText1.Cfw.Width = Annotations.LineWidth.Thin
lineAndArrowPreferences1.ArrowheadLength = 0.125
lineAndArrowPreferences1.FirstArrowType = ArrowheadType.FilledArrow
lineAndArrowPreferences1.SecondArrowType = ArrowheadType.FilledArrow
lineAndArrowPreferences1.ArrowheadIncludedAngle = 30
lineAndArrowPreferences1.FirstPosToExtLineDist = 0.1
lineAndArrowPreferences1.SecondPosToExtLineDist = 0.1
lineAndArrowPreferences1.ObliqueExtensionLineAngle = 0.0
lineAndArrowPreferences1.LinePastArrowDistance = 0.125
lineAndArrowPreferences1.TextToLineDistance = 0.1
lineAndArrowPreferences1.StubLength = 0.25
'Dim Dimensionradial As Annotations.DiameterRadiusPreferences = Nothing
'Dimensionradial.DiameterSymbol = DiameterSymbol.Dia
'Dimensionradial.RadiusSymbol = RadiusSymbol.R
'Dimensionradial.DistanceBetweenSymbolAndDimensionText = 0.0
letteringPreferences5.SetDimensionText(dimensionText1)
letteringPreferences5.SetAppendedText(dimensionText1)
letteringPreferences5.SetToleranceText(dimensionText1)
Dimension1.SetLetteringPreferences(letteringPreferences5)
Dimension1.SetLineAndArrowPreferences(lineAndArrowPreferences1)
'Dimension1.get()
dimensionPreferences1.Dispose()
letteringPreferences5.Dispose()
lineAndArrowPreferences1.Dispose()
Dimension1.RedisplayObject()
Next

'Update all Id symbols Line and Arrow preferences not included as User need different Arrowheads
For Each Idsymbol1 As Annotations.IdSymbol In workPart.Annotations.IdSymbols
Dim symbolPreferences1 As Annotations.SymbolPreferences
symbolPreferences1 = Idsymbol1.GetSymbolPreferences()
Dim lineAndArrowPreferences1 As Annotations.LineAndArrowPreferences
lineAndArrowPreferences1 = Idsymbol1.GetLineAndArrowPreferences()
Dim letteringPreferences6 As Annotations.LetteringPreferences
letteringPreferences6 = Idsymbol1.GetLetteringPreferences()
Dim generalText4 As Annotations.Lettering
generalText4.Size = 0.1
generalText4.CharacterSpaceFactor = 1.0
generalText4.AspectRatio = 1.0
generalText4.LineSpaceFactor = 1.0
generalText4.Cfw.Color = 6
generalText4.Cfw.Font = fontIndex1
generalText4.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences6.SetGeneralText(generalText4)
Idsymbol1.SetLetteringPreferences(letteringPreferences6)
symbolPreferences1.IdSymbolSize = 0.35
Idsymbol1.SetSymbolPreferences(symbolPreferences1)
letteringPreferences6.Dispose()
lineAndArrowPreferences1.Dispose()
symbolPreferences1.Dispose()
Idsymbol1.RedisplayObject()
Next

'Update the View label based on True section on projected view (using section)
For Each tempView As Drawings.DraftingView In workPart.DraftingViews

If TypeOf (tempView) Is Drawings.SectionView Then
Dim viewLabelTag As Tag
ufs.Draw.AskViewLabel(tempView.Tag, viewLabelTag)
Dim Tag1 As NXOpen.Tag = viewLabelTag ' Need to tag the tempview label
Dim Labelparms1 As UFDraw.ViewLabelParms = Nothing
ufs.Draw.AskViewLabelParms(Tag1, Labelparms1)
If IsSectioned(tempView) Then
Labelparms1.view_label_prefix = "SECTION"
Else
Labelparms1.view_label_prefix = "VIEW"
Labelparms1.scale_label = False
End If
ufs.Draw.SetViewLabelParms(Tag1, Labelparms1)

End If
Next

'Update Label Font for all the Labels
Dim NULL_TAG As NXOpen.Tag = NXOpen.Tag.Null
Dim obj As NXOpen.Tag = NULL_TAG

Do
obj = ask_next_drf_entity(obj)
If obj = NULL_TAG Then
GoTo end1
End If
' Check whether returned Tag is UF_draft_label_subtype
Dim type As Integer = Nothing
Dim subtype As Integer = Nothing
ufs.Obj.AskTypeAndSubtype(obj, type, subtype)
Dim nxobj As NXObject = NXObjectManager.Get(obj)

If nxobj.GetType().ToString() = "NXOpen.Annotations.Labelonparent" Then
Dim Label1 As Annotations.Label = nxobj
Dim letteringPreferences7 As Annotations.LetteringPreferences
letteringPreferences7 = Label1.GetLetteringPreferences()
Dim generalText5 As Annotations.Lettering
generalText5.Size = 0.1
generalText5.CharacterSpaceFactor = 1.0
generalText5.AspectRatio = 1.0
generalText5.LineSpaceFactor = 1.0
generalText5.Cfw.Color = 6
generalText5.Cfw.Font = fontIndex1
generalText5.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences7.SetGeneralText(generalText5)
Label1.SetLetteringPreferences(letteringPreferences7)
letteringPreferences7.Dispose()
Label1.RedisplayObject()
Continue Do

ElseIf nxobj.GetType().ToString() <> "NXOpen.Annotations.Label" Then
Continue Do

Else
Dim Label1 As Annotations.Label = nxobj
Dim text2() As String
text2 = Label1.GetText()
Dim letteringPreferences7 As Annotations.LetteringPreferences
letteringPreferences7 = Label1.GetLetteringPreferences()
Dim generalText5 As Annotations.Lettering
generalText5.Size = 0.1
If text2(0).Contains("VWLETTER") Then
generalText5.Size = 0.1
End If
generalText5.CharacterSpaceFactor = 1.0
generalText5.AspectRatio = 1.0
generalText5.LineSpaceFactor = 1.0
generalText5.Cfw.Color = 6
generalText5.Cfw.Font = fontIndex1
generalText5.Cfw.Width = Annotations.LineWidth.Thin
letteringPreferences7.SetGeneralText(generalText5)
Label1.SetLetteringPreferences(letteringPreferences7)
letteringPreferences7.Dispose()
Label1.RedisplayObject()
End If

Loop Until obj = NULL_TAG
End1:

'Update All table cells Font to correct standard user need to define cellPrefs1.format individually if requires per code it will be Text
Dim myTabularNoteTags As New List(Of Tag)
If FindTabularNotes(myTabularNoteTags) = 0 Then
'no tabular notes to process
Return
End If
For Each tableNote As Tag In myTabularNoteTags
Dim numRows As Integer
ufs.Tabnot.AskNmRows(tableNote, numRows)
Dim numCols As Integer
ufs.Tabnot.AskNmColumns(tableNote, numCols)
Dim tableOrigin(2) As Double
Dim tableSectionTag As Tag
ufs.Tabnot.AskNthSection(tableNote, 0, tableSectionTag)
For i As Integer = 0 To numRows - 1
Dim rowTag As Tag
ufs.Tabnot.AskNthRow(tableNote, i, rowTag)
For j As Integer = 0 To numCols - 1
Dim colTag As Tag
ufs.Tabnot.AskNthColumn(tableNote, j, colTag)
Dim cellTag As Tag
ufs.Tabnot.AskCellAtRowCol(rowTag, colTag, cellTag)
Dim cellPrefs1 As UFTabnot.CellPrefs = Nothing
ufs.Tabnot.AskCellPrefs(cellTag, cellPrefs1)
cellPrefs1.format = UFTabnot.Format.FormatFixed
cellPrefs1.text_font = fontIndex1
cellPrefs1.text_height = 0.075
cellPrefs1.text_aspect_ratio = 1.0 '
cellPrefs1.text_angle = 0.0
cellPrefs1.text_slant = 0.0
cellPrefs1.line_space_factor = 1.0
cellPrefs1.char_space_factor = 1.0
cellPrefs1.text_color = 6
ufs.Tabnot.SetCellPrefs(cellTag, cellPrefs1)

Next
Next
Next

End Sub

Function FindTabularNotes(ByRef theTabNotes As List(Of Tag)) As Integer

Dim tmpTabNote As NXOpen.Tag = NXOpen.Tag.Null
Dim type As Integer
Dim subtype As Integer

Do
ufs.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_tabular_note_type, tmpTabNote)
If tmpTabNote = NXOpen.Tag.Null Then
Continue Do
End If
If tmpTabNote <> NXOpen.Tag.Null Then
ufs.Obj.AskTypeAndSubtype(tmpTabNote, type, subtype)
If subtype = UFConstants.UF_tabular_note_subtype Then
theTabNotes.Add(tmpTabNote)
End If
End If
Loop Until tmpTabNote = NXOpen.Tag.Null
Return theTabNotes.Count

End Function

Function IsSectioned(ByVal sectionView As Drawings.SectionView) As Boolean

Dim sxSolidTags() As Tag = Nothing
Dim numSxSolids As Integer
ufs.Draw.AskSxsolidsOfSxview(sectionView.Tag, Nothing, numSxSolids, sxSolidTags)

'lw.WriteLine("num section solids: " & numSxSolids.ToString)

Return numSxSolids > 0

End Function

Public Function ask_next_drf_entity(ByRef obj As NXOpen.Tag) As NXOpen.Tag
Dim part As NXOpen.Tag = workPart.Tag
ufs.Obj.CycleObjsInPart(part, UFConstants.UF_drafting_entity_type, obj)
Return obj
End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function

End Module

' NX Make System wake for Maximum of 16 hrs (ie: Maintain TCE NX link without getting Broken)
' Journal created by Alto on 16-05-2016

' Stop Work in NX. Go to Format>>>Database attributes >>>>Reload Database attributes.
' Press Alt+F11 in NX Window or go to Tools>>Journal>>Edit.
' Copy this enitire Script and paste in the editor and press play icon to run the Journal.

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports System.Threading

Module KeepSystemAlive

Sub Main()

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim databaseAttributeManager1 As PDM.DatabaseAttributeManager
Dim Timealive As Integer = 14

If Timealive = 14 Then

' Keep the NX sleep for 12 hrs (Normal Kickout time 4 hrs + 2 hrs = Result 6 hrs)

System.Threading.Thread.Sleep(14400000) ' This will update the Database attributes after 4 hrs=14400000 milliseconds

' Format>>>Database attributes >>>>Reload Database attributes(This Will keep the NX TCE interaction)
'Dim databaseAttributeManager1 As PDM.DatabaseAttributeManager
databaseAttributeManager1 = workPart.PDMPart.NewDatabaseAttributeManager()
databaseAttributeManager1.RefreshAttributes()
databaseAttributeManager1.StoreAttributes()
databaseAttributeManager1.Dispose()

System.Threading.Thread.Sleep(14400000) ' This will update the Database attributes after 4 hrs=14400000 milliseconds

' Format>>>Database attributes >>>>Reload Database attributes(This Will keep the NX TCE interaction)
'Dim databaseAttributeManager1 As PDM.DatabaseAttributeManager
databaseAttributeManager1 = workPart.PDMPart.NewDatabaseAttributeManager()
databaseAttributeManager1.RefreshAttributes()
databaseAttributeManager1.StoreAttributes()
databaseAttributeManager1.Dispose()
System.Threading.Thread.Sleep(14400000) ' This will update the Database attributes after 4 hrs=14400000 milliseconds

' Format>>>Database attributes >>>>Reload Database attributes(This Will keep the NX TCE interaction)
'Dim databaseAttributeManager1 As PDM.DatabaseAttributeManager
databaseAttributeManager1 = workPart.PDMPart.NewDatabaseAttributeManager()
databaseAttributeManager1.RefreshAttributes()
databaseAttributeManager1.StoreAttributes()
databaseAttributeManager1.Dispose()

End If

End Sub

End Module

' NX Model Check
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Collections
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.UF.UFSket
Imports NXOpen.Assemblies
Imports NXOpenUI
Imports System.Collections.Generic
Imports System.Threading

Module Modelchecklist
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession

Sub Main()
'Dim allParts() As Part = theSession.Parts.ToArray()
'Dim ModelParts As New ArrayList
'Dim AssyParts As New ArrayList
'Dim myPart As Part = Nothing
'Dim wbook As Object = Nothing
'Dim wsheet As Object = Nothing
'Dim excelFileName As String
'Dim excelFileExists As Boolean = False
'Dim row As Long = 1
'Dim column As Long = 1
Dim Sketch1 As Sketch = Nothing
Dim Dof As Integer = Nothing
Dim Dim1 As DisplayableObject = Nothing
Dim Datum1 As DisplayableObject = Nothing

'Dim Allsketchs As List(Of Sketch) = Nothing
'Allsketchs.Add(workPart.Sketches.GetOwningSketch)

Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()
lw.WriteLine("HI")
Dim PartNo As String = Nothing

For Each referenceSet1 As ReferenceSet In workPart.GetAllReferenceSets()
If referenceSet1.Name = "MODEL" Then
For Each Referencesetitem As Object In referenceSet1.AskAllDirectMembers()
If Not Referencesetitem.GetType.ToString() = "NXOpen.Body" Then
lw.WriteLine("Model Referenceset contains Wrong Item")
End If
Next
End If
Next

For Each Sketch1 In workPart.Sketches.ToArray
Try
Sketch1.Activate(Sketch.ViewReorient.False)
Sketch1.GetStatus(Dof)
If Not Dof = 0 Then
lw.WriteLine("Sketch" & Sketch1.Name.ToString() & "-" & "Not Fully consrtained and Have" & Dof & "Degrees Of Freedom")
End If
Sketch1.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.SketchOnly)
Catch Err1 As NXException
lw.WriteLine(Err1.ToString())
End Try
Next

For Each Sketch1 In workPart.Sketches.ToArray
Try
Sketch1.Activate(Sketch.ViewReorient.False)
If Sketch1.IsInternal = True Then
lw.WriteLine("Sketch" & Sketch1.Name.ToString() & "-" & "is Internal and associated with some feature" & Sketch1.Feature.Name.ToString())
End If
Sketch1.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.SketchOnly)
Catch Err1 As NXException
lw.WriteLine(Err1.ToString())
End Try
Next

For Each Sketch1 In workPart.Sketches.ToArray
Try
Sketch1.Activate(Sketch.ViewReorient.False)
If Not Sketchlayer(Sketch1.Layer) = True Then
lw.WriteLine("Sketch" & Sketch1.Name.ToString() & "-" & "is not in correct Layer" & "-" & "The current layer is " & Sketch1.Layer.ToString())
End If
Sketch1.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.SketchOnly)
Catch Err1 As NXException
lw.WriteLine(Err1.ToString())
End Try
Next

For Each Datum1 In workPart.Datums
If TypeOf (Datum1) Is DatumPlane Then
If Not Datumlayer(Datum1.Layer) = True Then
lw.WriteLine(Datum1.Name.ToString() & "-" & "Datum Plane is not in correct Layer. It is in " & Datum1.Layer.ToString)
End If

End If
If TypeOf (Datum1) Is CoordinateSystem Then
If Not Datumlayer(Datum1.Layer) = True Then
lw.WriteLine(Datum1.Name.ToString() & "-" & "Datum Coordinate is not in correct Layer. It is in " & Datum1.Layer.ToString)
End If

End If
If TypeOf (Datum1) Is DatumAxis Then
If Not Datumlayer(Datum1.Layer) = True Then
lw.WriteLine(Datum1.Name.ToString() & "-" & "Datum Axis is not in correct Layer. It is in " & Datum1.Layer.ToString)
End If

End If

Next

For Each Sketch1 In workPart.Sketches.ToArray
Try
Sketch1.Activate(Sketch.ViewReorient.False)
lw.WriteLine("Sketch" & Sketch1.Name.ToString())
Catch Err1 As NXException
lw.WriteLine(Err1.ToString())
End Try
Sketch1.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.SketchOnly)
Next

For Each Dim1 In workPart.Sketches
Try
Sketch1.Activate(Sketch.ViewReorient.False)
If Dim1.Color = 160 Then
lw.WriteLine("Model have auto Dimension or Reference Dimension")
End If
Catch Err1 As NXException
lw.WriteLine(Err1.ToString())
End Try
Sketch1.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.SketchOnly)
Next
' lw.WriteLine("Model have auto Dimension or Reference Dimension")
' End If
'Next

'For Each Dim1 In workPart.Sketches
' If Not Dim1.AssociatedDimension.AnnotationOrigin.X = "0.0" And Dim1.AssociatedDimension.AnnotationOrigin.Y = "0.0" And Dim1.AssociatedDimension.AnnotationOrigin.Z = "0.0" Then
' lw.WriteLine(Dim1.GetDimensionGeometry.ToString() & "-" & "is not associated to Orgin")
' End If

lw.Close()

End Sub

Function Sketchlayer(ByVal size As Integer) As Boolean
' Returns true if size is within this range.
Return size >= 101 And size <= 131
End Function

Function Datumlayer(ByVal size As Integer) As Boolean
' Returns true if size is within this range.
Return size >= 50 And size <= 60
End Function

'Function AskDimensionsOfSketch(Sketch2 As Tag, i As Integer, Dimtag As Tag)
' Dim Sketchlist As List(Of Tag) = Nothing
' Dim Dimlist As List(Of Tag) = Nothing
' Dim Sketch1 As Sketch = Nothing
' Sketch2 = Sketch1.Tag
' For Each Sketch1 In workPart.Sketches.ToArray
' Sketchlist.Add(Sketch2)
' Next
' For Each Sketch2 In Sketchlist
' Dimlist.Add(Dimtag)
' Next
' Return Dimlist
'End Function

End Module

' NX Model layers
' Journal created by Alto on 10-06-2015

Option Strict Off
Imports System
Imports NXOpen

Module NXJournal
Sub Main

Dim theSession As Session = Session.GetSession()
Dim workpart As Part = theSession.Parts.Work

Const DatumLayer as Integer = 50
Const DatumLayer1 as Integer = 51
Const DatumLayer2 as Integer = 52
Const SketchLayer as Integer = 101
Const CurveLayer as Integer = 40
dim i as integer = 0

for each datumObj as DisplayableObject in workPart.Datums
if typeof(datumObj) is DatumPlane then
datumObj.Layer = DatumLayer
datumObj.RedisplayObject
end if
if typeof(datumObj) is CoordinateSystem then
datumObj.Layer = DatumLayer1
datumObj.RedisplayObject
end if
if typeof(datumObj) is DatumAxis then
datumObj.Layer = DatumLayer2
datumObj.RedisplayObject
end if

next

For each curveObj as curve In workPart.curves
curveObj.Layer = CurveLayer
next

For each sketchsObj as sketch In workPart.sketches
sketchsObj.Activate(False)
sketchsObj.Layer = SketchLayer+i
sketchsObj.Deactivate(False, Sketch.UpdateLevel.Sketchonly)
i += 1
next

End Sub
End Module

'NX Model layers
'Journal created by Alto on 10-06-2015

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

Module NXJournal
Sub Main

Dim theSession As Session = Session.GetSession()
Dim workpart As Part = theSession.Parts.Display

Const SymbolsLayer as Integer = 254

For each SymbolsObj as DisplayableObject In workPart.Annotations.Idsymbols
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject
next

For each SymbolsObj as DisplayableObject In workPart.Annotations.centerlines
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject

next
For each SymbolsObj as DisplayableObject In workPart.Annotations.intersectionSymbols
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject
next
For each SymbolsObj as DisplayableObject In workPart.Annotations.customSymbols
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject
next
For each SymbolsObj as DisplayableObject In workPart.Annotations.targetPoints
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject
next
'For each SymbolsObj as DisplayableObject In workPart.Annotations.hatches
'SymbolsObj.Layer = SymbolsLayer
'SymbolsObj.RedisplayObject
'next
For each SymbolsObj as DisplayableObject In workPart.Annotations.draftingSurfaceFinishSymbols
SymbolsObj.Layer = SymbolsLayer
SymbolsObj.RedisplayObject
next

Dim stateArray1(0) As Layer.StateInfo
stateArray1(0).Layer = 254
stateArray1(0).State = Layer.State.Selectable
workPart.Layers.ChangeStates(stateArray1, False)

End Sub
End Module

Regards,

Joe

1. Select a part from excel sheet and open in NX
2. Delete all reference sets except entire and empty. Then create new reference set as “Model” and add only solid bodies to the new “Model” reference set.
3. Part Cleanup (NX->File->Utilities-> Part Cleanup)
4. Set WCS to Absolute
5. Make active part “Shaded with Edges”
6. Fit to screen
7. Set to isometric view
8. Save
9. Exit
10. Repeat above steps for next item is excel sheet

Neenad Sawant

I try to apply the fonction "ufs.Tabnot.MergeCells" on the fist row. you can help me ?

I have a problem in this section of my code. If you remove this section, my code run correctly.

This code is used to create a TabNote based on the points it finds in a Drafting view.

Tank you !
_______________________________________________
' Add Title Row
Dim TitleRow As Integer
ufs.Tabnot.CreateRow(30, TitleRow )
ufs.Tabnot.AddRow(tabnote, TitleRow, UFConstants.UF_TABNOT_APPEND)
'Dim cellprefes As UFTabnot.CellPrefs = Nothing
Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(4), cell)
ufs.Tabnot.MergeCells(cell1, cell2)
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "XYZ POINTS")
______________________________________________________


Option Strict Off

Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.Annotations
Imports NXOpen.UI
Imports NXOpen.UF
Imports NXOpen.Utilities

Structure PointData
Public PointObj As Point
Public CoordsABS As Point3d
Public CoordsWCS As Point3d
End Structure

Module CoordsTable

' Creates a tabular note with all Point coordinates from the assembly
' regardless of whether the points are displayed or hidden.
' Optionally, the coordinates are mapped to the current WCS of the drawing part.
' To get the WCS, the drawing display is turned off/on temporarily.
' It also creates ID notes at the points in the selected drawing member view.
' Test: create a part or an assembly with some points in any part.
' Note: The tabular note and the ID notes are not associative yet...

Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theUI As UI = UI.GetUI()
Dim lw As ListingWindow = theSession.ListingWindow
Dim workPart As Part = theSession.Parts.Work

Sub Main()

Try

' Get all points in assembly
Dim ptList as List(Of PointData) = new List(Of PointData)
GetAllPointsInAssy(ptList)

If ptList.ToArray().Length = 0 Then
lw.Open()
lw.WriteLine("No Points found. Exit.")
return
End If

' Get a view for the IDs
Dim dwgview As Drawings.BaseView
If select_a_drawing_member_view(dwgview) <> Selection.Response.Ok Then
return
End If

' Get a location for the tabular note
Dim cursor As Point3d
Dim response As Selection.DialogResponse = SelectScreenPos(cursor)
If response <> Selection.DialogResponse.Pick Then
return
End If

' Ask to use ABS or WCS coordinates
Dim answer As Integer = theUI.NXMessageBox.Show("Coordinates", _
NXOpen.NXMessageBox.DialogType.Question, "Convert ABS to WCS values?")
If answer = 1 Then
MapPointsFromAbsToWcs(ptList)
End If

lw.Open()
For each pt As PointData in ptList
lw.WriteLine(vbCrLf + "ABS: " + pt.CoordsABS.X.ToString() + " " + pt.CoordsABS.Y.ToString() + " " + pt.CoordsABS.Z.ToString())
lw.WriteLine("WCS: " + pt.CoordsWCS.X.ToString() + " " + pt.CoordsWCS.Y.ToString() + " " + pt.CoordsWCS.Z.ToString())
Next

' Create the tabular note
Dim n_new_columns As Integer = 4
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(1,n_new_columns,cursor)

' Get the column tags
Dim columns(n_new_columns-1) As NXOpen.Tag
For ii As Integer = 0 To n_new_columns-1
ufs.Tabnot.AskNthColumn(tabnote, ii, columns(ii))
Next

Dim cell As NXOpen.Tag

' Add Title Row
Dim TitleRow As Integer
ufs.Tabnot.CreateRow(30, TitleRow )
ufs.Tabnot.AddRow(tabnote, TitleRow, UFConstants.UF_TABNOT_APPEND)
'Dim cellprefes As UFTabnot.CellPrefs = Nothing
Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(4), cell)
ufs.Tabnot.MergeCells(cell1, cell2)
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "XYZ POINTS")

' Add Header Row
Dim headerrow As NXOpen.Tag
ufs.Tabnot.CreateRow(30, headerrow )
ufs.Tabnot.AddRow(tabnote, headerrow, UFConstants.UF_TABNOT_APPEND)

ufs.Tabnot.AskCellAtRowCol(headerrow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "ID")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(1), cell)
ufs.Tabnot.SetCellText(cell, "X")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(2), cell)
ufs.Tabnot.SetCellText(cell, "Y")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(3), cell)
ufs.Tabnot.SetCellText(cell, "Z")

' Add one row for each point
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Dim jj As Integer = 0

For each pt As PointData in ptList
Dim id As Integer = jj+1
Dim pt3dCoords as Point3D
If answer = 1 Then
' Use the Coordinates in WCS
pt3dCoords = pt.CoordsWCS
Else
' Use the Coordinates in ABS
pt3dCoords = pt.CoordsABS
End If

' Add a row for each point
Dim row As NXOpen.Tag
ufs.Tabnot.CreateRow(30, row )
ufs.Tabnot.AddRow(tabnote, row, UFConstants.UF_TABNOT_APPEND)
ufs.Tabnot.AskCellAtRowCol(row, columns(0), cell)
ufs.Tabnot.SetCellText(cell, id.ToString())
' Set the cell text (pour ajuster le nombre de decimals changer la valeur "F")
ufs.Tabnot.AskCellAtRowCol(row, columns(1), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.X.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(2), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Y.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(3), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Z.ToString("F3"))

' Add ID notes to the points
AddNoteToPoint(id, pt.CoordsABS, dwgview)

jj = jj+1

Next

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

End Try

End Sub

Public Function GetAllPointsInAssy(ByRef ptList As List(Of PointData))
Dim ptTag As Tag = NXOpen.Tag.Null
Do
ufs.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_point_type, ptTag)
If ptTag <> NXOpen.Tag.Null Then
Dim ptObj = CType(NXObjectManager.Get(ptTag), Point)
Dim pt As PointData
pt.PointObj = ptObj
pt.CoordsABS = ptObj.Coordinates
ptList.Add(pt)
End If

Loop Until ptTag = NXOpen.Tag.Null
End Function

Public Function MapPointsFromAbsToWcs(ByRef ptList As List(Of PointData))

Dim module_id As Integer = 0
ufs.UF.AskApplicationModule(module_id)

'If we are in drafting, we need the modeling view to access WCS
If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_SUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(1)
End If

For ii As Integer = 0 To ptList.Count-1
Dim ptNew As PointData = ptList(ii)

Dim ptAbsVal as Double() = {ptNew.CoordsABS.X, ptNew.CoordsABS.Y, ptNew.CoordsABS.Z}
Dim ptWcsVal as Double() = New Double(2){}
ufs.Csys.MapPoint(UFConstants.UF_CSYS_ROOT_COORDS, ptAbsVal,
UFConstants.UF_CSYS_ROOT_WCS_COORDS, ptWcsVal)

Dim ptWcs As Point3d = new Point3d(ptWcsVal(0),ptWcsVal(1),ptWcsVal(2))
ptNew.CoordsWCS = ptWcs
ptList(ii) = ptNew
Next

If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_UNSUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(2)
End If

End Function

Public Function SelectScreenPos(ByRef pos As Point3d) As Selection.DialogResponse
Dim view As NXOpen.View = Nothing
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
return theUI.SelectionManager.SelectScreenPosition("Select location for tabnote", view, pos)
End Function

Function select_a_drawing_member_view(ByRef dwgview As Drawings.BaseView)
Dim ui As UI = GetUI()
Dim mask(0) As Selection.MaskTriple
With mask(0)
.Type = UFConstants.UF_view_type
.Subtype = UFConstants.UF_view_imported_subtype
.SolidBodySubtype = 0
End With
Dim cursor As Point3d = Nothing
Dim vw As View = nothing

Dim resp As Selection.Response = _
ui.SelectionManager.SelectObject("Select a drawing member view", _
"Select a drawing member view", _
Selection.SelectionScope.AnyInAssembly, _
Selection.SelectionAction.ClearAndEnableSpecific, _
False, False, mask, vw, cursor)

If resp = Selection.Response.ObjectSelected Or _
resp = Selection.Response.ObjectSelectedByName Then
dwgview = CType(vw, Drawings.BaseView)

return Selection.Response.Ok

Else
return Selection.Response.Cancel
End If
End Function

Public Function CreateTabnoteWithSize( _
ByVal nRows As Integer, ByVal nColumns As Integer, ByVal loc As Point3d) As NXOpen.Tag

Try
' Create the tabular note
Dim secPrefs As UFTabnot.SectionPrefs
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim cellPrefs As UFTabnot.CellPrefs
ufs.Tabnot.AskDefaultCellPrefs(cellPrefs)
cellPrefs.zero_display = UFTabnot.ZeroDisplay.ZeroDisplayZero
cellPrefs.line_space_factor = 1.0
cellPrefs.nm_fit_methods = 2
cellPrefs.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeRow
cellPrefs.fit_methods(1) = UFTabnot.FitMethod.FitMethodAutoSizeCol
ufs.Tabnot.SetDefaultCellPrefs(cellPrefs)

Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)

' Delete all existing columns and rows (we create them as needed)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows-1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns-1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next

' Now add our columns as needed
Dim columns(nColumns-1) As NXOpen.Tag
For ii As Integer = 0 To nColumns-1
ufs.Tabnot.CreateColumn(30, columns(ii))
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next

' Now add our rows as needed
Dim rows(nRows-1) As NXOpen.Tag
For ii As Integer = 0 To nRows-1
ufs.Tabnot.CreateRow(30, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next

return tabnote

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

End Try

End Function

Function AddNoteToPoint(ByVal id As Integer, ByVal pt As Point3d, ByVal dwgview As Drawings.BaseView)

Dim nullAnnotations_SimpleDraftingAid As Annotations.SimpleDraftingAid = Nothing
Dim draftingNoteBuilder1 As Annotations.DraftingNoteBuilder
draftingNoteBuilder1 = workPart.Annotations.CreateDraftingNoteBuilder(nullAnnotations_SimpleDraftingAid)
Dim text1(0) As String
text1(0) = id.ToString()
draftingNoteBuilder1.Text.TextBlock.SetText(text1)
draftingNoteBuilder1.Origin.AnnotationView.Value = dwgview
draftingNoteBuilder1.Origin.Origin.SetValue(Nothing, Nothing, pt)
draftingNoteBuilder1.Style.LetteringStyle.GeneralTextSize = 3.5
draftingNoteBuilder1.Commit()
draftingNoteBuilder1.Destroy()

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module

Pat

Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)

You have dimensioned a variable named "cell1", but do not populate it with a value. The following line of code assigns the title row column(0) cell to the variable "cell" instead of "cell1". The same situation is happening with "cell2". The call to .MergeCells then fails because "cell1" and "cell2" do not hold the values that you want.

Change the above code to:

Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell1)

And do similarly for "cell2".

Hello,

Tank you for your answer !

I had tried what you describe. But, It does not work because the code does not merge the cells of the first line. In addition, NX creates a table with only 2 rows and 4 columns with no value in the cells.

If you try, create a .part and put a few points. Then, in a drafting create a view to see the points. Then read (play) the code and you will see what happens.

But, if you remove all this section of the code and try again, you will see that the table is created correctly!
-----------------------------------------------------

' Add Title Row
Dim TitleRow As Integer
ufs.Tabnot.CreateRow(30, TitleRow )
ufs.Tabnot.AddRow(tabnote, TitleRow, UFConstants.UF_TABNOT_APPEND)
' 'Dim cellprefes As UFTabnot.CellPrefs = Nothing
Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(4), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "XYZ POINTS")
-------------------------------------------------

BTW, I would like to understand how you do to make appear the code with the colors ... "DIM", "AS" in blue... (0) in red... ???

Regards !

Pat

Try this:

Option Strict Off

Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.Annotations
Imports NXOpen.UI
Imports NXOpen.UF
Imports NXOpen.Utilities

Structure PointData
Public PointObj As Point
Public CoordsABS As Point3d
Public CoordsWCS As Point3d
End Structure

Module CoordsTable

' Creates a tabular note with all Point coordinates from the assembly
' regardless of whether the points are displayed or hidden.
' Optionally, the coordinates are mapped to the current WCS of the drawing part.
' To get the WCS, the drawing display is turned off/on temporarily.
' It also creates ID notes at the points in the selected drawing member view.
' Test: create a part or an assembly with some points in any part.
' Note: The tabular note and the ID notes are not associative yet...

Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theUI As UI = UI.GetUI()
Dim lw As ListingWindow = theSession.ListingWindow
Dim workPart As Part = theSession.Parts.Work

Sub Main()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Point table")

Try

' Get all points in assembly
Dim ptList As List(Of PointData) = New List(Of PointData)
GetAllPointsInAssy(ptList)

If ptList.ToArray().Length = 0 Then
lw.Open()
lw.WriteLine("No Points found. Exit.")
Return
End If

' Get a view for the IDs
Dim dwgview As Drawings.BaseView
If select_a_drawing_member_view(dwgview) <> Selection.Response.Ok Then
Return
End If

' Get a location for the tabular note
Dim cursor As Point3d
Dim response As Selection.DialogResponse = SelectScreenPos(cursor)
If response <> Selection.DialogResponse.Pick Then
Return
End If

' Ask to use ABS or WCS coordinates
Dim answer As Integer = theUI.NXMessageBox.Show("Coordinates",
NXOpen.NXMessageBox.DialogType.Question, "Convert ABS to WCS values?")
If answer = 1 Then
MapPointsFromAbsToWcs(ptList)
End If

lw.Open()
For Each pt As PointData In ptList
lw.WriteLine(vbCrLf + "ABS: " + pt.CoordsABS.X.ToString() + " " + pt.CoordsABS.Y.ToString() + " " + pt.CoordsABS.Z.ToString())
lw.WriteLine("WCS: " + pt.CoordsWCS.X.ToString() + " " + pt.CoordsWCS.Y.ToString() + " " + pt.CoordsWCS.Z.ToString())
Next

' Create the tabular note
Dim n_new_columns As Integer = 4
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(1, n_new_columns, cursor)

' Get the column tags
Dim columns(n_new_columns - 1) As NXOpen.Tag
For ii As Integer = 0 To n_new_columns - 1
ufs.Tabnot.AskNthColumn(tabnote, ii, columns(ii))
Next

Dim cell As NXOpen.Tag

' Add Title Row
Dim TitleRow As Tag
ufs.Tabnot.CreateRow(30, TitleRow)
ufs.Tabnot.AddRow(tabnote, TitleRow, UFConstants.UF_TABNOT_APPEND)
'Dim cellprefes As UFTabnot.CellPrefs = Nothing
Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(3), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
ufs.Tabnot.SetCellText(cell1, "XYZ POINTS")

' Add Header Row
Dim headerrow As NXOpen.Tag
ufs.Tabnot.CreateRow(30, headerrow)
ufs.Tabnot.AddRow(tabnote, headerrow, UFConstants.UF_TABNOT_APPEND)

ufs.Tabnot.AskCellAtRowCol(headerrow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "ID")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(1), cell)
ufs.Tabnot.SetCellText(cell, "X")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(2), cell)
ufs.Tabnot.SetCellText(cell, "Y")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(3), cell)
ufs.Tabnot.SetCellText(cell, "Z")

' Add one row for each point
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Dim jj As Integer = 0

For Each pt As PointData In ptList
Dim id As Integer = jj + 1
Dim pt3dCoords As Point3d
If answer = 1 Then
' Use the Coordinates in WCS
pt3dCoords = pt.CoordsWCS
Else
' Use the Coordinates in ABS
pt3dCoords = pt.CoordsABS
End If

' Add a row for each point
Dim row As NXOpen.Tag
ufs.Tabnot.CreateRow(30, row)
ufs.Tabnot.AddRow(tabnote, row, UFConstants.UF_TABNOT_APPEND)
ufs.Tabnot.AskCellAtRowCol(row, columns(0), cell)
ufs.Tabnot.SetCellText(cell, id.ToString())
' Set the cell text (pour ajuster le nombre de decimals changer la valeur "F")
ufs.Tabnot.AskCellAtRowCol(row, columns(1), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.X.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(2), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Y.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(3), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Z.ToString("F3"))

' Add ID notes to the points
AddNoteToPoint(id, pt.CoordsABS, dwgview)

jj = jj + 1

Next

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

End Try

End Sub

Public Sub GetAllPointsInAssy(ByRef ptList As List(Of PointData))
Dim ptTag As Tag = NXOpen.Tag.Null
Do
ufs.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_point_type, ptTag)
If ptTag <> NXOpen.Tag.Null Then
Dim ptObj = CType(NXObjectManager.Get(ptTag), Point)
Dim pt As PointData
pt.PointObj = ptObj
pt.CoordsABS = ptObj.Coordinates
ptList.Add(pt)
End If

Loop Until ptTag = NXOpen.Tag.Null
End Sub

Public Sub MapPointsFromAbsToWcs(ByRef ptList As List(Of PointData))

Dim module_id As Integer = 0
ufs.UF.AskApplicationModule(module_id)

'If we are in drafting, we need the modeling view to access WCS
If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_SUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(1)
End If

For ii As Integer = 0 To ptList.Count - 1
Dim ptNew As PointData = ptList(ii)

Dim ptAbsVal As Double() = {ptNew.CoordsABS.X, ptNew.CoordsABS.Y, ptNew.CoordsABS.Z}
Dim ptWcsVal As Double() = New Double(2) {}
ufs.Csys.MapPoint(UFConstants.UF_CSYS_ROOT_COORDS, ptAbsVal,
UFConstants.UF_CSYS_ROOT_WCS_COORDS, ptWcsVal)

Dim ptWcs As Point3d = New Point3d(ptWcsVal(0), ptWcsVal(1), ptWcsVal(2))
ptNew.CoordsWCS = ptWcs
ptList(ii) = ptNew
Next

If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_UNSUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(2)
End If

End Sub

Public Function SelectScreenPos(ByRef pos As Point3d) As Selection.DialogResponse
Dim view As NXOpen.View = Nothing
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Return theUI.SelectionManager.SelectScreenPosition("Select location for tabnote", view, pos)
End Function

Function select_a_drawing_member_view(ByRef dwgview As Drawings.BaseView) As Selection.Response
Dim ui As UI = GetUI()
Dim mask(0) As Selection.MaskTriple
With mask(0)
.Type = UFConstants.UF_view_type
.Subtype = UFConstants.UF_view_imported_subtype
.SolidBodySubtype = 0
End With
Dim cursor As Point3d = Nothing
Dim vw As View = Nothing

Dim resp As Selection.Response =
ui.SelectionManager.SelectObject("Select a drawing member view",
"Select a drawing member view",
Selection.SelectionScope.AnyInAssembly,
Selection.SelectionAction.ClearAndEnableSpecific,
False, False, mask, vw, cursor)

If resp = Selection.Response.ObjectSelected Or
resp = Selection.Response.ObjectSelectedByName Then
dwgview = CType(vw, Drawings.BaseView)

Return Selection.Response.Ok

Else
Return Selection.Response.Cancel
End If
End Function

Public Function CreateTabnoteWithSize(ByVal nRows As Integer,
ByVal nColumns As Integer,
ByVal loc As Point3d) As NXOpen.Tag

Try
' Create the tabular note
Dim secPrefs As UFTabnot.SectionPrefs
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim cellPrefs As UFTabnot.CellPrefs
ufs.Tabnot.AskDefaultCellPrefs(cellPrefs)
cellPrefs.zero_display = UFTabnot.ZeroDisplay.ZeroDisplayZero
cellPrefs.line_space_factor = 1.0
cellPrefs.nm_fit_methods = 2
cellPrefs.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeRow
cellPrefs.fit_methods(1) = UFTabnot.FitMethod.FitMethodAutoSizeCol
ufs.Tabnot.SetDefaultCellPrefs(cellPrefs)

Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)

' Delete all existing columns and rows (we create them as needed)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows - 1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns - 1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next

' Now add our columns as needed
Dim columns(nColumns - 1) As NXOpen.Tag
For ii As Integer = 0 To nColumns - 1
ufs.Tabnot.CreateColumn(30, columns(ii))
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next

' Now add our rows as needed
Dim rows(nRows - 1) As NXOpen.Tag
For ii As Integer = 0 To nRows - 1
ufs.Tabnot.CreateRow(30, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next

Return tabnote

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

End Try

End Function

Function AddNoteToPoint(ByVal id As Integer, ByVal pt As Point3d, ByVal dwgview As Drawings.BaseView)

Dim nullAnnotations_SimpleDraftingAid As Annotations.SimpleDraftingAid = Nothing
Dim draftingNoteBuilder1 As Annotations.DraftingNoteBuilder
draftingNoteBuilder1 = workPart.Annotations.CreateDraftingNoteBuilder(nullAnnotations_SimpleDraftingAid)
Dim text1(0) As String
text1(0) = id.ToString()
draftingNoteBuilder1.Text.TextBlock.SetText(text1)
draftingNoteBuilder1.Origin.AnnotationView.Value = dwgview
draftingNoteBuilder1.Origin.Origin.SetValue(Nothing, Nothing, pt)
draftingNoteBuilder1.Style.LetteringStyle.GeneralTextSize = 3.5
draftingNoteBuilder1.Commit()
draftingNoteBuilder1.Destroy()

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module

To get the syntax highlighting in your code snippet, surround the code with "vbnet" tags, like this:

some code here

That work great and like i want.Tank you !

But, I modified the line

' Create the tabular note
Dim n_new_columns As Integer = 4
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(1, n_new_columns, cursor)

For this line

' Create the tabular note
Dim n_new_columns As Integer = 4
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(0, n_new_columns, cursor)

Regards!

Option Strict Off

Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.Annotations
Imports NXOpen.UI
Imports NXOpen.UF
Imports NXOpen.Utilities

Structure PointData
Public PointObj As Point
Public CoordsABS As Point3d
Public CoordsWCS As Point3d
End Structure

Module CoordsTable

' Creates a tabular note with all Point coordinates from the assembly
' regardless of whether the points are displayed or hidden.
' Optionally, the coordinates are mapped to the current WCS of the drawing part.
' To get the WCS, the drawing display is turned off/on temporarily.
' It also creates ID notes at the points in the selected drawing member view.
' Test: create a part or an assembly with some points in any part.
' Note: The tabular note and the ID notes are not associative yet...

Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim theUI As UI = UI.GetUI()
Dim lw As ListingWindow = theSession.ListingWindow
Dim workPart As Part = theSession.Parts.Work

Sub Main()

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Point table")

Try

' Get all points in assembly
Dim ptList As List(Of PointData) = New List(Of PointData)
GetAllPointsInAssy(ptList)

If ptList.ToArray().Length = 0 Then
lw.Open()
lw.WriteLine("No Points found. Exit.")
Return
End If

' Get a view for the IDs
Dim dwgview As Drawings.BaseView
If select_a_drawing_member_view(dwgview) <> Selection.Response.Ok Then
Return
End If

' Get a location for the tabular note
Dim cursor As Point3d
Dim response As Selection.DialogResponse = SelectScreenPos(cursor)
If response <> Selection.DialogResponse.Pick Then
Return
End If

' Ask to use ABS or WCS coordinates
Dim answer As Integer = theUI.NXMessageBox.Show("Coordinates",
NXOpen.NXMessageBox.DialogType.Question, "Convert ABS to WCS values?")
If answer = 1 Then
MapPointsFromAbsToWcs(ptList)
End If

lw.Open()
For Each pt As PointData In ptList
lw.WriteLine(vbCrLf + "ABS: " + pt.CoordsABS.X.ToString() + " " + pt.CoordsABS.Y.ToString() + " " + pt.CoordsABS.Z.ToString())
lw.WriteLine("WCS: " + pt.CoordsWCS.X.ToString() + " " + pt.CoordsWCS.Y.ToString() + " " + pt.CoordsWCS.Z.ToString())
Next

' Create the tabular note
Dim n_new_columns As Integer = 4
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(0, n_new_columns, cursor)

' Get the column tags
Dim columns(n_new_columns - 1) As NXOpen.Tag
For ii As Integer = 0 To n_new_columns - 1
ufs.Tabnot.AskNthColumn(tabnote, ii, columns(ii))
Next

Dim cell As NXOpen.Tag

' Add Title Row
Dim TitleRow As Tag
ufs.Tabnot.CreateRow(30, TitleRow)
ufs.Tabnot.AddRow(tabnote, TitleRow, UFConstants.UF_TABNOT_APPEND)
'Dim cellprefes As UFTabnot.CellPrefs = Nothing
Dim cell1 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(3), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
ufs.Tabnot.AskCellAtRowCol(TitleRow, columns(0), cell)
ufs.Tabnot.SetCellText(cell1, "XYZ POINTS")

' Add Header Row
Dim headerrow As NXOpen.Tag
ufs.Tabnot.CreateRow(30, headerrow)
ufs.Tabnot.AddRow(tabnote, headerrow, UFConstants.UF_TABNOT_APPEND)

ufs.Tabnot.AskCellAtRowCol(headerrow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "ID")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(1), cell)
ufs.Tabnot.SetCellText(cell, "X")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(2), cell)
ufs.Tabnot.SetCellText(cell, "Y")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(3), cell)
ufs.Tabnot.SetCellText(cell, "Z")

' Add one row for each point
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Dim jj As Integer = 0

For Each pt As PointData In ptList
Dim id As Integer = jj + 1
Dim pt3dCoords As Point3d
If answer = 1 Then
' Use the Coordinates in WCS
pt3dCoords = pt.CoordsWCS
Else
' Use the Coordinates in ABS
pt3dCoords = pt.CoordsABS
End If

' Add a row for each point
Dim row As NXOpen.Tag
ufs.Tabnot.CreateRow(30, row)
ufs.Tabnot.AddRow(tabnote, row, UFConstants.UF_TABNOT_APPEND)
ufs.Tabnot.AskCellAtRowCol(row, columns(0), cell)
ufs.Tabnot.SetCellText(cell, id.ToString())
' Set the cell text (pour ajuster le nombre de decimals changer la valeur "F")
ufs.Tabnot.AskCellAtRowCol(row, columns(1), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.X.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(2), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Y.ToString("F3"))
ufs.Tabnot.AskCellAtRowCol(row, columns(3), cell)
ufs.Tabnot.SetCellText(cell, pt3dCoords.Z.ToString("F3"))

' Add ID notes to the points
AddNoteToPoint(id, pt.CoordsABS, dwgview)

jj = jj + 1

Next

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

End Try

End Sub

Public Sub GetAllPointsInAssy(ByRef ptList As List(Of PointData))
Dim ptTag As Tag = NXOpen.Tag.Null
Do
ufs.Obj.CycleObjsInPart(workPart.Tag, UFConstants.UF_point_type, ptTag)
If ptTag <> NXOpen.Tag.Null Then
Dim ptObj = CType(NXObjectManager.Get(ptTag), Point)
Dim pt As PointData
pt.PointObj = ptObj
pt.CoordsABS = ptObj.Coordinates
ptList.Add(pt)
End If

Loop Until ptTag = NXOpen.Tag.Null
End Sub

Public Sub MapPointsFromAbsToWcs(ByRef ptList As List(Of PointData))

Dim module_id As Integer = 0
ufs.UF.AskApplicationModule(module_id)

'If we are in drafting, we need the modeling view to access WCS
If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_SUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(1)
End If

For ii As Integer = 0 To ptList.Count - 1
Dim ptNew As PointData = ptList(ii)

Dim ptAbsVal As Double() = {ptNew.CoordsABS.X, ptNew.CoordsABS.Y, ptNew.CoordsABS.Z}
Dim ptWcsVal As Double() = New Double(2) {}
ufs.Csys.MapPoint(UFConstants.UF_CSYS_ROOT_COORDS, ptAbsVal,
UFConstants.UF_CSYS_ROOT_WCS_COORDS, ptWcsVal)

Dim ptWcs As Point3d = New Point3d(ptWcsVal(0), ptWcsVal(1), ptWcsVal(2))
ptNew.CoordsWCS = ptWcs
ptList(ii) = ptNew
Next

If module_id = UFConstants.UF_APP_DRAFTING Then
ufs.Disp.SetDisplay(UFConstants.UF_DISP_UNSUPPRESS_DISPLAY)
ufs.Draw.SetDisplayState(2)
End If

End Sub

Public Function SelectScreenPos(ByRef pos As Point3d) As Selection.DialogResponse
Dim view As NXOpen.View = Nothing
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Return theUI.SelectionManager.SelectScreenPosition("Select location for tabnote", view, pos)
End Function

Function select_a_drawing_member_view(ByRef dwgview As Drawings.BaseView) As Selection.Response
Dim ui As UI = GetUI()
Dim mask(0) As Selection.MaskTriple
With mask(0)
.Type = UFConstants.UF_view_type
.Subtype = UFConstants.UF_view_imported_subtype
.SolidBodySubtype = 0
End With
Dim cursor As Point3d = Nothing
Dim vw As View = Nothing

Dim resp As Selection.Response =
ui.SelectionManager.SelectObject("Select a drawing member view",
"Select a drawing member view",
Selection.SelectionScope.AnyInAssembly,
Selection.SelectionAction.ClearAndEnableSpecific,
False, False, mask, vw, cursor)

If resp = Selection.Response.ObjectSelected Or
resp = Selection.Response.ObjectSelectedByName Then
dwgview = CType(vw, Drawings.BaseView)

Return Selection.Response.Ok

Else
Return Selection.Response.Cancel
End If
End Function

Public Function CreateTabnoteWithSize(ByVal nRows As Integer,
ByVal nColumns As Integer,
ByVal loc As Point3d) As NXOpen.Tag

Try
' Create the tabular note
Dim secPrefs As UFTabnot.SectionPrefs
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim cellPrefs As UFTabnot.CellPrefs
ufs.Tabnot.AskDefaultCellPrefs(cellPrefs)
cellPrefs.zero_display = UFTabnot.ZeroDisplay.ZeroDisplayZero
cellPrefs.line_space_factor = 1.0
cellPrefs.nm_fit_methods = 2
cellPrefs.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeRow
cellPrefs.fit_methods(1) = UFTabnot.FitMethod.FitMethodAutoSizeCol
ufs.Tabnot.SetDefaultCellPrefs(cellPrefs)

Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)

' Delete all existing columns and rows (we create them as needed)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows - 1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns - 1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next

' Now add our columns as needed
Dim columns(nColumns - 1) As NXOpen.Tag
For ii As Integer = 0 To nColumns - 1
ufs.Tabnot.CreateColumn(30, columns(ii))
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next

' Now add our rows as needed
Dim rows(nRows - 1) As NXOpen.Tag
For ii As Integer = 0 To nRows - 1
ufs.Tabnot.CreateRow(30, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next

Return tabnote

Catch ex As NXOpen.NXException
lw.Open()
lw.WriteLine(ex.Message)

Catch ex As Exception
lw.Open()
lw.WriteLine(ex.GetBaseException.ToString())

End Try

End Function

Function AddNoteToPoint(ByVal id As Integer, ByVal pt As Point3d, ByVal dwgview As Drawings.BaseView)

Dim nullAnnotations_SimpleDraftingAid As Annotations.SimpleDraftingAid = Nothing
Dim draftingNoteBuilder1 As Annotations.DraftingNoteBuilder
draftingNoteBuilder1 = workPart.Annotations.CreateDraftingNoteBuilder(nullAnnotations_SimpleDraftingAid)
Dim text1(0) As String
text1(0) = id.ToString()
draftingNoteBuilder1.Text.TextBlock.SetText(text1)
draftingNoteBuilder1.Origin.AnnotationView.Value = dwgview
draftingNoteBuilder1.Origin.Origin.SetValue(Nothing, Nothing, pt)
draftingNoteBuilder1.Style.LetteringStyle.GeneralTextSize = 3.5
draftingNoteBuilder1.Commit()
draftingNoteBuilder1.Destroy()

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function

End Module

Pat

Hello All,
My task is to initialize managed NX(UGMGR.initialize), open the given part, do some operations in NX, save back to teamcenter and terminate the connection. I have a sample code to initialize ugmgr and terminate. I'm well aware of the ugmgr API's. The issue I'm facing it is to set the required environmental variables. Can anyone let me know what are the variables I need to set for a 2 Tier teamcenter and command line arguments I need to pass to the EXE to successfully run the application in batch mode. I'm using NX8.5 and TC 2T 10. Thanks in advance.

//Create Section View//-------------------------------
Tag tagDwg = workPart.DrawingSheets.CurrentDrawingSheet.Tag;
//Tag prntView = workPart.DraftingViews.FindObject("Top@4").Tag;
BaseView mdlVw = (BaseView)inputVw1[0];
Tag prntView = mdlVw.Tag;
double scale = 1.0;
double[] stepDir = { 0, 1, 0 };
double[] arrow = { 1, 0, 0 };
double[] viewPlacement = new double[3];
viewPlacement[0] = X + 150;
viewPlacement[1] = Y+25;
viewPlacement[2] = 0;
Tag sxView;

UFDrf.Object cutobj = new UFDrf.Object();
theUFSession.Drf.InitObjectStructure(ref cutobj);
cutobj.object_tag = workPart.DraftingViews.Tag;
cutobj.object_assoc_type = UFDrf.AssocType.DwgPos;
double[] dwgPos = new double[2];
dwgPos[0] = X-25;
dwgPos[1] = 0;
cutobj.assoc_dwg_pos = dwgPos;
cutobj.object2_tag = workPart.Planes.Tag;
cutobj.object_view_tag = prntView;

theUFSession.Draw.CreateSimpleSxview(tagDwg, scale, stepDir, arrow, prntView, ref cutobj, viewPlacement, out sxView);

Can anyone please tell me how to convert DLL file into VB file?

Thanks,
Muthu

Here is a journal I made that will produce an animated GIF of your NX model. It will rotate the model 360 degrees and capture screenshots of the rotation in action. It will compress the screenshots together and make an animated Gif that you can use to reference the model later on. It will automatically create a folder on your desktop to store the file in if there isn't one already made. There is no need to create the folder.

It will only capture the 3D graphical window where the geometry is displayed. You can change the size of the window to decrease the size of the Gif. If you want to capture anything beyond that then you will need to edit the code. However if you wish to capture the full screen, commented code has been provided in the journal to show you how to do so.

Also, this is set-up to currently work with NX 10.xx.xx (whatever version of 10 you are running). To change it to run with other versions of NX, you will need to change a single number on line 75 as presented below:

If p.MainWindowTitle.Contains("NX 10 -")

Enter the version number you are using. It should match the number at the very top of the NX window. Leave the spacing in the string as it is.


Option Strict Off

Imports System
Imports System.Collections.Generic
Imports System.Diagnostics
Imports System.Text
Imports System.IO
Imports System.Collections
Imports System.Collections.Specialized
Imports System.Math
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System.Drawing.Image
Imports System.Threading
Imports System.Runtime.Serialization
Imports System.Windows.Forms
Imports System.Windows

Imports NXOpen
Imports NXOpen.UI
Imports NXOpen.Utilities
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports System.Runtime.InteropServices

Module Module2

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
Dim lw As ListingWindow = theSession.ListingWindow
Dim environ As String = Environment.UserName
Dim userPath As String = "C:\Users\" & environ & "\Desktop\Animated Gifs\"
Dim Bitmaps As List(Of Bitmap) = New List(Of Bitmap)
Dim c As ComponentAssembly = workPart.ComponentAssembly
Dim rootDispName As String = (c.RootComponent.DisplayName).Replace("/", "_")
Dim width As Integer
Dim height As Integer
Dim windowRect As New NativeMethods.RECT

Sub Main()

'find on-screen coordinates of 3D graphics window in NX
'It will only take screenshots of that screen-space.
'To capture the full-screen look in CaptureScreenshots() subroutine
'to find commented code
WindowCoord()

'Set model view
workPart.ModelingViews.WorkView.Orient(NXOpen.View.Canned.Trimetric, NXOpen.View.ScaleAdjustment.Saved)
workPart.ModelingViews.WorkView.Fit()

'Rotate model >Take screenshot > Repeat until desired rotations are finished
Rotation()

'Take Screenshots and assemble them into an animated GIF
'Sets certain properties, such as Frame delay and number of times the animation
'will loop
AssembleGIF()

End Sub

Sub WindowCoord()
Dim MainWindow As IntPtr
Dim WindowName As String
Dim count As Integer
Dim Lstring As Integer
Dim Rstring As Integer
'Create a buffer of 256 characters
Dim Caption As New System.Text.StringBuilder(256)

For Each p As Process In Process.GetProcesses()
If p.MainWindowTitle.Contains("NX 10 -") Then
WindowName = p.MainWindowTitle
MainWindow = p.MainWindowHandle
End If
Next

'use Echo() for debugging
'Echo(WindowName)

Dim StringLenth As Integer
For Each c As Char In WindowName
count += 1
If c = "[" Then
Lstring = count
ElseIf c = "]" Then
Rstring = count
End If
Next

WindowName = WindowName.Substring(Lstring, WindowName.Length - Lstring - 1)
'Echo("String Output " & WindowName)

'Enumerate child windows
For Each child As IntPtr In NativeMethods.GetChildWindows(MainWindow)
NativeMethods.GetWindowText(child, Caption, Caption.Capacity)
'Echo(child.ToString & " " & Caption.ToString)

If Caption.ToString = WindowName Then
'Get Screenshot width, height
NativeMethods.GetWindowRect(child, windowRect)
width = windowRect.right - windowRect.left
height = windowRect.bottom - windowRect.top
'Echo("Child Dimensions: " & width & " " & height)
End If

Next

End Sub

Sub Rotation()

Dim dispPart As Part = theSession.Parts.Display
Dim workView As NXOpen.View = dispPart.Views.WorkView()

lw.Open()

'Initiate reference to solid Bodies
Dim theBodies As New List(Of Body)
'Can change to process work part instead
'Measures Min/Max of Solid Bod
Dim bbox(5) As Double
'lengths of solid body returned in part units
Dim bodyLengths(2) As Double
Dim Xcenter As Double
Dim Ycenter As Double
Dim Zcenter As Double

'Min max values
Dim Xmin() As Double
Dim Xmax() As Double
Dim Ymin() As Double
Dim Ymax() As Double
Dim Zmin() As Double
Dim Zmax() As Double
Dim minimunX As Double = Double.MaxValue
Dim maximumX As Double = Double.MinValue
Dim minimunZ As Double = Double.MaxValue
Dim maximumZ As Double = Double.MinValue
Dim minimunY As Double = Double.MaxValue
Dim maximumY As Double = Double.MinValue
Dim E As Double = 0

theBodies = AskAllBodies(theSession.Parts.Display)

For Each tempBody As Body In theBodies

theUfSession.Modl.AskBoundingBox(tempBody.Tag, bbox)

ReDim Preserve Xmin(E)
Xmin(E) = bbox(0) 'X axis

ReDim Preserve Xmax(E)
Xmax(E) = bbox(3)

ReDim Preserve Zmin(E)
Zmin(E) = bbox(2) 'Z axis

ReDim Preserve Zmax(E)
Zmax(E) = bbox(5)

ReDim Preserve Ymin(E)
Ymin(E) = bbox(1) 'Y axis

ReDim Preserve Ymax(E)
Ymax(E) = bbox(4)

E = E + 1

Next

Echo("")
Echo("")

'Get Min and Max values for X axis
For Each element As Double In Xmin
minimunX = Math.Min(minimunX, element)
Next
For Each element As Double In Xmax
maximumX = Math.Max(maximumX, element)
Next
Echo("X Min: " & minimunX & " " & "X Max: " & maximumX)
Xcenter = (minimunX + maximumX) / 2

'Get Min and Max values for Z Axis
For Each element As Double In Zmin
minimunZ = Math.Min(minimunZ, element)
Next
For Each element As Double In Zmax
maximumZ = Math.Max(maximumZ, element)
Next
Echo("Z Min: " & minimunZ & " " & "Z Max: " & maximumZ)
Zcenter = (minimunZ + maximumZ) / 2

'Get Min and Max values for Y axis
For Each element As Double In Ymin
minimunY = Math.Min(minimunY, element)
Next
For Each element As Double In Ymax
maximumY = Math.Max(maximumY, element)
Next
Echo("Y Min: " & minimunY & " " & "Y Max: " & maximumY)
Ycenter = (minimunY + maximumY) / 2

'Determine center of bounding box in 3 planes
Echo("")
Echo("X center: " & Xcenter)
Echo("Y center: " & Ycenter)
Echo("Z center: " & Zcenter)

Dim center() As Double = {Xcenter, Ycenter, Zcenter}
Dim axis() As Double = {0, 0, 1}

Dim deltaAngle = 1
Dim count As Double = 4
Dim i As Integer = 0
'The 4 to 90 ratio seems optimal. For Full quality animations, a 1 (count) to 360 (loops) ratio should be used.
'This ends up with a very large image file, so tweak accordingly.
For i = 1 To 90
theUfSession.View.RotateViewAbsCsys(workView.Tag, center, axis, deltaAngle, count)
CaptureScreenshots()
Next

End Sub
Sub CaptureScreenshots()

'declare variables
'Dim bounds As Rectangle
Dim screenshot As System.Drawing.Bitmap
Dim graph As Graphics

'get screenshot coordinates, used for
'full screen
'bounds = Screen.PrimaryScreen.Bounds
'screenshot width and height in ratio to screen
'screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppRgb)

screenshot = New System.Drawing.Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format32bppRgb)

'screen shot quality
screenshot.SetResolution(300, 300) 'dpi
graph = Graphics.FromImage(screenshot)
graph.Clear(Color.White)
graph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
graph.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
graph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
graph.CopyFromScreen(windowRect.left, windowRect.top, 0, 0, New Size(width, height), CopyPixelOperation.SourceCopy)
graph.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias

'Print text on screenshot

Using F As New Font("Arial", 10)
'Create a brush
Using B As New SolidBrush(Color.Black)
'Draw some text
graph.DrawString(rootDispName, F, B, 20, 20)
End Using
End Using

'Add screenshot to Bitmaps List for later
'Assembly and animation
Dim Bmp As New Bitmap(screenshot)
Bitmaps.Add(Bmp)

End Sub

Sub AssembleGIF()

'GDI+ constants absent from system.drawing
Const PropertyTagFrameDelay As Integer = &H5100
Const PropertyTagLoopCount As Integer = &H5101
Const PropertyTagTypeLong As Short = 4
Const PropertyTagTypeShort As Short = 3
Const UIntBytes As Integer = 4

Dim gifEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Gif)
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality

'Parameters of the first frame
Dim myEncoderParameters1 As New EncoderParameters(1)
myEncoderParameters1.Param(0) = New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.MultiFrame))

'Parameters of other frames
Dim myEncoderParametersN = New EncoderParameters(1)
myEncoderParametersN.Param(0) = New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.FrameDimensionTime))

Dim myEncoderParametersFlush As New EncoderParameters(1)
myEncoderParametersFlush.Param(0) = New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.Flush))

'Property for the frame delay (apparently no other way to create a fresh instance)
Dim frameDelay As PropertyItem = DirectCast(FormatterServices.GetUninitializedObject(GetType(PropertyItem)), PropertyItem)

frameDelay.Id = PropertyTagFrameDelay
frameDelay.Type = PropertyTagTypeLong

'Length of the value in bytes
frameDelay.Len = Bitmaps.Count * UIntBytes

'The value is an array of 4-byte entries: one per frame.
'Every entry is the frame delay in 1/100-s of a second, in little endian.
Dim desiredLength = Bitmaps.Count * UIntBytes
'E.g., here, we're setting the delay of every frame to 1 second.

'Change FrameDelay argument to change the delay
'between each frame (the implemenation needs to be uncommnted further down in the code)
frameDelay.Len = desiredLength
frameDelay.Value = New Byte(desiredLength - 1) {}

Dim argument As UInteger = 100
Dim frameDelayBytes = BitConverter.GetBytes(argument)
Dim J As Integer = 0

For J = LBound(Bitmaps.ToArray) To Bitmaps.Count
If J < Bitmaps.Count Then
Array.Copy(frameDelayBytes, 0, frameDelay.Value, J * UIntBytes, UIntBytes)
Else
Exit For
End If
Next

'Property Item for the number of animation loops
Dim loopPropertyItem As PropertyItem = DirectCast(FormatterServices.GetUninitializedObject(GetType(PropertyItem)), PropertyItem)
loopPropertyItem.Id = PropertyTagLoopCount
loopPropertyItem.Type = PropertyTagTypeShort
loopPropertyItem.Len = 1

'Ensure that the user has a working directory set-up
'to store the Gif
If (Not System.IO.Directory.Exists(userPath)) Then
System.IO.Directory.CreateDirectory(userPath)
End If

'0 means to animate forever
Dim loopArgument As UShort = 0
loopPropertyItem.Value = BitConverter.GetBytes(loopArgument)
Dim Fstream As FileStream = New FileStream(userPath & "\" & rootDispName & ".Gif", FileMode.Create)
Using Fstream
Dim first As Boolean = True
Dim firstBitmap As Bitmap = Nothing
'Bitmaps is a collection of Bitmap instances that'll become gif frames
For Each bitmap As Bitmap In Bitmaps
If first = True Then
firstBitmap = bitmap
'firstBitmap.SetPropertyItem(frameDelay)
firstBitmap.SetPropertyItem(loopPropertyItem)
firstBitmap.Save(Fstream, gifEncoder, myEncoderParameters1)
first = False
Else
firstBitmap.SaveAdd(bitmap, myEncoderParametersN)
End If
Next
firstBitmap.SaveAdd(myEncoderParametersFlush)
End Using
End Sub

Sub Echo(ByVal output As String)
theSession.ListingWindow.Open()
theSession.ListingWindow.WriteLine(output)
theSession.LogFile.WriteLine(output)
End Sub

Private Function GetBoundingBox(ByVal solidBody As NXOpen.Body) As Double()

'AskBoundingBox returns min and max coordinates
'this function will simply return the box lengths (x, y, z)
Dim bboxCoordinates(5) As Double
Dim bboxLengths(2) As Double

Try
'get solid body bounding box extents
theUfSession.Modl.AskBoundingBox(solidBody.Tag, bboxCoordinates)
bboxLengths(0) = bboxCoordinates(3) - bboxCoordinates(0)
bboxLengths(1) = bboxCoordinates(4) - bboxCoordinates(1)
bboxLengths(2) = bboxCoordinates(5) - bboxCoordinates(2)

Return bboxLengths

Catch ex As NXException
MsgBox(ex.GetType.ToString & " : " & ex.Message, CType(MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, MsgBoxStyle), "Solid Body Bounds Error!")
bboxLengths(0) = 0
bboxLengths(1) = 0
bboxLengths(2) = 0
Return bboxLengths
End Try

End Function

Function AskAllBodies(ByVal thePart As Part) As List(Of Body)

Dim theBodies As New List(Of Body)

Dim aBodyTag As Tag = Nothing
Do
theUfSession.Obj.CycleObjsInPart(thePart.Tag, _
UFConstants.UF_solid_type, aBodyTag)
If aBodyTag = Nothing Then
Exit Do
End If

Dim theType As Integer, theSubtype As Integer
theUfSession.Obj.AskTypeAndSubtype(aBodyTag, theType, theSubtype)
If theSubtype = UFConstants.UF_solid_body_subtype Then
theBodies.Add(CType(Utilities.NXObjectManager.Get(aBodyTag), Body))

End If
Loop While True

Return theBodies

End Function

Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo

Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()

Dim codec As ImageCodecInfo
For Each codec In codecs
If codec.FormatID = format.Guid Then
Return codec
End If
Next codec
Return Nothing

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

End Function

End Module

'Windows 32 API functions used to
'get window properties
Public Class NativeMethods
_
Private Shared Function EnumChildWindows _
(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, _
ByVal lParam As IntPtr) As Boolean
End Function

_
Public Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure 'RECT

Public Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
Public Declare Auto Function GetWindowText Lib "user32" _
(ByVal hWnd As System.IntPtr, _
ByVal lpString As System.Text.StringBuilder, _
ByVal cch As Integer) As Integer

Public Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr()
Dim ChildrenList As New List(Of IntPtr)
Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)
Try
EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle))
Finally
If ListHandle.IsAllocated Then ListHandle.Free()
End Try
Return ChildrenList.ToArray

End Function

Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target
If ChildrenList Is Nothing Then Throw New Exception("GCHandle Target could not be cast as List(Of IntPtr)")
ChildrenList.Add(Handle)
Return True
End Function
End Class

Hi all, I hope you're ok!!
I am new with NXOpen, I'm learning yet.
I was wondering if you could help me with a code where it read the data of a cylinder face in order to get its axis and measure it with another one and get the degrees between them, this code is like a tool to determine if both cylinder connections are aligned. In this moment I have the code that asks to the user to select the faces of the cylinders, but I do not know how to get what I have mentioned above.

Thanks so much!
--------------------------------------------------------

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports System.Windows.Forms

Module PININO1

Sub Main()

Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim theUISession As UI = UI.GetUI
Dim response As Integer
Dim answer As String = ""

If IsNothing(theSession.Parts.Work) Then

Return
End If

Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow

lw.Open()

Const undoMarkName As String = "NXJ journal"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, undoMarkName)

Dim FaceA As Face
Dim FaceB As Face

If SelectFace("Select the hose face", FaceA) = Selection.Response.Cancel Then
Return
End If

If SelectFace("Select the spigot face", FaceB) = Selection.Response.Cancel Then
Return
End If
'------
'---------
'---CODE
'---------
lw.Close()

End Sub

Function SelectFace(ByVal Label As String, ByRef selObj As TaggedObject) As Selection.Response

Dim theUI As UI = UI.GetUI
Dim title As String = Label
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPartAndOccurrence
Dim selectionMask_array(0) As Selection.MaskTriple

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

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(Label, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selobj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

End Module

The .AskFaceData method will return the axis direction of a cylindrical face (along with other information). It is a "wrapper" for an older command so the vector direction info is returned as an array of double values representing (i,j,k) vector info rather than a newer "vector" or "direction" object. Once you have the vector information, there are several ways to measure the angle. If you are only concerned about the vectors being parallel, I'd suggest using the .IsParallel method; it is also a wrapper for an older method and can directly use the array information given by the .AskFaceData method.

I have a question I hope you can help me with.
I have created a code which I’m going to use in NX Check-Mate.
Part of the code is attached below.
What I am looking for is to find all component positioning constraints and from this find which constraint type, component 1 and component 2.
That works well in the code shown below. As far as I don’t give the constraint a name.
By default the name is “Align (DU600241646_A, DU600241647_A)” but when I give it a name it becomes “MY_CONSTRAINT_NAME”
Do you know a method to get the constraint type, component 1 and component 2 even if it has got a name?


Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.Assemblies

Module Module1

Sub Main()
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
Dim constraintstringtocheck As String
Dim myConstraints() As Positioning.Constraint = theSession.Parts.Work.ComponentAssembly.Positioner.Constraints.ToArray()

lw.Open()

For Each thisConstraint As Positioning.Constraint In myConstraints
constraintstringtocheck = (thisConstraint.Name.ToString())
lw.WriteLine(constraintstringtocheck)
Next
End Sub

End Module

Best Regards
Gunnar

Hello Everyone, I have the below Journal which performs the following actions.
1> Assign material by receiving input material through Windows Form and selecting the part body through select object
2> Measure the weight attribute
3> Create an attribute "Weight" and add weight of the material to the weight attribute.

Now i have couple of issues:

1>How do i delete the old material if a material is already added
2>How to delete the measure body properties which is created previously
3> This macro is running fine to rename the expression based on symbol ( expression with Kg to be renamed to Mass, with mm2 to be renamed to Surface Area) only if there is no other expressions previously... it's not running fine if there is a lot of Expressions already
4> I have not added any of the methods to capture error codes... any insights on where to add the error codes..??

' NX 12.0.1.7
' Journal created by Balaji_Sampath03 on Sat Oct 19 16:11:05 2019 India Standard Time
'
Imports System
Imports NXOpen
Imports System.Collections.Generic
Imports NXOpen.UF
Imports NXOpenUI

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

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

' ----------------------------------------------
' Menu: Tools->Materials->Assign Materials...
' ----------------------------------------------

Dim MaterialListBuilder1 As NXOpen.PhysMat.PhysicalMaterialListBuilder = Nothing
MaterialListBuilder1 = workPart.MaterialManager.PhysicalMaterials.CreateListBlockBuilder()

Dim MaterialAssignBuilder1 As NXOpen.PhysMat.PhysicalMaterialAssignBuilder = Nothing
MaterialAssignBuilder1 = workPart.MaterialManager.PhysicalMaterials.CreateMaterialAssignBuilder()

Dim physicalMaterialListBuilder3 As NXOpen.PhysMat.PhysicalMaterialListBuilder = Nothing
physicalMaterialListBuilder3 = workPart.MaterialManager.PhysicalMaterials.CreateListBlockBuilder()

Dim nXObject1 As NXOpen.NXObject = Nothing
Dim physicalMaterial1 As NXOpen.PhysicalMaterial = CType(nXObject1, NXOpen.PhysicalMaterial.GetUsedMaterials)
physicalMaterial1.Delete()
nXObject1 = physicalMaterialListBuilder3.Commit()
physicalMaterialListBuilder3.Destroy()

Dim MaterialToAssign As NXOpen.PhysicalMaterial = Nothing
Dim MaterialToAdd As String = Nothing

'create new form object
Dim myForm As New AddMaterial
'set form object properties (current part attribute title and value)
myForm.MaterialToAdd = MaterialToAdd
'display our form
myForm.ShowDialog()

If myForm.Canceled Then
'user pressed cancel, exit journal
Return
Else
'user pressed OK, assign value from form to part attribute
MaterialToAdd = myForm.MaterialToAdd

End If

MaterialToAssign = workPart.MaterialManager.PhysicalMaterials.LoadFromMatmlLibrary("Z:\Knowldege Management\BOK\References\RTCOE_MatLibrary\physicalmateriallibrary.xml", MaterialToAdd)

Dim physicalMaterialBuilder1 As NXOpen.PhysicalMaterialBuilder = Nothing
physicalMaterialBuilder1 = workPart.MaterialManager.PhysicalMaterials.CreatePhysicalMaterialInspectBuilder(MaterialToAssign)
physicalMaterialBuilder1.Destroy()

Dim theBody As Body
If SelectSolidToAssignMaterial("select a body", theBody) = Selection.Response.Cancel Then
Return
End If

Dim theBodies(0) As Body
theBodies(0) = theBody
MaterialToAssign.AssignObjects(theBodies)
MaterialListBuilder1.Destroy()
MaterialAssignBuilder1.Destroy()

' ----------------------------------------------
' Menu: Analysis->Measure Body...
' ----------------------------------------------

'Dim MeasureToDelete As NXOpen.Measure = DeleteMeasure()

Dim nullNXOpen_NXObject As NXOpen.NXObject = Nothing
Dim measureBodyBuilder1 As NXOpen.MeasureBodyBuilder = Nothing
measureBodyBuilder1 = workPart.MeasureManager.CreateMeasureBodyBuilder(nullNXOpen_NXObject)

Dim BodyToMeasure(0) As NXOpen.Body
BodyToMeasure(0) = theBody

Dim bodyDumbRule1 As NXOpen.BodyDumbRule = Nothing
bodyDumbRule1 = workPart.ScRuleFactory.CreateRuleBodyDumb(BodyToMeasure, True)

Dim rules1(0) As NXOpen.SelectionIntentRule
rules1(0) = bodyDumbRule1
measureBodyBuilder1.BodyCollector.ReplaceRules(rules1, False)

Dim massUnits1(4) As NXOpen.Unit
'Dim SurfaceArea As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("SquareMilliMeter"), NXOpen.Unit)
'Dim Volume As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("CubicMilliMeter"), NXOpen.Unit)
Dim Mass As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("Kilogram"), NXOpen.Unit)
'Dim Length As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), NXOpen.Unit)
'Dim Weight As NXOpen.Unit = CType(workPart.UnitCollection.FindObject("Newton"), NXOpen.Unit)

Dim measureBodies1 As NXOpen.MeasureBodies = Nothing
measureBodies1 = workPart.MeasureManager.NewMassProperties(massUnits1, 0.98999999999999999, False, measureBodyBuilder1.BodyCollector)
Dim measure1 As NXOpen.Measure = Nothing
measure1 = measureBodies1.CreateFeature()

measureBodies1.Dispose()
measureBodyBuilder1.Destroy()

' ----------------------------------------------
' Menu: Tools-> Expression-> Rename Measured Body Expressions
' ----------------------------------------------

For Each temp As Expression In workPart.Expressions

If temp.Units.Symbol = "kg" Then
workPart.Expressions.Rename(temp, "Mass")
End If

' If temp.Units.Symbol = "mm²" Then
' workPart.Expressions.Rename(temp, "SurfaceArea")
' End If

' If temp.Units.Symbol = "mm³" Then
' workPart.Expressions.Rename(temp, "Volume")
' End If

' If temp.Units.Symbol = "N" Then
' workPart.Expressions.Rename(temp, "Weight")
' End If

Next

' ----------------------------------------------
' Dialog Begin Expressions Properties Builder
' ----------------------------------------------

Dim objectsAttribute(0) As NXOpen.NXObject
objectsAttribute(0) = workPart

Dim attributePropertiesBuilder1 As NXOpen.AttributePropertiesBuilder = Nothing
attributePropertiesBuilder1 = theSession.AttributeManager.CreateAttributePropertiesBuilder(workPart, objectsAttribute, NXOpen.AttributePropertiesBuilder.OperationType.None)

attributePropertiesBuilder1.Category = "Materials"
attributePropertiesBuilder1.Title = "Weight"
attributePropertiesBuilder1.DataType = NXOpen.AttributePropertiesBaseBuilder.DataTypeOptions.Number
'attributePropertiesBuilder1.Units = "Tesla"
attributePropertiesBuilder1.Units = "Kilogram"

Dim MassProperties As NXOpen.Expression = Nothing
MassProperties = workPart.Expressions.CreateSystemExpressionWithUnits("0.0", Mass)
MassProperties.RightHandSide = "Mass"
attributePropertiesBuilder1.IsReferenceType = False

attributePropertiesBuilder1.Expression = MassProperties

Dim nXObject2 As NXOpen.NXObject = Nothing
nXObject2 = attributePropertiesBuilder1.Commit()

attributePropertiesBuilder1.Destroy()

End Sub

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

Dim theUI As UI = UI.GetUI
Dim title As String = "Select Solid To Assign Material"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
Dim selectionMask_array(0) As Selection.MaskTriple

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

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selobj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

End Function

'Function DeleteMeasure() As NXOpen.Measure
' Dim objects1(0) As NXOpen.TaggedObject
' Dim MeasureToDelete As NXOpen.Measure = CType(workPart.Features.FindObject("BODY_MEASUREMENT(4)"), NXOpen.Measure)
' objects1(0) = MeasureToDelete
'End Function

End Module

Public Class AddMaterial
Private _frmAttributeValue As String
Public Property MaterialToAdd() As String
Get
Return _frmAttributeValue
End Get
Set(ByVal value As String)
_frmAttributeValue = value
End Set
End Property

Private _canceled As Boolean = False
Public ReadOnly Property Canceled() As Boolean
Get
Return _canceled
End Get
End Property

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Label1.Text = "Material"
TextBox1.Text = _frmAttributeValue
End Sub

Private Sub btnCancel_Click(sender As System.Object, e As System.EventArgs) Handles btnCancel.Click
_canceled = True
Me.Close()
End Sub

Private Sub btnOK_Click(sender As System.Object, e As System.EventArgs) Handles btnOK.Click
_frmAttributeValue = TextBox1.Text.ToUpper
Me.Close()
End Sub

End Class

_
Partial Class AddMaterial
Inherits System.Windows.Forms.Form

'Form overrides dispose to clean up the component list.
_
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub

'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer

'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
_
Private Sub InitializeComponent()
Me.btnCancel = New System.Windows.Forms.Button()
Me.btnOK = New System.Windows.Forms.Button()
Me.Label1 = New System.Windows.Forms.Label()
Me.TextBox1 = New System.Windows.Forms.TextBox()
Me.SuspendLayout()
'
'btnCancel
'
Me.btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel
Me.btnCancel.Location = New System.Drawing.Point(178, 107)
Me.btnCancel.Name = "btnCancel"
Me.btnCancel.Size = New System.Drawing.Size(85, 50)
Me.btnCancel.TabIndex = 0
Me.btnCancel.Text = "Cancel"
Me.btnCancel.UseVisualStyleBackColor = True
'
'btnOK
'
Me.btnOK.Location = New System.Drawing.Point(66, 107)
Me.btnOK.Name = "btnOK"
Me.btnOK.Size = New System.Drawing.Size(85, 50)
Me.btnOK.TabIndex = 1
Me.btnOK.Text = "Ok"
Me.btnOK.UseVisualStyleBackColor = True
'
'Label1
'
Me.Label1.Location = New System.Drawing.Point(12, 54)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(79, 13)
Me.Label1.TabIndex = 2
Me.Label1.Text = "Label1"
Me.Label1.TextAlign = System.Drawing.ContentAlignment.MiddleRight
'
'TextBox1
'
Me.TextBox1.Location = New System.Drawing.Point(97, 51)
Me.TextBox1.Name = "TextBox1"
Me.TextBox1.Size = New System.Drawing.Size(166, 20)
Me.TextBox1.TabIndex = 3
'
'MaterialCreation
'
Me.AcceptButton = Me.btnOK
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.CancelButton = Me.btnCancel
Me.ClientSize = New System.Drawing.Size(284, 176)
Me.Controls.Add(Me.TextBox1)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.btnOK)
Me.Controls.Add(Me.btnCancel)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedDialog
Me.MaximizeBox = False
Me.MinimizeBox = False
Me.Name = "AddMaterial"
Me.Text = "AddMaterial"
Me.ResumeLayout(False)
Me.PerformLayout()

End Sub
Friend WithEvents btnCancel As System.Windows.Forms.Button
Friend WithEvents btnOK As System.Windows.Forms.Button
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
End Class

Balaji

This Journal creates a PDF of the drawing sheets the user selects. It puts the PDF with the name you select in the folder where the .prt file is located.

Option Strict Off
Imports System
Imports System.IO
Imports System.Collections
Imports System.Collections.Generic
Imports System.Windows.Forms
Imports System.Windows.Forms.MessageBox
Imports NXOpen
Imports NXOpen.UF

Module NXJournal

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim shts As New ArrayList()
Dim myForm1 As New Form1

'**********************************************************

Sub Main

Dim dwgs As Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim i As Integer
Dim pdfFile As String
Dim currentPath As String
Dim currentFile As String
Dim exportFile As String
Dim partUnits As Integer
Dim strOutputFolder As String
Dim strRevision As String
Dim rspFileExists

'determine if we are running under TC or native
Dim IsTcEng As Boolean = False
Dim UFSes As UFSession = UFSession.GetUFSession()
UFSes.UF.IsUgmanagerActive(IsTcEng)

partUnits = displayPart.PartUnits
'0 = inch
'1 = metric

If IsTcEng Then
currentFile = workPart.GetStringAttribute("DB_PART_NO")
strRevision = workPart.GetStringAttribute("DB_PART_REV")

Else 'running in native mode
'currentFile = GetFilePath() & GetFileName() & ".prt"
currentPath = GetFilePath()
currentFile = GetFileName()

Try
strRevision = workPart.GetStringAttribute("REVISION")
strRevision = Trim(strRevision)
Catch ex As Exception
strRevision = ""
End Try
End If
exportFile = currentFile

strOutputFolder = OutputPath()
'if we don't have a valid directory (ie the user pressed 'cancel') exit the journal
If Not Directory.Exists(strOutputFolder) Then
Exit Sub
End If
strOutputFolder = strOutputFolder & "\"

Dim userSelectedFileName = exportFile & ".pdf"
userSelectedFileName = InputBox("Enter File Name", "NAME OF FILE", userSelectedFileName)
If String.ReferenceEquals(userSelectedFileName, String.Empty) Then
Exit Sub

End If

pdfFile = strOutputFolder & userSelectedFileName

For Each sheet in dwgs
shts.Add(sheet.Name)
Next
shts.Sort()

if shts.count() > 1 then

myform1.shts = shts
myForm1.ShowDialog()

If myForm1.Canceled Then

'Exit sub
Return

End If

shts = myform1.shts

end if

i = 0
Dim sht As String
For Each sht in shts

For Each sheet in dwgs
If sheet.name = sht Then
i = i + 1

'the pdf export uses 'append file', if we are on sheet 1 make sure the user wants to overwrite
'if the drawing is multisheet, don't ask on subsequent sheets
If i = 1 Then
If File.Exists(pdfFile) Then
rspFileExists = msgbox("The file: '" & pdfFile & "' already exists; overwrite?", vbyesno + vbquestion)
If rspFileExists = vbYes Then
Try
File.Delete(pdfFile)
Catch ex As Exception
msgbox(ex.message & vbcrlf & "Journal exiting", vbcritical + vbokonly, "Error")
Exit Sub
End Try
Else
'msgbox("journal exiting", vbokonly)
Exit Sub
End If
End If
End If

'update any views that are out of date
theSession.Parts.Work.DraftingViews.UpdateViews(Drawings.DraftingViewCollection.ViewUpdateOption.OutOfDate, sheet)

Try
ExportPDF(sheet, pdfFile, partUnits)
Catch ex As exception
msgbox("Error occurred in PDF export" & vbcrlf & ex.message & vbcrlf & "journal exiting", vbcritical + vbokonly, "Error")
Exit Sub
End Try
Exit For
End If
Next

Next

If i = 0 Then
MessageBox.Show("This part has no drawing sheets to export", "PDF export failure", MessageBoxButtons.ok, MessageBoxIcon.Warning)
Else
MessageBox.Show("Exported: " & i & " sheet(s) to pdf file" & vbcrlf & pdfFile, "PDF export success", MessageBoxButtons.ok, MessageBoxIcon.Information)
End If

End Sub
'**********************************************************

Function GetFileName()
Dim strPath As String
Dim strPart As String
Dim pos As Integer

'get the full file path
strPath = displayPart.fullpath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)

strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 4)

GetFileName = strPart
End Function
'**********************************************************

Function GetFilePath()
Dim strPath As String
Dim strPart As String
Dim pos As Integer

'get the full file path
strPath = displayPart.fullpath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)

strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 4)

GetFilePath = strPath
End Function
'**********************************************************

Function OutputPath()
'Requires:
' Imports System.IO
' Imports System.Windows.Forms
'if the user presses OK on the dialog box, the chosen path is returned
'if the user presses cancel on the dialog box, 0 is returned

Dim strLastPath As String
Dim strOutputPath As String

'Key will show up in HKEY_CURRENT_USER\Software\VB and VBA Program Settings
Try
'Get the last path used from the registry
strLastPath = GetSetting("NX journal", "Export pdf", "ExportPath")
'msgbox("Last Path: " & strLastPath)
Catch e As ArgumentException
Catch e As Exception
msgbox (e.GetType.ToString)
Finally
End Try

OutputPath = GetFilePath()

End Function
'**********************************************************

Sub ExportPDF(dwg As Drawings.DrawingSheet, outputFile As String, units As Integer)

Dim printPDFBuilder1 As PrintPDFBuilder

printPDFBuilder1 = workPart.PlotManager.CreatePrintPdfbuilder()
printPDFBuilder1.Scale = 1.0
printPDFBuilder1.Action = PrintPDFBuilder.ActionOption.Native
printPDFBuilder1.Colors = PrintPDFBuilder.Color.BlackOnWhite
printPDFBuilder1.Size = PrintPDFBuilder.SizeOption.ScaleFactor
If units = 0 Then
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.English
Else
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.Metric
End If
printPDFBuilder1.XDimension = dwg.height
printPDFBuilder1.YDimension = dwg.length
printPDFBuilder1.OutputText = PrintPDFBuilder.OutputTextOption.Polylines
printPDFBuilder1.RasterImages = True
printPDFBuilder1.ImageResolution = PrintPDFBuilder.ImageResolutionOption.Medium
printPDFBuilder1.Append = True
printPDFBuilder1.AddWatermark = False
printPDFBuilder1.Watermark = ""
Dim sheets1(0) As NXObject
Dim drawingSheet1 As Drawings.DrawingSheet = CType(dwg, Drawings.DrawingSheet)

sheets1(0) = drawingSheet1
printPDFBuilder1.SourceBuilder.SetSheets(sheets1)

printPDFBuilder1.Filename = outputFile

Dim nXObject1 As NXObject
nXObject1 = printPDFBuilder1.Commit()

printPDFBuilder1.Destroy()

End Sub
'**********************************************************

End Module

'*************************************************************************************************
'* FORM1
'*************************************************************************************************
Public Class Form1

Public shts As New ArrayList()
Public shts2 As New ArrayList()

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

for each shtname as string in shts

ListBox1.Items.Add(shtname)

next

End Sub

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

shts = shts2

Me.Close()

End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

_canceled = True
Me.Close()

End Sub

Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox1.SelectedIndexChanged

shts2.Clear()

For Each Item As Object In ListBox1.SelectedItems

shts2.add(Item)

Next

End Sub

Private _canceled As Boolean = False

Public ReadOnly Property Canceled() As Boolean

Get

Return _canceled

End Get

End Property

End Class

_
Partial Class Form1
Inherits System.Windows.Forms.Form

_
Protected Overrides Sub Dispose(ByVal disposing As Boolean)

Try

If disposing AndAlso components IsNot Nothing Then

components.Dispose()

End If

Finally

MyBase.Dispose(disposing)

End Try

End Sub

Private components As System.ComponentModel.IContainer

_
Private Sub InitializeComponent()

Me.Button1 = New System.Windows.Forms.Button()
Me.Button2 = New System.Windows.Forms.Button()
Me.ListBox1 = New System.Windows.Forms.ListBox()
Me.Label1 = New System.Windows.Forms.Label()
Me.SuspendLayout()
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(36, 205)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(75, 23)
Me.Button1.TabIndex = 0
Me.Button1.Text = "Ok"
Me.Button1.UseVisualStyleBackColor = True
'
'Button2
'
Me.Button2.Location = New System.Drawing.Point(149, 205)
Me.Button2.Name = "Button2"
Me.Button2.Size = New System.Drawing.Size(75, 23)
Me.Button2.TabIndex = 1
Me.Button2.Text = "Cancel"
Me.Button2.UseVisualStyleBackColor = True
'
'ListBox1
'
Me.ListBox1.FormattingEnabled = True
'Me.ListBox1.Items.AddRange(New Object() {"A", "B", "V", "X", "D"})
Me.ListBox1.Location = New System.Drawing.Point(12, 30)
Me.ListBox1.Name = "ListBox1"
'Me.ListBox1.SelectionMode = System.Windows.Forms.SelectionMode.MultiSimple
Me.ListBox1.SelectionMode = System.Windows.Forms.SelectionMode.MultiExtended
Me.ListBox1.Size = New System.Drawing.Size(240, 160)
Me.ListBox1.TabIndex = 2
'
'Label1
'
Me.Label1.AutoSize = True
Me.Label1.Location = New System.Drawing.Point(12, 10)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(72, 13)
Me.Label1.TabIndex = 4
Me.Label1.Text = "Choose Sheets to export: "
'
'Form1
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(280, 280)
Me.Controls.Add(Me.Label1)
Me.Controls.Add(Me.ListBox1)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Button1)
Me.AcceptButton = Button1
Me.CancelButton = Button2
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Sizable
Me.MaximumSize = New System.Drawing.Size(280, 280)
Me.MinimumSize = New System.Drawing.Size(280, 280)
Me.MaximizeBox = False
Me.MinimizeBox = False
Me.Name = "Form1"
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
Me.Text = "Sheets to export:"
Me.ResumeLayout(False)
Me.PerformLayout()

End Sub

Friend WithEvents Button1 As Button
Friend WithEvents Button2 As Button
Friend WithEvents ListBox1 As ListBox
Friend WithEvents Label1 As System.Windows.Forms.Label

End Class

it is runnning fine within my system but when created same in other system we are facing error. looks like probelem with mentioned line below CType(workPart.Annotations.TableSections.FindObject("ENTITY 165 4 1"),
Please provide your suggestions and it would be of help to move on

Thanks

' NX 1855
' Journal created by mchekkab on Thu Jun 25 15:59:14 2020 India Standard Time
'
Imports System
Imports NXOpen

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

Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()
Dim workPart As NXOpen.Part = theSession.Parts.Work

Dim displayPart As NXOpen.Part = theSession.Parts.Display

' ----------------------------------------------
' Menu: Edit->Table->Settings...
' ----------------------------------------------
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")

Dim objects1(0) As NXOpen.DisplayableObject
Dim tableSection1 As NXOpen.Annotations.TableSection = CType(workPart.Annotations.TableSections.FindObject("ENTITY 165 4 1"), NXOpen.Annotations.TableSection)

objects1(0) = tableSection1
Dim tableEditSettingsBuilder1 As NXOpen.Annotations.TableEditSettingsBuilder = Nothing
tableEditSettingsBuilder1 = workPart.SettingsManager.CreateTableEditSettingsBuilder(objects1)

tableEditSettingsBuilder1.TableSection.ApplyToAllSections = True

theSession.SetUndoMarkName(markId1, "Settings Dialog")

Dim taggedObject1 As NXOpen.TaggedObject = Nothing
taggedObject1 = tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.FindItem(0)

Dim tableColumnBuilder1 As NXOpen.Annotations.TableColumnBuilder = CType(taggedObject1, NXOpen.Annotations.TableColumnBuilder)

Dim taggedObject2 As NXOpen.TaggedObject = Nothing
taggedObject2 = tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.FindItem(1)

Dim tableColumnBuilder2 As NXOpen.Annotations.TableColumnBuilder = CType(taggedObject2, NXOpen.Annotations.TableColumnBuilder)

Dim taggedObject3 As NXOpen.TaggedObject = Nothing
taggedObject3 = tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.FindItem(2)

Dim tableColumnBuilder3 As NXOpen.Annotations.TableColumnBuilder = CType(taggedObject3, NXOpen.Annotations.TableColumnBuilder)

Dim editsettingsbuilders1(0) As NXOpen.Drafting.BaseEditSettingsBuilder
editsettingsbuilders1(0) = tableEditSettingsBuilder1
workPart.SettingsManager.ProcessForMultipleObjectsSettings(editsettingsbuilders1)

Dim markId2 As NXOpen.Session.UndoMarkId = Nothing
markId2 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId2, Nothing)

Dim markId3 As NXOpen.Session.UndoMarkId = Nothing
markId3 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableColumnBuilder1.Title = "ITEM NO"

theSession.SetUndoMarkName(markId3, "Settings - Title")

theSession.SetUndoMarkVisibility(markId3, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId4 As NXOpen.Session.UndoMarkId = Nothing
markId4 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId4, Nothing)

Dim markId5 As NXOpen.Session.UndoMarkId = Nothing
markId5 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim tableColumnBuilder4 As NXOpen.Annotations.TableColumnBuilder = Nothing
tableColumnBuilder4 = tableEditSettingsBuilder1.TableColumnSettingsBuilder.CreateTableColumnBuilder(tableColumnBuilder1)

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Insert(1, tableColumnBuilder4)

tableColumnBuilder4.Category = NXOpen.Annotations.TableColumnBuilder.CategoryType.Callout

tableColumnBuilder4.Scope = NXOpen.Annotations.TableColumnBuilder.ScopeType.AllCellsinColumn

theSession.SetUndoMarkName(markId5, "Settings - Add New Column")

theSession.SetUndoMarkVisibility(markId5, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId6 As NXOpen.Session.UndoMarkId = Nothing
markId6 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId6, Nothing)

Dim markId7 As NXOpen.Session.UndoMarkId = Nothing
markId7 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim tableColumnBuilder5 As NXOpen.Annotations.TableColumnBuilder = Nothing
tableColumnBuilder5 = tableEditSettingsBuilder1.TableColumnSettingsBuilder.CreateTableColumnBuilder(tableColumnBuilder4)

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Insert(2, tableColumnBuilder5)

tableColumnBuilder5.Category = NXOpen.Annotations.TableColumnBuilder.CategoryType.Callout

tableColumnBuilder5.Scope = NXOpen.Annotations.TableColumnBuilder.ScopeType.AllCellsinColumn

theSession.SetUndoMarkName(markId7, "Settings - Add New Column")

theSession.SetUndoMarkVisibility(markId7, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId8 As NXOpen.Session.UndoMarkId = Nothing
markId8 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId8, Nothing)

Dim markId9 As NXOpen.Session.UndoMarkId = Nothing
markId9 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId9, Nothing)

Dim markId10 As NXOpen.Session.UndoMarkId = Nothing
markId10 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId10, Nothing)

Dim markId11 As NXOpen.Session.UndoMarkId = Nothing
markId11 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId11, Nothing)

Dim markId12 As NXOpen.Session.UndoMarkId = Nothing
markId12 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId12, Nothing)

Dim markId13 As NXOpen.Session.UndoMarkId = Nothing
markId13 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId13, Nothing)

Dim markId14 As NXOpen.Session.UndoMarkId = Nothing
markId14 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(1, 2)

theSession.SetUndoMarkName(markId14, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId14, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId15 As NXOpen.Session.UndoMarkId = Nothing
markId15 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(2, 3)

theSession.SetUndoMarkName(markId15, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId15, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId16 As NXOpen.Session.UndoMarkId = Nothing
markId16 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(3, 4)

theSession.SetUndoMarkName(markId16, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId16, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId17 As NXOpen.Session.UndoMarkId = Nothing
markId17 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(4, 3)

theSession.SetUndoMarkName(markId17, "Settings - Move Up")

theSession.SetUndoMarkVisibility(markId17, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId18 As NXOpen.Session.UndoMarkId = Nothing
markId18 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId18, Nothing)

Dim markId19 As NXOpen.Session.UndoMarkId = Nothing
markId19 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId19, Nothing)

Dim markId20 As NXOpen.Session.UndoMarkId = Nothing
markId20 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(3, 4)

theSession.SetUndoMarkName(markId20, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId20, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId21 As NXOpen.Session.UndoMarkId = Nothing
markId21 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId21, Nothing)

Dim markId22 As NXOpen.Session.UndoMarkId = Nothing
markId22 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId22, Nothing)

Dim markId23 As NXOpen.Session.UndoMarkId = Nothing
markId23 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(1, 2)

theSession.SetUndoMarkName(markId23, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId23, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId24 As NXOpen.Session.UndoMarkId = Nothing
markId24 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableEditSettingsBuilder1.TableColumnSettingsBuilder.TableColumnList.Swap(2, 3)

theSession.SetUndoMarkName(markId24, "Settings - Move Down")

theSession.SetUndoMarkVisibility(markId24, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId25 As NXOpen.Session.UndoMarkId = Nothing
markId25 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId25, Nothing)

Dim markId26 As NXOpen.Session.UndoMarkId = Nothing
markId26 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

tableColumnBuilder5.Category = NXOpen.Annotations.TableColumnBuilder.CategoryType.General

tableColumnBuilder5.DefaultText = ""

theSession.SetUndoMarkName(markId26, "Settings - Category")

theSession.SetUndoMarkVisibility(markId26, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId27 As NXOpen.Session.UndoMarkId = Nothing
markId27 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId27, Nothing)

Dim markId28 As NXOpen.Session.UndoMarkId = Nothing
markId28 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim markId29 As NXOpen.Session.UndoMarkId = Nothing
markId29 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Start")

theSession.SetUndoMarkName(markId29, "Attribute Name Dialog")

' ----------------------------------------------
' Dialog Begin Attribute Name
' ----------------------------------------------
Dim markId30 As NXOpen.Session.UndoMarkId = Nothing
markId30 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Attribute Name")

theSession.DeleteUndoMark(markId30, Nothing)

Dim markId31 As NXOpen.Session.UndoMarkId = Nothing
markId31 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Attribute Name")

theSession.DeleteUndoMark(markId31, Nothing)

theSession.SetUndoMarkName(markId29, "Attribute Name")

theSession.DeleteUndoMark(markId29, Nothing)

tableColumnBuilder5.AttributeName = "$MASS"

tableColumnBuilder5.DefaultText = ""

tableColumnBuilder5.Title = "MASS"

theSession.SetUndoMarkName(markId28, "Settings - Column")

theSession.SetUndoMarkVisibility(markId28, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId32 As NXOpen.Session.UndoMarkId = Nothing
markId32 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

theSession.DeleteUndoMark(markId32, Nothing)

Dim markId33 As NXOpen.Session.UndoMarkId = Nothing
markId33 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim markId34 As NXOpen.Session.UndoMarkId = Nothing
markId34 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Start")

theSession.SetUndoMarkName(markId34, "Attribute Name Dialog")

' ----------------------------------------------
' Dialog Begin Attribute Name
' ----------------------------------------------
Dim markId35 As NXOpen.Session.UndoMarkId = Nothing
markId35 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Attribute Name")

theSession.DeleteUndoMark(markId35, Nothing)

Dim markId36 As NXOpen.Session.UndoMarkId = Nothing
markId36 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Attribute Name")

theSession.DeleteUndoMark(markId36, Nothing)

theSession.SetUndoMarkName(markId34, "Attribute Name")

theSession.DeleteUndoMark(markId34, Nothing)

tableColumnBuilder4.AttributeName = "$COMPONENT_NAME"

tableColumnBuilder4.DefaultText = ""

tableColumnBuilder4.Title = "COMPONENT NAME"

theSession.SetUndoMarkName(markId33, "Settings - Column")

theSession.SetUndoMarkVisibility(markId33, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Invisible)

Dim markId37 As NXOpen.Session.UndoMarkId = Nothing
markId37 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim markId38 As NXOpen.Session.UndoMarkId = Nothing
markId38 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Settings")

Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = tableEditSettingsBuilder1.Commit()

theSession.DeleteUndoMark(markId38, Nothing)

theSession.SetUndoMarkName(markId1, "Settings")

tableEditSettingsBuilder1.Destroy()

theSession.DeleteUndoMark(markId37, Nothing)

theSession.SetUndoMarkVisibility(markId1, Nothing, NXOpen.Session.MarkVisibility.Visible)

theSession.DeleteUndoMark(markId33, Nothing)

theSession.DeleteUndoMark(markId28, Nothing)

theSession.DeleteUndoMark(markId26, Nothing)

theSession.DeleteUndoMark(markId24, Nothing)

theSession.DeleteUndoMark(markId23, Nothing)

theSession.DeleteUndoMark(markId20, Nothing)

theSession.DeleteUndoMark(markId17, Nothing)

theSession.DeleteUndoMark(markId16, Nothing)

theSession.DeleteUndoMark(markId15, Nothing)

theSession.DeleteUndoMark(markId14, Nothing)

theSession.DeleteUndoMark(markId7, Nothing)

theSession.DeleteUndoMark(markId5, Nothing)

theSession.DeleteUndoMark(markId3, Nothing)

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

End Sub
End Module

Niranjan

Are you modifying an actual parts list object or is this a generic tabular note that you are using to create your own BOM?

We are modifying default Part List by adding new columns to add Materials,Vendor names etc depending on client BOM format and renaming the headers from PC.NO to ITEM NO etc., We recorded journal but selecting Part List table has Find Object (Entity) which is particular to that Assy file and not working in other files.
"Dim tableSection1 As NXOpen.Annotations.TableSection = CType(workPart.Annotations.TableSections.FindObject("ENTITY 165 4 1"), NXOpen.Annotations.TableSection)"
Please suggest to replace the Find Object line so it works in any file to select the Part List Table OR a new Journal to edit BOM so we will modify for our required fields.

Niranjan

http://nxjournaling.com/comment/5029#comment-5029

There is some code in the link above that will find the parts list in the current display part.

Option Strict Off

Imports NXOpen
Imports NXOpen.CAM
Imports NXOpen.UF
Imports NXOpen.UF.UFoper
Imports NXOpen.Utilities
Imports NXOpenUI
Imports System
Imports System.IO

Module IPMTraversalFeedRateEditor
Dim updatableMillingOperationSubTypes = New Collections.Generic.Dictionary(Of Integer, String) From {
{ 110, "Planar mill profile / pocket operation" },
{ 210, "Fixed axis surface contouring" },
{ 211, "Variable axis surface contouring" },
{ 220, "Unknown (UF_mach_point_to_point_subtype)" },
{ 260, "Cavity milling" },
{ 261, "Face milling" },
{ 262, "Volume milling" },
{ 263, "Z-Level milling" },
{ 265, "Plunge milling" },
{ 266, "Variable axis Z-Level" },
{ 1700, "Thread milling" },
{ 3100, "Groove milling" },
{ 3300, "Radial groove milling operation" },
{ 2700, "Cylinder milling" },
{ 3200, "Chamfer milling" }
}

Sub Main()
' Read selected item by the user. It should be a single program group.
Dim selectedTags() As NXOpen.Tag
Dim selectedCount As Integer
UFSession.GetUFSession().UiOnt.AskSelectedNodes(selectedCount, selectedTags)
If selectedCount <> 1 Then
UI.GetUI().NXMessageBox.Show("Error : ", NXMessageBox.DialogType.Error, "You must select exactly one program group.")
Exit Sub
End If

' Cast selected item to program group.
Dim programGroup As CAM.NCGroup
Try
programGroup = CType(NXObjectManager.Get(selectedTags(0)), CAM.NCGroup)
Catch ex As InvalidCastException
UI.GetUI().NXMessageBox.Show("Error : ", NXMessageBox.DialogType.Error, "You must select a program group.")
Exit Sub
Catch ex As OverflowException
UI.GetUI().NXMessageBox.Show("Error : ", NXMessageBox.DialogType.Error, "You must select a program group.")
Exit Sub
End Try

' Prompt for the new feed traversal feed rate and convert to a number.
Dim newFeedRateValue As Double = Convert.ToDouble(NXInputBox.GetInputString("Enter new traversal feed rate", "Feed Traversal Rate Editor", "475"))

' Get all operations that are part of the program group.
Dim operations As New System.Collections.Generic.List(Of CAM.Operation)
For Each member As CAM.CAMObject In programGroup.GetMembers()
If TypeOf member Is CAM.Operation
operations.Add(CType(member, CAM.Operation))
End If
Next

Dim listingWindow As ListingWindow = Session.GetSession().ListingWindow
listingWindow.SelectDevice(ListingWindow.DeviceType.Window, "")
listingWindow.open()

' Iterate over operations. Update milling operations with IPM traversal feed rates.
For Each operation As CAM.Operation In operations
'Get the type and subtype of the operation.
Dim operationType As Integer
Dim operationSubtype As Integer
UFSession.GetUFSession().Obj.AskTypeAndSubtype(operation.tag, operationType, operationSubtype)

' Update milling operations with IPM traversal feed rates. Skip others.
If updatableMillingOperationSubTypes.ContainsKey(operationSubtype) Then
Dim objectsFeedsBuilder As CAM.ObjectsFeedsBuilder = Session.GetSession().Parts.Work.CAMSetup.CreateFeedsBuilder(New CAM.CAMObject() { operation })
Dim feedTraversal As CAM.InheritableFeedBuilder = objectsFeedsBuilder.FeedsBuilder.FeedTraversalBuilder
Dim oldFeedRateValue As Double = feedTraversal.Value

If feedTraversal.Unit = CAM.FeedRateUnit.PerMinute Then
feedTraversal.Value = newFeedRateValue
objectsFeedsBuilder.Commit()
ListingWindow.WriteLine(operation.Name & " - Traversal feed rate updated from " & oldFeedRateValue & " to " & newFeedRateValue)
End If
objectsFeedsBuilder.Destroy()
End If
Next

listingWindow.Close()

End Sub

End Module

Thanks for posting your finished code!

Hello,
I am new here and also for NXopen environment. I want to create a journal for something complex.
i have a 3D-Modell and i want to export it in step214 and save it with same name but in different folder (folder name: step) which folder also will be created through journal and if is there any folder with same name then skip the create folder process and export step file in that folder.
Its same i want to do with 2D-drawing and pdf.
I am very thankfull to you in advance for help me out.

The code in the link below shows how to create a folder:
http://www.nxjournaling.com/comment/5527#comment-5527

The link below has a "PDF exporter class" that you can add to your own journal to make exporting PDF's easier (examples included).
http://www.nxjournaling.com/content/pdf-exporter-class

If you search the site for "export STEP", you will find several examples. However, the API commands have changed in newer versions of NX, so it will be dependent on your NX version.

I have a journal in NX10 that runs great. When I run the journal in NX1926 I get the following error.
'GetDriveMethod' is not a member of 'NXOpen.CAM.SurfaceContourBuilder'.

any help would be appreciated.

The NXOpen "what's changed" report states that the .GetDriveMethod has been converted to a property (.DriveMethod).

https://docs.plm.automation.siemens.com/docs/nx_dev/nx_report/en_US/Conf...

thank you
works perfectly

Dear all,
I am trying to export a list of the constraints that I have added to my assembly.
I need to understand if it is possible to do the following:
- get the name of components related to the constraint;
- position and orientation of entities involved in the constraint. For example, if I consider an axis of a cylinder aligned with another axis, I need this information.

Thank you

Pages