Option Strict Off
Imports System
Imports System.Windows.Forms
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Assemblies
Module NXJournal
Public theSession As Session = Session.GetSession()
Public theUFSession As UFSession = UFSession.GetUFSession()
Public lw As ListingWindow = theSession.ListingWindow
Dim workPart As Part = theSession.Parts.Work
Dim dispPart As Part = theSession.Parts.Display
Sub Main()
lw.Open()
Try
Dim c As ComponentAssembly = dispPart.ComponentAssembly
IfNot IsNothing(c.RootComponent)Then
ForEach child As Component In c.RootComponent.GetChildren()
child.SetAttribute("LINK", "N")
Next
EndIf
Catch e As Exception
theSession.ListingWindow.WriteLine("Failed: "& e.ToString)
EndTry
makeAllCompsEntirePart()
loadAllRoutingControlPointsToArray_ControlPoints1()
For i AsInteger=0To(ControlPoints1.length-1)
componentOfRCP(ControlPoints1(i))
Next
lw.WriteLine("!!****************************************************")
lw.WriteLine("!! For help contact Carlo Tony Daristotile LINKEDIN.")
lw.WriteLine("!* <a href="mailto:cdaristotile@lear.com"> </a> / <a href="mailto:carlo.daristotile@gmail.com"> </a>")
lw.WriteLine("!!****************************************************")
lw.Close()
EndSub
'***************************************************************************
'**************************************************************************
' function componentOfRCP(ControlPoint1 as NXOpen.Routing.ControlPoint) as string
'
' REQUIREMENTS
' - ALL COMPONENTS ENTIRE PART
' - ALL COMPONENTS FULLY LOADED
'**************************************************************************
'**************************************************************************
Function componentOfRCP(ByVal ControlPoint1 As NXOpen.Routing.ControlPoint)AsString
componentOfRCP = ControlPoint1.name
ControlPoint1.unblank()
Dim rcpTag As Tag = ControlPoint1.tag
Dim numOfPorts AsInteger
Dim portTags()As Tag
Try
'INPUT = ROUTING CONTROL POINT , OUTPUT = PORTS
theUFSession.Route.AskRcpPorts(rcpTag, numOfPorts, portTags)
ForEach portTag As tag In portTags
Dim port_occ_tag1 As tag
Try
'INPUT = EXTRACT PORT ON ROUTING , OUTPUT = FIXPORT/MUTLIPORT OF COMPONENT
theUFSession.Route.AskPortOccOfPort(portTag, port_occ_tag1)
If port_occ_tag1 <> tag.NullThen
Dim part_occ_Tag As Tag
Try
'INPUT = FIXPORT/MUTLIPORT OF COMPONENT , OUTPUT = COMPONENT
theUFSession.Route.AskPortPartOcc(port_occ_tag1, part_occ_Tag)
If part_occ_Tag <> tag.NullThen
Dim TaggedObject1 As TaggedObject
TaggedObject1 = Utilities.NXObjectManager.Get(part_occ_Tag)
IfNot TaggedObject1 IsNothingThen
If TaggedObject1.gettype.tostring="NXOpen.Assemblies.Component"Then
Dim component1 As NXOpen.Assemblies.Component= TaggedObject1
componentOfRCP = component1.name
component1.SetAttribute("LINK", "YES")
EndIf
EndIf
EndIf
Catch exPoint3 As exception
EndTry
EndIf
Catch exPoint2 As exception
EndTry
Next portTag
Catch exPoint1 As exception
EndTry
Erase portTags 'free memory
EndFunction
'**************************************************************************
'**********************************************************
Dim ControlPointCollection1 As NXOpen.Routing.ControlPointCollection
Dim ControlPoints1()As NXOpen.Routing.ControlPoint
Sub loadAllRoutingControlPointsToArray_ControlPoints1()
' ----------------------------------------------
'load control points to array ControlPoints1()
' ----------------------------------------------
REM ControlPointCollection1 = workPart.RouteManager.ControlPoints
ControlPointCollection1 = dispPart.RouteManager.ControlPoints
ControlPoints1 = ControlPointCollection1.ToArray()
EndSub
'**********************************************************
'******************************************
Sub makeAllCompsEntirePart()
'--------------------------------------------
'make all comps Entire Part
'--------------------------------------------
'REQUIREMENT
'comps DEFINED
'--------------------------------------------
Try
Dim comps()As component = dispPart.ComponentAssembly.RootComponent.getchildren()
Dim errorList2 As ErrorList
errorList2 = workPart.ComponentAssembly.ReplaceReferenceSetInOwners("Entire Part", comps)
'errorList2 = workPart.ComponentAssembly.ReplaceReferenceSetInOwners("PART", comps)
errorList2.Dispose()
Catch ex_EntirePart As exception
MessageBox.Show("Replace all REFERENCE SETS of component assembly to ENTIRE PART."& VBLF & ex_EntirePart.Message)
lw.writeline("Replace all REFERENCE SETS of component assembly to ENTIRE PART."& VBLF)
EndTry
EndSub
'******************************************
'**************************************************************************
PublicFunction GetUnloadOption(ByVal dummy AsString)AsInteger
'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
EndFunction
End Module