Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.Features
Imports NXOpen.Utilities
Imports NXOpen.UF
Module NXJournal
Sub Main (ByVal args() As String)
Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim displayPart As NXOpen.Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
lw.open
Dim DatumLayer As Integer = 60
Dim CsysLayer as Integer = 65
Dim SketchLayer as Integer = 70
Dim CurveLayer as Integer = 75
Dim PointLayer as Integer = 80
for each MyPoint as Point in WorkPart.Points
Dim featTag As Tag = Tag.Null
Dim myFeature As Features.Feature
ufs.Modl.AskObjectFeat(myPoint.Tag, featTag)
If featTag = Tag.Null Then
'point is unused
'lw.WriteLine("point is unused")
MyPoint.Layer = PointLayer
MyPoint.RedisplayObject
Else
myFeature = Utilities.NXObjectManager.Get(featTag)
'lw.WriteLine("used by: " & myFeature.GetFeatureName)
dim FeatName as string = myFeature.GetFeatureName
if FeatName.contains("SKETCH") then
myPoint.Layer = SketchLayer
myPoint.RedisplayObject
elseif FeatName.contains("DATUM_CSYS") then
myPoint.Layer = CsysLayer
myPoint.RedisplayObject
else
myPoint.Layer = PointLayer
myPoint.RedisplayObject
end if
End If
next
For Each myFeature As Feature In workPart.Features
If TypeOf (myFeature) Is DatumCsys Then
'uncomment the following If block to skip internal features
If myFeature.IsInternal Then
'Continue For
End If
Dim csys_tag As Tag
Dim origin_tag As Tag
Dim daxes As Tag()
Dim dplanes As Tag()
ufs.Modl.AskDatumCsysComponents(myFeature.Tag, csys_tag, origin_tag, daxes, dplanes)
ufs.Obj.SetLayer(origin_tag, CsysLayer)
ufs.Obj.SetLayer(csys_tag, CsysLayer)
For Each thisObj As NXOpen.Tag In daxes
ufs.Obj.SetLayer(thisObj, CsysLayer)
Next
For Each thisObj As NXOpen.Tag In dplanes
ufs.Obj.SetLayer(thisObj, CsysLayer)
Next
ElseIf TypeOf (myFeature) Is DatumPlaneFeature Then
Dim myDatum as Features.DatumPlaneFeature = myFeature
myDatum.DatumPlane.Layer = DatumLayer
myDatum.DatumPlane.RedisplayObject
End If
Next
for each myCurve as Curve in WorkPart.Curves
Dim featTag As Tag = Tag.Null
Dim myFeature As Features.Feature
ufs.Modl.AskObjectFeat(myCurve.Tag, featTag)
If featTag = Tag.Null Then
'curve is unused
'lw.WriteLine("curve is unused")
myCurve.Layer = CurveLayer
myCurve.RedisplayObject
Else
myFeature = Utilities.NXObjectManager.Get(featTag)
'lw.WriteLine("used by: " & myFeature.GetFeatureName)
dim FeatName as string = myFeature.GetFeatureName
'lw.writeline(featName)
if FeatName.contains("SKETCH") then
myCurve.Layer = SketchLayer
myCurve.RedisplayObject
else
myCurve.Layer = CurveLayer
myCurve.RedisplayObject
end if
End If
next
For Each MySketch As Sketch In workPart.Sketches
'lw.WriteLine(mySketch.Name)
mySketch.Layer = SketchLayer
mySketch.RedisplayObject
Next
Dim stateArray1(0) As NXOpen.Layer.StateInfo
stateArray1(0) = New NXOpen.Layer.StateInfo(60, NXOpen.Layer.State.Hidden)
workPart.Layers.ChangeStates(stateArray1, False)
Dim stateArray2(0) As NXOpen.Layer.StateInfo
stateArray2(0) = New NXOpen.Layer.StateInfo(65, NXOpen.Layer.State.Hidden)
workPart.Layers.ChangeStates(stateArray2, False)
Dim stateArray3(0) As NXOpen.Layer.StateInfo
stateArray3(0) = New NXOpen.Layer.StateInfo(70, NXOpen.Layer.State.Hidden)
workPart.Layers.ChangeStates(stateArray3, False)
Dim stateArray4(0) As NXOpen.Layer.StateInfo
stateArray4(0) = New NXOpen.Layer.StateInfo(75, NXOpen.Layer.State.Hidden)
workPart.Layers.ChangeStates(stateArray4, False)
Dim stateArray5(0) As NXOpen.Layer.StateInfo
stateArray5(0) = New NXOpen.Layer.StateInfo(80, NXOpen.Layer.State.Hidden)
workPart.Layers.ChangeStates(stateArray5, False)
lw.close
End Sub
End Module