Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Module Module1
Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
If IsNothing(theSession.Parts.BaseWork) Then
'active part required
Return
End If
lw.Open()
Const undoMarkName As String = "chamfer along depth"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, undoMarkName)
Dim myEdge As Edge = Nothing
If SelectEdge("Select an edge", myEdge) = Selection.Response.Cancel Then
Return
End If
CreateChamfer(0.06, 15, myEdge)
lw.Close()
End Sub
Function SelectEdge(ByVal prompt As String, ByRef selEdge As Edge) As Selection.Response
Dim theUI As UI = UI.GetUI
Dim title As String = "Select an edge"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
Dim selectionMask_array(0) As Selection.MaskTriple
Dim selObj As TaggedObject = Nothing
With selectionMask_array(0)
.Type = UFConstants.UF_solid_type
.SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_EDGE
End With
Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
selEdge = selObj
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If
End Function
Private Function CreateChamfer(ByVal iDepth As Double, ByVal iAngle As Double, ByVal iEdge As Edge) As Features.Feature
Dim holeDirection As Direction = Nothing
Dim dirError As Boolean = True
Try
holeDirection = FindHoleDirection(iEdge)
dirError = False
Catch ex As Exception
lw.WriteLine("FindHoleDirection error: " & ex.Message)
End Try
Dim chamferBuilder1 As Features.ChamferBuilder
chamferBuilder1 = workPart.Features.CreateChamferBuilder(Nothing)
With chamferBuilder1
.Option = Features.ChamferBuilder.ChamferOption.OffsetAndAngle
.Method = Features.ChamferBuilder.OffsetMethod.EdgesAlongFaces
.ReverseOffsets = False
.FirstOffset = iDepth.ToString()
.Angle = iAngle.ToString()
.Tolerance = 0.001
End With
Dim scCollector1 As ScCollector
scCollector1 = workPart.ScCollectors.CreateCollector()
Dim nullEdge As Edge = Nothing
Dim edgeTangentRule1 As EdgeTangentRule
edgeTangentRule1 = workPart.ScRuleFactory.CreateRuleEdgeTangent(iEdge, nullEdge, False, 0.5, False, False)
Dim rules1(0) As SelectionIntentRule
rules1(0) = edgeTangentRule1
scCollector1.ReplaceRules(rules1, False)
chamferBuilder1.SmartCollector = scCollector1
Dim feature1 As Features.Feature
feature1 = chamferBuilder1.CommitFeature()
chamferBuilder1.Destroy()
If Not dirError Then
CheckChamfer(iDepth, iAngle, holeDirection, feature1)
End If
Return feature1
End Function
Private Sub FlipChamfer(ByVal theChamfer As Features.Chamfer)
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Edit Feature Parameters")
Dim chamferBuilder1 As Features.ChamferBuilder
chamferBuilder1 = workPart.Features.CreateChamferBuilder(theChamfer)
chamferBuilder1.ReverseOffsets = Not chamferBuilder1.ReverseOffsets
Dim feature1 As Features.Feature
feature1 = chamferBuilder1.CommitFeature()
chamferBuilder1.Destroy()
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)
theSession.Preferences.Modeling.UpdatePending = False
End Sub
Private Sub CheckChamfer(ByVal iDepth As Double, ByVal iAngle As Double, ByVal theDirection As Direction, ByVal theChamfer As Features.Chamfer)
Dim theAngularTolerance As Double
theUfSession.Modl.AskAngleTolerance(theAngularTolerance)
If Math.Abs(45 - iAngle) < theAngularTolerance Then
'chamfer is close to 45°, no need to flip chamfer
Return
End If
Dim depth1 As Double = MeasureChamferDepth(theChamfer, theDirection)
Dim diff1 As Double = Math.Abs(iDepth - depth1)
FlipChamfer(theChamfer)
Dim depth2 As Double = MeasureChamferDepth(theChamfer, theDirection)
Dim diff2 As Double = Math.Abs(iDepth - depth2)
If diff1 < diff2 Then
FlipChamfer(theChamfer)
End If
End Sub
Private Function FindHoleDirection(ByVal theEdge As Edge) As Direction
'finds the axis of a cylindrical hole
Dim holeFaceTags() As Tag = Nothing
theUfSession.Modl.AskEdgeFaces(theEdge.Tag, holeFaceTags)
'get faces connected to selected edge
Dim holeFaces As New List(Of Face)
For Each temp As Tag In holeFaceTags
holeFaces.Add(Utilities.NXObjectManager.Get(temp))
Next
Dim holeFace As Face
Dim holeFaceRadius As Double
Dim found As Boolean = False
Dim dirArray(2) As Double
For Each temp As Face In holeFaces
If temp.SolidFaceType = Face.FaceType.Cylindrical Then
Dim faceType As Integer
Dim pt(2) As Double
Dim dir(2) As Double
Dim box(5) As Double
Dim rad As Double
Dim radData As Double
Dim normDir As Integer
theUfSession.Modl.AskFaceData(temp.Tag, faceType, pt, dir, box, rad, radData, normDir)
If found Then
'not the first cylindrical face found, check to see if it is smaller than the first
If rad < holeFaceRadius Then
holeFace = temp
holeFaceRadius = rad
dirArray(0) = dir(0)
dirArray(1) = dir(1)
dirArray(2) = dir(2)
End If
Else
'first cylindrical face found, use it as hole face
holeFace = temp
dirArray(0) = dir(0)
dirArray(1) = dir(1)
dirArray(2) = dir(2)
holeFaceRadius = rad
found = True
End If
End If
Next
If Not found Then
Throw (New Exception("no cylindrical face found"))
Return Nothing
End If
Dim holeDir As Direction
Dim origin1 As Point3d = New Point3d(0.0, 0.0, 0.0)
Dim vector1 As Vector3d = New Vector3d(dirArray(0), dirArray(1), dirArray(2))
holeDir = workPart.Directions.CreateDirection(origin1, vector1, SmartObject.UpdateOption.AfterModeling)
Return holeDir
End Function
Private Function MeasureChamferDepth(ByVal theChamfer As Features.Chamfer, ByVal chamferDirection As Direction) As Double
Dim depth As Double
'if the chamfer feature creates more than 2 edges, this code will need to be improved
Dim chamferEdges() As Edge = theChamfer.GetEdges
Dim nullNXObject As NXObject = Nothing
Dim measureDistanceBuilder1 As MeasureDistanceBuilder
measureDistanceBuilder1 = workPart.MeasureManager.CreateMeasureDistanceBuilder(nullNXObject)
With measureDistanceBuilder1
.InfoWindow = False
.AnnotationMode = MeasureBuilder.AnnotationType.None
.Mtype = MeasureDistanceBuilder.MeasureType.Minimum
.ProjectionVector = chamferDirection
.Object1.Value = chamferEdges(0)
.Object2.Value = chamferEdges(1)
End With
Dim unit1 As Unit
If workPart.PartUnits = BasePart.Units.Inches Then
unit1 = workPart.UnitCollection.FindObject("Inch")
Else
unit1 = workPart.UnitCollection.FindObject("MilliMeter")
End If
Dim measureDistance1 As MeasureDistance
measureDistance1 = workPart.MeasureManager.NewDistance(unit1, chamferEdges(0), chamferEdges(1), chamferDirection, MeasureManager.ProjectionType.Minimum)
depth = measureDistance1.Value
measureDistance1.Dispose()
measureDistanceBuilder1.Destroy()
Return depth
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
