Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Assemblies
Public class PList1
Public Property Part_Name As String
Public Property Link_Name As String
Public Property Parent_Name As String
Public Property Link_Status As String
Public Sub New(ByVal PartN As String, ByVal ParentN As String, ByVal LinkN As String, ByVal LinkS As String)
'Public Sub New(ByVal PartN As String, ByVal LinkN As String, ByVal ParentN As String, ByVal LinkS As String)
'Public Sub New(ByVal PartN As String, ByVal ParentN As String)
Part_Name = PartN
Link_Name = LinkN
Parent_Name = ParentN
Link_Status = LinkS
End Sub
End Class
Module wave_links_part_only
Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession
Dim workPart As Part = theSession.Parts.Work
Dim dispPart As Part = theSession.Parts.Display
Dim PartList1 as New list (of PList1) ()
Dim List1 as New List (of String)
'Dim Lista2 as New List (of String)
Dim List3 as New List (of String)
Dim List4 as New List (of String)
Dim List5 as New List (of String)
Dim List6 as New List (of String)
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
If IsNothing(theSession.Parts.Work) Then
'active part required
Return
End If
'Dim workPart As Part = theSession.Parts.Work
lw.Open()
Dim searched_string as string
searched_string = Inputbox("Please enter searched string. Minimum 3 chars.", "Enter searched string.", " ")
If searched_string = " " Then
MsgBox("You have to enter searched string.", vbOKOnly, "Error")
Exit Sub
ElseIf searched_string = "" Then
Exit Sub
End If
If Len(searched_string) < 3 Then
Msgbox("You have to enter minimum 3 chars to continue.", vbOKOnly, "Error")
Exit sub
End If
Try
Dim c As ComponentAssembly = dispPart.ComponentAssembly
if not IsNothing(c.RootComponent) then
ReportComponentChildren(c.RootComponent, 0)
ReportComponentChildren1(c.RootComponent, 0)
else
lw.WriteLine("Part has no components")
end if
Catch e As Exception
theSession.ListingWindow.WriteLine("Failed: " & e.ToString)
End Try
if Not IsNothing(Partlist1) AndAlso Partlist1.Count > 0 Then
'Partlist1.sort(Function(x, y) x.part_name.CompareTo(y.Part_name))
partlist1.sort(AddressOf Comparer)
lw.writeline(" ")
lw.writeline("*************************************************************")
lw.writeline("* Parts with searched links: *")
lw.writeline("*************************************************************")
'lw.writeline(" ")
lw.writeline("-------------------------------------------------------------")
lw.writeline("| Part name | Parent name | Link name | Link Status |")
lw.writeline("-------------------------------------------------------------")
lw.writeline(" ")
Dim Prt1 as String = nothing
Dim Prt2 as String = Nothing
for each Part_ as PList1 in Partlist1
if Part_.Parent_Name.Contains(searched_string) then
Prt1 = Part_.Part_Name
If Prt2 = nothing then
lw.writeline(Part_.Part_Name & " | " & Part_.Parent_Name & " | " & Part_.Link_Name & " | " & Part_.Link_Status)
elseif Prt2 <> Prt1
lw.writeline(" ")
lw.writeline(Part_.Part_Name & " | " & Part_.Parent_Name & " | " & Part_.Link_Name & " | " & Part_.Link_Status)
else
lw.writeline(Part_.Part_Name & " | " & Part_.Parent_Name & " | " & Part_.Link_Name & " | " & Part_.Link_Status)
end if
Prt2 = Prt1
end if
next
end if
lw.Close()
End Sub
'*****************************************************************************************
' Empty run
'*****************************************************************************************
Sub reportComponentChildren( ByVal comp As Component, ByVal indent As Integer)
Dim workPart As Part = theSession.Parts.Work
Dim dispPart As Part = theSession.Parts.Display
For Each child As Component In comp.GetChildren()
Dim MyPart As Part = child.Prototype.OwningPart
Try
if child.IsSuppressed = true then
'lw.writeline(" Error: " & child.DisplayName & ".prt" & " -> " & "Part is closed")
list4.add(child.name)
Continue for
end if
Catch e1 As Exception
theSession.ListingWindow.WriteLine("Failed: " & e1.ToString)
end try
If LoadComponent(child) Then
Else
'component could not be loaded
End If
reportComponentChildren(child, indent+1)
Next
End Sub
'**********************************************************
' Looking for Links
'**********************************************************
Sub reportComponentChildren1( ByVal comp As Component, ByVal indent As Integer)
Dim workPart As Part = theSession.Parts.Work
Dim dispPart As Part = theSession.Parts.Display
For Each child As Component In comp.GetChildren()
Dim MyPart As Part = child.Prototype.OwningPart
Try
if child.IsSuppressed = true then
Continue for
end if
Catch e11 As Exception
theSession.ListingWindow.WriteLine("Failed: " & e11.ToString)
end try
If LoadComponent(child) Then
Const undoMarkName As String = "report wave links"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, undoMarkName)
if not list3.contains(MyPart.leaf) then
list3.add(MyPart.leaf)
Dim theWaveLinks As New WaveLinkReport(mypart)
ReportWaveLinks(theWaveLinks, False, mypart)
End if
Else
'component could not be loaded
End If
reportComponentChildren1(child, indent + 1)
Next
End Sub
Sub ReportWaveLinks(ByVal someLinkReport As WaveLinkReport, ByVal suppressNull As Boolean, ByVal mypart As Part)
If suppressNull And someLinkReport.WaveFeatures.Count = 0 Then
Return
End If
If someLinkReport.WaveFeatures.Count = 0 Then
Return
End If
lw.WriteLine("")
lw.WriteLine(mypart.leaf & ":")
lw.WriteLine("")
Dim status as String
For Each temp As WaveFeature In someLinkReport.WaveFeatures
For Each parent As String In temp.WaveParents
If temp.IsBroken Then
lw.WriteLine(" " & parent & " -> " & temp.Feature.GetFeatureName & " -> Link is broken! ")
status = "Broken"
Else
lw.WriteLine(" " & parent & " -> " & temp.Feature.GetFeatureName)
Status = "Alive"
End If
Partlist1.add(new PList1(MyPart.name, Parent, temp.Feature.GetFeatureName, status))
Next
'lw.WriteLine("")
Next
lw.WriteLine("")
End Sub
'**********************************************************
' Function loading components
'**********************************************************
Private Function LoadComponent(ByVal theComponent As Component) As Boolean
Dim thePart As Part = theComponent.Prototype.OwningPart
Dim partName As String = ""
Dim refsetName As String = ""
Dim instanceName As String = ""
Dim origin(2) As Double
Dim csysMatrix(8) As Double
Dim transform(3, 3) As Double
Try
If thePart.IsFullyLoaded Then
'component is fully loaded
Else
'component is partially loaded
End If
Return True
Catch ex As NullReferenceException
'component is not loaded
Try
theUfSession.Assem.AskComponentData(theComponent.Tag, partName, refsetName, instanceName, origin, csysMatrix, transform)
Dim theLoadStatus As PartLoadStatus
theSession.Parts.Open(partName, theLoadStatus)
If theLoadStatus.NumberUnloadedParts > 0 Then
Dim allReadOnly As Boolean = True
For i As Integer = 0 To theLoadStatus.NumberUnloadedParts - 1
If theLoadStatus.GetStatus(i) = 641058 Then
'read-only warning, file loaded ok
Else
if not list5.contains(partname) then
'641044: file not found
lw.WriteLine("File not found: -> " & partName)
list5.add(partName)
allReadOnly = False
else
'lw.WriteLine(" File not found: -> " & partName)
allReadOnly = False
end if
End If
Next
If allReadOnly Then
Return True
Else
'warnings other than read-only...
Return False
End If
Else
Return True
End If
Catch ex2 As NXException
if ex2.message = "File not found" then
if not list6.contains(partname) then
lw.WriteLine("Error: File not found" & " -> " & partname)
list6.add(partName)
else
'lw.WriteLine(" Error: " & partname & " -> " & "File not found")
end if
else
lw.WriteLine("Error: " & partname & " -> " & ex2.Message)
end if
Return False
End Try
Catch ex As NXException
'unexpected error
lw.WriteLine("error: " & ex.Message)
Return False
End Try
End Function
'**********************************************************
' Compare component function
'**********************************************************
Private Function Comparer(ByVal x As Plist1, ByVal y As Plist1) As Integer
Dim result As Integer = x.Part_name.CompareTo(y.Part_name)
If result = 0 Then
'result = x.Link_name.CompareTo(y.Link_name)
result = x.Parent_Name.CompareTo(y.Parent_name)
If result = 0 Then
result = x.Link_name.CompareTo(y.Link_name)
'result = x.Parent_Name.CompareTo(y.Parent_name)
end if
End If
Return result
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
Public Class WaveLinkReport
Private cSession As Session = Session.GetSession
Private cUfSession As UFSession = UFSession.GetUFSession
Private cPart As Part
Public Property Part() As Part
Get
Return cPart
End Get
Set(ByVal value As Part)
cPart = value
Me.ExamineFeatures()
Me.FindUniqueParents()
End Set
End Property
Private cWaveFeatures As New List(Of WaveFeature)
Public ReadOnly Property WaveFeatures() As List(Of WaveFeature)
Get
Return cWaveFeatures
End Get
End Property
Private cUniqueWaveParents As New List(Of String)
Public ReadOnly Property UniqueWaveParents() As List(Of String)
Get
Return cUniqueWaveParents
End Get
End Property
Public ReadOnly Property NumberOfBrokenLinks() As Integer
Get
Return cBrokenLinks.Count
End Get
End Property
Private cBrokenLinks As New List(Of WaveFeature)
Public ReadOnly Property BrokenLinks() As List(Of WaveFeature)
Get
Return cBrokenLinks
End Get
End Property
Public Sub New(ByVal thePart As Part)
Me.Part = thePart
End Sub
Private Sub ExamineFeatures()
For Each tempFeature As Features.Feature In cPart.Features
If IsWaveFeature(tempFeature) Then
Dim newWaveFeature As New WaveFeature(tempFeature)
cWaveFeatures.Add(newWaveFeature)
End If
Next
End Sub
Private Function IsWaveFeature(ByVal theFeature As Features.Feature) As Boolean
Dim wave2 As Boolean = False
'check for wave linked sketch
'linked sketches can be internal to another feature (such as an extrude)
'so check for a WaveSketch feature before running the .IsInternal check
If TypeOf (theFeature) Is NXOpen.Features.WaveSketch Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'some features create links within the part file (extract face, instance geometry, etc)
'if the feature .IsInternal, odds are good it links to something in this part file
'and not an external file
If theFeature.IsInternal Then
wave2 = Me.IsWaveFeature2(theFeature)
'skip features such as "mirror geometry" or "instance geometry" that do not link to another part
Return False
End If
'check for wave linked datum
If TypeOf (theFeature) Is NXOpen.Features.WaveDatum Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'check for wave linked point
If TypeOf (theFeature) Is NXOpen.Features.WavePoint Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'check for wave linked curve
If TypeOf (theFeature) Is NXOpen.Features.CompositeCurve AndAlso theFeature.FeatureType = "LINKED_CURVE" Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'check for wave linked face
If TypeOf (theFeature) Is NXOpen.Features.ExtractFace AndAlso theFeature.FeatureType = "LINKED_FACE" Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'check for wave linked region
If TypeOf (theFeature) Is NXOpen.Features.ExtractFace AndAlso theFeature.FeatureType = "LINKED_REGION" Then
Return True
End If
'check for wave linked body
If TypeOf (theFeature) Is NXOpen.Features.ExtractFace AndAlso theFeature.FeatureType = "LINKED_BODY" Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'check for wave linked mirror body
If TypeOf (theFeature) Is NXOpen.Features.MirrorBody AndAlso theFeature.FeatureType = "LINKED_MIRROR" Then
Return True
End If
'check for wave linked routing object
If TypeOf (theFeature) Is NXOpen.Features.WaveRouting Then
wave2 = Me.IsWaveFeature2(theFeature)
Return True
End If
'none of the above...
Return False
End Function
Private Function IsWaveFeature2(ByVal theFeature As Features.Feature) As Boolean
Dim lw As ListingWindow = cSession.ListingWindow
lw.Open()
'lw.WriteLine("feature: " & theFeature.GetFeatureName)
'lw.WriteLine("owning part: " & theFeature.OwningPart.Leaf)
Dim theSourceEntityTag As NXOpen.Tag = NXOpen.Tag.Null
Dim owningSourcePartTag As Tag = NXOpen.Tag.Null
Dim allowLoad As Boolean = True
Dim owningPartName As String = ""
Try
'.AskLinkSource throws error if link is internal to the part being processed
'(simple hole, mirror geometry)
cUfSession.Wave.AskLinkSource(theFeature.Tag, allowLoad, theSourceEntityTag)
cUfSession.Obj.AskOwningPart(theSourceEntityTag, owningSourcePartTag)
cUfSession.Part.AskPartName(owningSourcePartTag, owningPartName)
Catch ex As NXException
If ex.ErrorCode = 1105004 Then
'first parameter passed in was invalid (not linked to external geometry?)
'lw.WriteLine("NX exception: " & ex.ErrorCode & ", " & ex.Message)
'lw.WriteLine("")
Return False
Else
'lw.WriteLine("NX exception: " & ex.ErrorCode & ", " & ex.Message)
'lw.WriteLine("")
Return False
End If
Catch ex As Exception
lw.WriteLine("Exception: " & ex.Message)
lw.WriteLine("")
End Try
'lw.WriteLine("source part: " & owningPartName)
'lw.WriteLine("current part: " & theFeature.OwningPart.FullPath)
'lw.WriteLine("")
If owningPartName.ToUpper = theFeature.OwningPart.FullPath.ToUpper Then
'lw.WriteLine("IsWaveFeature2: False")
'lw.WriteLine("")
Return False
Else
'lw.WriteLine("IsWaveFeature2: True")
'lw.WriteLine("")
Return True
End If
'lw.Close()
End Function
Private Sub FindUniqueParents()
For Each tempWF As WaveFeature In Me.WaveFeatures
If tempWF.IsBroken Then
cBrokenLinks.Add(tempWF)
End If
For Each tempString As String In tempWF.WaveParents
If Not cUniqueWaveParents.Contains(tempString) Then
cUniqueWaveParents.Add(tempString)
End If
Next
Next
cUniqueWaveParents.Sort()
End Sub
End Class
Public Class WaveFeature
Private cSession As Session = Session.GetSession
Private cUfSession As UFSession = UFSession.GetUFSession
Private cFeature As Features.Feature
Public Property Feature() As Features.Feature
Get
Return cFeature
End Get
Set(ByVal value As Features.Feature)
cFeature = value
Me.ExamineFeature()
End Set
End Property
Private cParents As New List(Of String)
Public ReadOnly Property WaveParents() As List(Of String)
Get
Return cParents
End Get
End Property
Private cIsBroken As Boolean = True 'assume link is broken
Public ReadOnly Property IsBroken() As Boolean
Get
Return cIsBroken
End Get
End Property
Private cIsAccepted As Boolean = False 'assume it is not broken intentionally
Public ReadOnly Property IsAccepted() As Boolean
Get
Return cIsAccepted
End Get
End Property
Public Sub New(ByVal theFeature As Features.Feature)
Me.Feature = theFeature
End Sub
Private Sub ExamineFeature()
Dim sourcePart As String = ""
Dim sourceId As String = ""
cUfSession.Wave.IsLinkBroken(cFeature.Tag, cIsBroken)
If cIsBroken Then
cIsBroken = True
cUfSession.Wave.AskBrokenLinkSourcePart(cFeature.Tag, sourcePart, sourceId)
cParents.Add(sourcePart)
cUfSession.Wave.AskLinkAcceptBroken(cFeature.Tag, cIsAccepted)
Else
'link NOT broken
'ref: nx_api4930
Dim theInfo As UFWave.LinkedFeatureInfo
cUfSession.Wave.AskLinkedFeatureInfo(cFeature.Tag, theInfo)
Dim sources() As String = theInfo.source_part_name.Split(",")
'wave feature may have multiple parents; e.g. the mirror body
' mirror plane may be owned by a file other than the file that owns the body
For Each prtSource As String In sources
cParents.Add(prtSource)
Next
End If
End Sub
End Class
