' NX 1946
' Journal created by pfbs04 on Fri Oct  1 09:53:55 2021 Mitteleuropäische Sommerzeit

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

Module NXJournal
Sub Main()

' ----------------------------------------------
'Festlegung das Die Anwender ausgewählte Skizze "sketch1" ist
' ----------------------------------------------
Dim sketch1 As Sketch = SelectSketch()
If sketch1 Is Nothing Then
Return
End If
   
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
' ----------------------------------------------
'   Menu: Insert->Design Features->Extrude...
' ----------------------------------------------
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")

Dim section1 As Section
section1 = workPart.Sections.CreateSection(0.00095, 0.001, 0.5)

Dim nullFeatures_Feature As Features.Feature = Nothing

Dim extrudeBuilder1 As Features.ExtrudeBuilder
extrudeBuilder1 = workPart.Features.CreateExtrudeBuilder(nullFeatures_Feature)

extrudeBuilder1.Section = section1

Dim limits1 As GeometricUtilities.Limits
limits1 = extrudeBuilder1.Limits

Dim linearLimits1 As GeometricUtilities.LinearLimits = CType(limits1, GeometricUtilities.LinearLimits)

Dim extend2 As GeometricUtilities.Extend
extend2 = linearLimits1.EndExtend

Dim featureOptions2 As GeometricUtilities.FeatureOptions
featureOptions2 = extrudeBuilder1.FeatureOptions
' -----------------------------------------------------------------------
'festlegung der Laenge des Extrudes durch Anwender Voreingestellt auf -28
' -----------------------------------------------------------------------
extend2.Value.RightHandSide = (NXInputBox.GetInputString("Set the End Limit: ", _
                                                    "Extrude Limit", _
                                                    "-28"))
' -----------------------------------------------------------------------
'Einstellung das der Extrude ein Sheet Body wird
' -----------------------------------------------------------------------
extrudeBuilder1.FeatureOptions.BodyType = NXOpen.GeometricUtilities.FeatureOptions.BodyStyle.Sheet

theSession.SetUndoMarkName(markId1, "Extrude")

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

theSession.UndoToMark(markId2, Nothing)

Dim features1(0) As Features.Feature
features1(0) = sketch1.Feature

Dim curveFeatureRule1 As CurveFeatureRule
curveFeatureRule1 = workPart.ScRuleFactory.CreateRuleCurveFeature(features1)

section1.AllowSelfIntersection(False)

Dim rules1(0) As SelectionIntentRule
rules1(0) = curveFeatureRule1

Dim geoms() As NXObject = sketch1.GetAllGeometry()
Dim nXObject1 As NXObject = geoms(0)      
Dim nullNXObject As NXObject = Nothing

Dim helpPoint1 As Point3d = New Point3d(4.0, 1.07416298997847, 1.75440985394924)

section1.AddToSection(rules1, nXObject1, nullNXObject, nullNXObject, helpPoint1, Section.Mode.Create)       
theSession.DeleteUndoMark(markId2, Nothing)

Dim direction2 As Direction
direction2 = workPart.Directions.CreateDirection(sketch1, Sense.Forward, SmartObject.UpdateOption.WithinModeling)

extrudeBuilder1.Direction = direction2

Dim markId3 As Session.UndoMarkId
markId3 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Extrude")

Dim exceptionThrown as Boolean = false
Dim feature1 As Features.Feature
Try
feature1 = extrudeBuilder1.CommitFeature()	
feature1.SetName("WEDM_HOLE") 'Benennung im Part Navigator des Features

'Extrude auf Layer legen
Dim theBodies As New List(Of Body)
For Each tempFeat As Features.Feature In theSession.Parts.Work.Features
If Not TypeOf (tempFeat) Is Features.Extrude Then 'Überspringt die Features die kein Extrude sind
Continue For
End If
If Left(tempFeat.Name, 9) = "WEDM_HOLE" Then 'die Extrude Feature die so heissen werden ausgewählt, die Zahl gibt an nach wievielen Stellen gesucht wird
Dim tempExtrude As Features.Extrude = tempFeat 'Hier werden diese Bodies in eine Temp Liste gelegt
theBodies.AddRange(tempExtrude.GetBodies) 'Hier werden Die Bodies übergeben wird benötigt für Move to Layer
End If
Next

'Move to layer
Const ExtLayer As Integer = 10
Dim displayModification1 As DisplayModification = theSession.DisplayManager.NewDisplayModification() 
With displayModification1
.NewLayer = ExtLayer
.Apply(theBodies.ToArray)
.Dispose()
End With	
Catch ex As Exception
exceptionThrown = True	
extrudeBuilder1.Destroy()
section1.Destroy()
theSession.UndoToMark(markId1, Nothing)
theSession.DeleteUndoMark(markId1, Nothing)			
UI.GetUI().NXMessageBox.Show("Quick Extrude", NXMessageBox.DialogType.Error, ex.ToString)
End Try		
if exceptionThrown <> true then
extrudeBuilder1.Destroy()		
theSession.DeleteUndoMark(markId3, Nothing)
End if
'---------------------------------------------------
'Layer 10 einblenden
'---------------------------------------------------
Dim stateArray1(0) As NXOpen.Layer.StateInfo
stateArray1(0) = New NXOpen.Layer.StateInfo(10, NXOpen.Layer.State.Selectable)
workPart.Layers.ChangeStates(stateArray1, False)

End Sub

'ab hier Auswahl für Skizze
Public Function SelectSketch() As Sketch

Dim ui As UI = ui.GetUI
Dim message As String = "Select sketch"
Dim title As String = "Select Sketch"

Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
Dim keepHighlighted As Boolean = False
Dim includeFeatures As Boolean = True

Dim selectionAction As Selection.SelectionAction = _
Selection.SelectionAction.ClearAndEnableSpecific

Dim selectionMask_array(10) As Selection.MaskTriple
With selectionMask_array(0)
.Type = UFConstants.UF_sketch_type
.Subtype = 0
.SolidBodySubtype = 0
End With

Dim selectedObject As TaggedObject = Nothing
Dim cursor As Point3d

ui.SelectionManager.SelectTaggedObject(message, title, scope, _
                                selectionAction, includeFeatures, _
                                keepHighlighted, selectionMask_array, _
                                selectedObject, cursor)

Dim sketch As Sketch = CType(selectedObject, Sketch)

If sketch Is Nothing Then
			Return Nothing
End If


Return sketch

End Function

End Module