Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations GregLocock on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

need help in journal

Status
Not open for further replies.

Forzindi

Mechanical
Jan 17, 2018
12
hello all,
I have used one vb code for layer assigning which is provide by you guys, it is working fine, but the sketches are assigned to go on layers 21, but they are only showing in 21 and actually they are going to 41.
please help to correct this. Here is the code.


Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.Features
Imports NXOpen.UF
Imports NXOpen.Utilities

Module layermove

Sub Main()

Dim s As Session = Session.GetSession()
Dim lw As ListingWindow = s.ListingWindow
Dim ufs As UFSession = UFSession.GetUFSession()
Dim workPart As Part = s.Parts.Work

Dim theSession As Session = Session.GetSession()

Dim pointcol As PointCollection = workPart.Points
Dim linecol As LineCollection = workPart.Lines
Dim arccol As ArcCollection = workPart.Arcs
Dim splinecol As SplineCollection = workPart.Splines

Dim objArray(0) As DisplayableObject

Dim pointslayer As Integer = 62
Dim linelayer As Integer = 41
Dim arclayer As Integer = 41
Dim coniclayer As Integer = 41
Dim splinelayer As Integer = 41
Dim csyslayer As Integer = 61
Dim daxislayer As Integer = 61
Dim dplanelayer As Integer = 62
Dim bodylayer As Integer = 1
Dim sheetlayer As Integer = 11
Const sketchLayer As Integer = 21
Const Layno As Integer = 61

Dim displayModification1 As DisplayModification
displayModification1 = theSession.DisplayManager.NewDisplayModification()

displayModification1.NewLayer = sketchLayer

displayModification1.Apply(workPart.Sketches.ToArray)

displayModification1.Dispose()


If pointcol.ToArray().Length > 0 Then
For Each pt As Point In pointcol
ufs.Obj.SetLayer(pt.Tag, pointslayer)
Next
End If

If linecol.ToArray().Length > 0 Then
For Each ln As Line In linecol
ufs.Obj.SetLayer(ln.Tag, linelayer)
ln.Layer = linelayer
Next
End If

If arccol.ToArray().Length > 0 Then
For Each arc1 As Arc In arccol
ufs.Obj.SetLayer(arc1.Tag, arclayer)
Next
End If

If splinecol.ToArray().Length > 0 Then
For Each sp As Spline In splinecol
ufs.Obj.SetLayer(sp.Tag, splinelayer)
Next
End If

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, Layno)
ufs.Obj.SetLayer(csys_tag, Layno)

For Each thisObj As NXOpen.Tag In daxes
ufs.Obj.SetLayer(thisObj, Layno)
Next

For Each thisObj As NXOpen.Tag In dplanes
ufs.Obj.SetLayer(thisObj, Layno)
Next

End If
Next



For Each obj As Body In workPart.Bodies
objArray(0) = obj
If obj.IsSheetBody Then
workPart.Layers.MoveDisplayableObjects(sheetlayer, objArray)
ElseIf obj.IsSolidBody Then
workPart.Layers.MoveDisplayableObjects(bodylayer, objArray)
End If
Next

For Each obj As DisplayableObject In workPart.Datums
If TypeOf obj Is DatumPlane Then
objArray(0) = obj
workPart.Layers.MoveDisplayableObjects(dplanelayer, objArray)
End If

If TypeOf obj Is DatumAxis Then
objArray(0) = obj
workPart.Layers.MoveDisplayableObjects(daxislayer, objArray)
End If
Next

Dim coniccol(-1) As Tag
Dim conictype As Integer = 6
Dim conictag As Tag = Tag.Null
Dim count As Integer = 0

ufs.Obj.CycleObjsInPart(workPart.Tag, conictype, conictag)
While conictag <> Tag.Null
ReDim Preserve coniccol(count)
coniccol(count) = conictag
count += 1
ufs.Obj.CycleObjsInPart(workPart.Tag, conictype, conictag)
End While


If coniccol.Length > 0 Then
For i As Integer = 0 To coniccol.Length - 1
ufs.Obj.SetLayer(coniccol(i), coniclayer)
Next
End If

Dim csyscol(-1) As Tag
Dim csystype As Integer = 45

Dim csystag As NXOpen.Tag = Tag.Null
count = 0

ufs.Obj.CycleObjsInPart(workPart.Tag, csystype, csystag)
While csystag <> Tag.Null
ReDim Preserve csyscol(count)
csyscol(count) = csystag
count += 1
ufs.Obj.CycleObjsInPart(workPart.Tag, csystype, csystag)
End While
If csyscol.Length > 0 Then
For i As Integer = 0 To csyscol.Length - 1
ufs.Obj.SetLayer(csyscol(i), csyslayer)
Next
End If

End Sub


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


 
Replies continue below

Recommended for you

Two suggestions for you to try:
[ol 1]
[li]Move the sketches AFTER moving the curves. IIRC, sketch curves will move with the sketches.[/li]
[li]When iterating through the curve objects, use the .AskObjectFeat method to determine which feature owns the curve; if a sketch owns the curve, don't move it to a new layer.[/li]
[/ol]

One of the above should work to get what you want. I don't think you will need to implement both. Suggestion #1 is pretty easy to try out.

www.nxjournaling.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor