Hi I am trying to automate the ECE Radii check.For example I have to do a head impact study on car dashboard. The goal is where ever the head (generally a sphere of 165mm dia)touches the dashboard that face radius should be more than 3.5mm.
1. Now with the following code I am able to color the faces when it does not meet the radii requirement.In this code During radiinumber=1, I have some issues, I did create a work around which takes more time but runs just fine (Few faces when with body create radiinumber =1 but gives both u & v radius values, I have to create new face to measure the radius for these faces).
2. After Identify the red faces I have to do sphere check on the red faces, If they are not touched by sphere I don't have to worry about them. For this any ideas would be helpful. My thought is to run the sphere with touch constraints along all faces with collision detection on and highlight the faces which is not touched by sphere. But I wonder how much will be the running time when I run more than 100k faces.
Example: I have U-shaped part where the sphere is coming and touching from the top of U shape. Now I can ignore the bottom face of U which will never be touched by sphere since collision stopped the sphere in the top itself.
3. In catia the radius report shows the area in a face where it is lesser than the input (https://ww3.cad.de/foren/ubb/uploads/SmokieMcPot/F02.PNG), Is it any method we can do the same in NX also. where face have variable radius highlight only the area where the radii is lesser than the input value.
Option Strict Off
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Features
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Module RadiiCheckTool
Public theSession As Session = Session.GetSession()
Public ufs As UFSession = UFSession.GetUFSession()
Public theUISession As UI = UI.GetUI
Public lw As ListingWindow = theSession.ListingWindow
Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim displayPart As NXOpen.Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Sub Main()
Dim MyLayers As Layer.LayerManager = workPart.Layers
Dim RadiiNumber As Integer = Nothing
Dim RadiiValue(1) As Double
Dim Positions(5) As Double
Dim Params(3) As Double
Dim i As Integer = Nothing
Dim j As Integer = Nothing
Dim aposition(2) As Double
Dim junk3(2) As Double
Dim junk2(1) As Double
Dim junk1 As Double = Nothing
Dim parm1(1) As Double
Dim parm2(1) As Double
Dim n1(2) As Double
Dim n2(2) As Double
Dim isparallel As Integer = Nothing
Dim MinRadii1 As Integer = 5
Dim MinRadii2 As Integer = 3.5
Dim Minradii3 As Integer = 3.5
Dim firstleveltangentfaces As ArrayList = New ArrayList
Dim secondleveltangentfaces As ArrayList = New ArrayList
lw.Open()
For Each obj As DisplayableObject In theSession.Parts.Work.Bodies
If MyLayers.GetState(obj.Layer) < 2 Then
If obj.IsBlanked = False Then ' only check visible objects
If obj.GetType.ToString = "NXOpen.Body" Then ' only check object types of body
Dim MyBody As Body = CType(obj, Body)
'Change the default color of the Body
ApplyColorToSelectedItem(97, MyBody)
Dim MyFaces() As Face = MyBody.GetFaces() 'get all faces of the body
For i = 0 To MyFaces.Length - 1
Dim theedges() As Edge = MyFaces(i).GetEdges
Dim InputEdgeCount As Integer = Nothing
InputEdgeCount = theedges.Length
Dim ParallelCount As Integer = 0
Dim theedgefaces(1) As Face
Dim thesecondlevelfaces(1) As Face
For Each e1 As Edge In theedges
theedgefaces = e1.GetFaces
For Each f1 As Face In theedgefaces
If f1.Tag <> MyFaces(i).Tag Then
' check a point on the common edge for tangancy
ufs.Modl.AskCurveProps(e1.Tag, 0.5, aposition, junk3, junk3, junk3, junk1, junk1)
ufs.Modl.AskFaceParm(MyFaces(i).Tag, aposition, parm1, aposition)
ufs.Modl.AskFaceParm(f1.Tag, aposition, parm2, aposition)
ufs.Modl.AskFaceProps(MyFaces(i).Tag, parm1, aposition, junk3, junk3, junk3, junk3, n1, junk2)
ufs.Modl.AskFaceProps(f1.Tag, parm2, aposition, junk3, junk3, junk3, junk3, n2, junk2)
ufs.Vec3.IsParallel(n1, n2, 0.01, isparallel)
If Not isparallel = 1 Then
'Create edge curve and make it Red
Dim edgeArcTag As Tag
ufs.Modl.CreateCurveFromEdge(e1.Tag, edgeArcTag)
Dim MyCurve As TaggedObject = NXOpen.Utilities.NXObjectManager.Get(edgeArcTag)
ApplyColorToSelectedItem(150, MyCurve)
ChangeLineThickness(MyCurve)
End If
End If
Next
Next
ParallelCount = 0
ufs.Modl.AskFaceMinRadii(MyFaces(i).Tag, RadiiNumber, RadiiValue, Positions, Params)
If RadiiValue(0) < 0 Then
RadiiValue(0) = RadiiValue(0) * -1
End If
If RadiiValue(1) < 0 Then
RadiiValue(1) = RadiiValue(1) * -1
End If
RadiiValue(0) = Math.Round(RadiiValue(0), 1)
RadiiValue(1) = Math.Round(RadiiValue(1), 1)
If RadiiNumber = 0 Then
'Planar Face
ApplyColorToSelectedItem(108, MyFaces(i))
ElseIf RadiiNumber = 1 Then
'One radius face
Dim Radius1(1) As Double
MeasureOffsetFace(MyFaces(i), Radius1)
If Radius1(0) > MinRadii1 Or Radius1(1) > MinRadii1 Then
ApplyColorToSelectedItem(108, MyFaces(i))
ElseIf Radius1(0) > MinRadii2 And Radius1(0) < MinRadii1 Then
ApplyColorToSelectedItem(78, MyFaces(i))
ElseIf Radius1(1) > MinRadii2 And Radius1(1) < MinRadii1 Then
ApplyColorToSelectedItem(78, MyFaces(i))
ElseIf Radius1(0) > Minradii3 And Radius1(0) < MinRadii2 Then
ApplyColorToSelectedItem(117, MyFaces(i))
ElseIf Radius1(1) > Minradii3 And Radius1(1) < MinRadii2 Then
ApplyColorToSelectedItem(117, MyFaces(i))
Else
ApplyColorToSelectedItem(150, MyFaces(i))
End If
ElseIf RadiiNumber = 2 Then
'Two radius face
If RadiiValue(0) > MinRadii1 And RadiiValue(1) > MinRadii1 Then
ApplyColorToSelectedItem(108, MyFaces(i))
ElseIf RadiiValue(0) > MinRadii2 And RadiiValue(1) > MinRadii2 And RadiiValue(0) < MinRadii1 And RadiiValue(1) < MinRadii1 Then
ApplyColorToSelectedItem(78, MyFaces(i))
ElseIf RadiiValue(0) > Minradii3 And RadiiValue(1) > Minradii3 And RadiiValue(0) < MinRadii2 And RadiiValue(1) < MinRadii2 Then
ApplyColorToSelectedItem(117, MyFaces(i))
Else
ApplyColorToSelectedItem(150, MyFaces(i))
End If
End If
NextFace:
Next
End If
End If
End If
Next
End Sub
Public Sub ApplyColorToSelectedItem(ByRef ColorInput As Integer, ByRef RefObj As NXObject)
Dim DispModify As DisplayModification = Nothing
Dim ColObj(0) As DisplayableObject
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Edit Object Display")
DispModify = theSession.DisplayManager.NewDisplayModification()
DispModify.ApplyToAllFaces = True
DispModify.ApplyToOwningParts = False
DispModify.NewColor = ColorInput
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.One
ColObj(0) = RefObj
DispModify.Apply(ColObj)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
ColObj(0) = Nothing
DispModify.Dispose()
End Sub
Public Sub ChangeLineThickness(ByRef RefObj As NXObject)
Dim DispModify As DisplayModification = Nothing
Dim ColObj(0) As DisplayableObject
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Edit Object Display")
DispModify = theSession.DisplayManager.NewDisplayModification()
DispModify.ApplyToAllFaces = True
DispModify.ApplyToOwningParts = False
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.Nine
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.Thick
ColObj(0) = RefObj
DispModify.Apply(ColObj)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
ColObj(0) = Nothing
DispModify.Dispose()
End Sub
Public Function MeasureOffsetFace(ByRef MyFace As Face, ByVal Radius1() As Double)
Dim RadiiNumber As Integer = Nothing
Dim RadiiValue(1) As Double
Dim Positions(5) As Double
Dim Params(3) As Double
Dim MyFeature As NXOpen.Features.Feature = Nothing
Dim offsetSurfaceBuilder1 As NXOpen.Features.OffsetSurfaceBuilder = Nothing
offsetSurfaceBuilder1 = workPart.Features.CreateOffsetSurfaceBuilder(MyFeature)
offsetSurfaceBuilder1.Tolerance = 0.01
Dim scCollector1 As NXOpen.ScCollector = Nothing
scCollector1 = workPart.ScCollectors.CreateCollector()
Dim faces1(0) As NXOpen.Face
Dim face1 As NXOpen.Face = MyFace
faces1(0) = face1
Dim faceDumbRule1 As NXOpen.FaceDumbRule = Nothing
faceDumbRule1 = workPart.ScRuleFactory.CreateRuleFaceDumb(faces1)
Dim rules1(0) As NXOpen.SelectionIntentRule
rules1(0) = faceDumbRule1
scCollector1.ReplaceRules(rules1, False)
Dim faceSetOffset1 As NXOpen.GeometricUtilities.FaceSetOffset = Nothing
faceSetOffset1 = workPart.FaceSetOffsets.CreateFaceSet("0", scCollector1, False, 0)
offsetSurfaceBuilder1.FaceSets.Append(faceSetOffset1)
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = offsetSurfaceBuilder1.Commit()
offsetSurfaceBuilder1.Destroy()
Dim MyF As OffsetSurface = NXOpen.Utilities.NXObjectManager.Get(nXObject1.Tag)
Dim NewFacesList() As Face = MyF.GetFaces()
ufs.Modl.AskFaceMinRadii(NewFacesList(0).Tag, RadiiNumber, RadiiValue, Positions, Params)
If RadiiValue(0) < 0 Then
RadiiValue(0) = RadiiValue(0) * -1
End If
If RadiiValue(1) < 0 Then
RadiiValue(1) = RadiiValue(1) * -1
End If
Radius1(0) = Math.Round(RadiiValue(0), 1)
Radius1(1) = Math.Round(RadiiValue(1), 1)
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Delete")
theSession.UpdateManager.ClearErrorList()
Dim objects1(0) As NXOpen.NXObject
objects1(0) = MyF
Dim nErrs1 As Integer = Nothing
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
theSession.DeleteUndoMark(markId1, Nothing)
Return Radius1(1)
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
re: face radius
I've not had a chance to look over your code, but for question #3, NX has "face analysis - radius" (menu -> analysis -> shape -> radius). It has a number of options available, but it can produce output very similar to your screenshot.
Extract faces with result colors.
The option is really good. Since my output requires much data then this (I want to apply different colors to the face which doesn't meet minimum requirements). So this is what I achieved So far. There are lot of roadblocks and time consuming due to measurements. But my first goal is to get result out of It. After that I want to focus on fine tuning it. You can go through it and let me know if you have any suggestion.
1. Point cloud (Similar to matrix) will be created around Origin (0, 0, 0) to (0,250,250) with gap of 5.
2. Keep the Input body such a way that the When points projects in X direction they will be projected into body.
3. Project the points into input cad which radius check is being calculated.
4. Identify the faces where Sphere can touch based on projected points.
5. The remaining faces will get different color (Blue).
6. After identifying the faces, Face radius will be calculated. Based on type of check different color codes will be applied to the faces.
7. Issue faces will be identified by color code, these faces will be proceeded for sphere check.
8. On issue faces equidistant points will be created with 5 mm gap.
9. On every point sphere will be created normal to the issue face direction at that point.
10. If any sphere placed on point without interfering the Input cad, then face will remain as issue.
11. If all the sphere created on face have interference with input bodies they will be deleted and face will be identified in different color (Face have minimum radius issue but it will not be in contact with Sphere).
Option Strict Off
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Features
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Module Test
Public theSession As Session = Session.GetSession()
Public ufs As UFSession = UFSession.GetUFSession()
Public theUISession As UI = UI.GetUI
Public lw As ListingWindow = theSession.ListingWindow
Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim displayPart As NXOpen.Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Sub Main()
Dim MyBodyCol As List(Of Body) = New List(Of Body)
AskAllBodies(MyBodyCol)
ApplyColorToSelectedItem(134, MyBodyCol(0))
Dim MyFaces() As Face = MyBodyCol(0).GetFaces()
Dim ThePoint As New Point3d(0, 0, 0)
Dim TouchFaces As List(Of Face) = New List(Of Face)
CreateEquidistancePoints(ThePoint, MyFaces)
MsgBox("Points projected")
Dim MyRefPoint(2) As Double
Dim MyIntersectData As NXOpen.UF.UFCurve.IntersectInfo = Nothing
For Each MyP As Point In workPart.Points
CreateLine(MyP)
Next
'MsgBox("Lines created")
For Each MyF As Face In MyFaces
For Each MyL As Line In workPart.Lines
ufs.Curve.Intersect(MyL.Tag, MyF.Tag, MyRefPoint, MyIntersectData)
If MyIntersectData.type_of_intersection = 1 Then
Dim MyDistance As MeasureDistance = Nothing
Dim unit1 As Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), Unit)
MyDistance = workPart.MeasureManager.NewDistance(unit1, MeasureManager.MeasureType.Minimum, MyF, MyL)
If MyDistance.Value.ToString = 0 Then
TouchFaces.Add(MyF)
End If
End If
Next
Next
'For Each MyP As Point In workPart.Points
' For Each MyF As Face In MyFaces
' Dim MyDistance As MeasureDistance = Nothing
' Dim unit1 As Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), Unit)
' MyDistance = workPart.MeasureManager.NewDistance(unit1, MeasureManager.MeasureType.Minimum, MyF, MyP)
' If MyDistance.Value.ToString < 0.1 Then
' TouchFaces.Add(MyF)
' Exit For
' End If
' Next
'Next
Dim ResultFaces As List(Of Face) = New List(Of Face)
For Each temp As Face In TouchFaces
If Not ResultFaces.Contains(temp) Then
ResultFaces.Add(temp)
End If
Next
MsgBox("Touch faces identified")
For Each MyL As Line In workPart.Lines
theSession.UpdateManager.ClearErrorList()
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete group")
Dim objects1(0) As NXObject
objects1(0) = MyL
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)
Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
theSession.DeleteUndoMark(markId1, Nothing)
Next
MsgBox("Ref lines deleted")
MinimumRadiiCheck(ResultFaces)
Exit Sub
Dim IssueFaces As List(Of Face) = New List(Of Face)
For Each MyF As Face In MyFaces
If MyF.Color = "150" Then
IssueFaces.Add(MyF)
End If
Next
MsgBox("Issue faces Identified")
CreateEquidistancePoints(ThePoint, IssueFaces.ToArray)
For Each MyP As Point In workPart.Points
CreateLine(MyP)
Next
Dim LinesList As List(Of Line) = New List(Of Line)
For Each MyL As Line In workPart.Lines
LinesList.Add(MyL)
Next
MsgBox("Issue face lines created")
For Each MyF As Face In IssueFaces
For Each MyL As Line In LinesList
ufs.Curve.Intersect(MyL.Tag, MyF.Tag, MyRefPoint, MyIntersectData)
If MyIntersectData.type_of_intersection = 1 Then
Try
Dim SphereCenterLine As Line = Nothing
Dim MyPoint As Point = workPart.Points.CreatePoint(MyL.StartPoint)
CreateNormalLine(MyPoint, MyF, SphereCenterLine)
Dim SphereCenterPoint As Point = workPart.Points.CreatePoint(SphereCenterLine.EndPoint)
Dim RefSphere As Sphere = Nothing
CreateSphere(SphereCenterPoint, RefSphere)
Dim SphereFaces() As Face = Nothing
SphereFaces = RefSphere.GetFaces()
For Each RefFace As Face In MyFaces
Dim MyDistance1 As MeasureDistance = Nothing
Dim unit1 As Unit = CType(workPart.UnitCollection.FindObject("MilliMeter"), Unit)
MyDistance1 = workPart.MeasureManager.NewDistance(unit1, MeasureManager.MeasureType.Minimum, MyF, SphereFaces(0))
If MyDistance1.Value.ToString = 0 Then
theSession.UpdateManager.ClearErrorList()
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete group")
Dim objects1(0) As NXObject
objects1(0) = RefSphere
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)
Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
theSession.DeleteUndoMark(markId1, Nothing)
Exit For
End If
Next
Catch
lw.WriteLine("Faces with issues found")
ApplyColorToSelectedItem(75, MyF)
End Try
End If
Next
Next
End Sub
Public Sub ApplyColorToSelectedItem(ByRef ColorInput As Integer, ByRef RefObj As NXObject)
Dim DispModify As DisplayModification = Nothing
Dim ColObj(0) As DisplayableObject
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Edit Object Display")
DispModify = theSession.DisplayManager.NewDisplayModification()
DispModify.ApplyToAllFaces = True
DispModify.ApplyToOwningParts = False
DispModify.NewColor = ColorInput
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.One
ColObj(0) = RefObj
DispModify.Apply(ColObj)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
ColObj(0) = Nothing
DispModify.Dispose()
End Sub
Function AskAllBodies(ByVal thebodies As List(Of Body))
Dim thepart As Part = Nothing
thepart = theSession.Parts.Display
Try
Dim BodyTag As Tag = Tag.Null
Do
ufs.Obj.CycleObjsInPart(thepart.Tag, UFConstants.UF_solid_type, BodyTag)
If BodyTag = Tag.Null Then
Exit Do
End If
Dim theType As Integer, theSubtype As Integer
ufs.Obj.AskTypeAndSubtype(BodyTag, theType, theSubtype)
If theSubtype = UFConstants.UF_solid_body_subtype Then
thebodies.Add(Utilities.NXObjectManager.Get(BodyTag))
End If
Loop While True
Catch ex As NXException
lw.WriteLine(ex.ErrorCode & ex.Message)
End Try
Return thebodies
End Function
Sub CreateLine(ByVal InputPoint As Point)
'Set Undo Mark
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
'Create Builder
Dim MyLine As AssociativeLine = Nothing
Dim MyLineBuilder As AssociativeLineBuilder = Nothing
MyLineBuilder = workPart.BaseFeatures.CreateAssociativeLineBuilder(MyLine)
'Set Preferences
MyLineBuilder.StartPointOptions = NXOpen.Features.AssociativeLineBuilder.StartOption.Point
MyLineBuilder.EndPointOptions = NXOpen.Features.AssociativeLineBuilder.EndOption.AlongXc
MyLineBuilder.Limits.StartLimit.LimitOption = NXOpen.GeometricUtilities.CurveExtendData.LimitOptions.AtPoint
MyLineBuilder.Limits.EndLimit.LimitOption = NXOpen.GeometricUtilities.CurveExtendData.LimitOptions.Value
MyLineBuilder.Limits.EndLimit.Distance.RightHandSide = "0.25"
Dim point3 As NXOpen.Point3d = Nothing
theSession.SetUndoMarkName(markId1, "Line Dialog")
'Create Line
MyLineBuilder.StartPoint.Value = InputPoint
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = MyLineBuilder.Commit()
theSession.SetUndoMarkName(markId1, "Line")
MyLineBuilder.Destroy()
theSession.DeleteUndoMark(markId1, Nothing)
End Sub
Function CreateNormalLine(ByVal InputPoint As Point, ByVal InputFace As Face, ByRef OutLine As Line)
'Set Undo Mark
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
'Create Builder
Dim MyLine As AssociativeLine = Nothing
Dim MyLineBuilder As AssociativeLineBuilder = Nothing
MyLineBuilder = workPart.BaseFeatures.CreateAssociativeLineBuilder(MyLine)
'Set Preferences
MyLineBuilder.StartPointOptions = NXOpen.Features.AssociativeLineBuilder.StartOption.Point
MyLineBuilder.EndPointOptions = NXOpen.Features.AssociativeLineBuilder.EndOption.Normal
MyLineBuilder.Limits.StartLimit.LimitOption = NXOpen.GeometricUtilities.CurveExtendData.LimitOptions.AtPoint
MyLineBuilder.Limits.EndLimit.LimitOption = NXOpen.GeometricUtilities.CurveExtendData.LimitOptions.Value
MyLineBuilder.Limits.EndLimit.Distance.RightHandSide = "82.500001"
Dim point3 As NXOpen.Point3d = Nothing
theSession.SetUndoMarkName(markId1, "Line Dialog")
Dim faces1(0) As NXOpen.Face
faces1(0) = InputFace
Dim faceDumbRule1 As NXOpen.FaceDumbRule = Nothing
faceDumbRule1 = workPart.ScRuleFactory.CreateRuleFaceDumb(faces1)
Dim scCollector1 As NXOpen.ScCollector = Nothing
scCollector1 = workPart.ScCollectors.CreateCollector()
Dim rules1(0) As NXOpen.SelectionIntentRule
rules1(0) = faceDumbRule1
scCollector1.ReplaceRules(rules1, False)
Dim added1 As Boolean = Nothing
added1 = MyLineBuilder.LineEndNormal.Add(scCollector1)
'Create Line
MyLineBuilder.StartPoint.Value = InputPoint
Dim MyLineFeature As Features.AssociativeLine
MyLineFeature = MyLineBuilder.Commit
MyLineBuilder.Destroy()
'get entities created by the feature
Dim MyEntities() As NXObject
MyEntities = MyLineFeature.GetEntities()
OutLine = MyEntities(0)
theSession.DeleteUndoMark(markId1, Nothing)
Return OutLine
End Function
Sub CreateEquidistancePoints(ByVal InputPoint As Point3d, ByVal InputFaces() As Face)
Dim i As Integer = Nothing
Dim J As Integer = Nothing
Dim MyPoint As Point = Nothing
Dim MyP3D As Point3d = New Point3d
Try
'Set Undo mark
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
'Create Builder
Dim ProjectPoint As Feature = Nothing
Dim ProjectPointBuilder As NXOpen.Features.ProjectCurveBuilder = Nothing
ProjectPointBuilder = workPart.Features.CreateProjectCurveBuilder(ProjectPoint)
'Set tolerances and Projection Direction
Dim MyTol As Double = 0.01
ProjectPointBuilder.CurveFitData.Tolerance = 0.01
ProjectPointBuilder.CurveFitData.AngleTolerance = 0.1
ProjectPointBuilder.ProjectionDirectionMethod = NXOpen.Features.ProjectCurveBuilder.DirectionType.AlongVector
ProjectPointBuilder.AngleToProjectionVector.RightHandSide = "0"
ProjectPointBuilder.NearestPointOption = True
ProjectPointBuilder.InputCurvesOption.Associative = False
ProjectPointBuilder.InputCurvesOption.InputCurveOption = NXOpen.GeometricUtilities.CurveOptions.InputCurve.Delete
ProjectPointBuilder.SectionToProject.DistanceTolerance = 0.01
ProjectPointBuilder.SectionToProject.ChainingTolerance = 0.0095
ProjectPointBuilder.SectionToProject.AngleTolerance = 0.1
ProjectPointBuilder.SectionToProject.SetAllowedEntityTypes(NXOpen.Section.AllowTypes.OnlyPoints)
ProjectPointBuilder.SectionToProject.AllowSelfIntersection(True)
Dim origin1 As NXOpen.Point3d = New NXOpen.Point3d(0.0, 0.0, 0.0)
Dim vector1 As NXOpen.Vector3d = New NXOpen.Vector3d(1.0, 0.0, 0.0)
Dim direction1 As NXOpen.Direction = Nothing
direction1 = workPart.Directions.CreateDirection(origin1, vector1, NXOpen.SmartObject.UpdateOption.WithinModeling)
ProjectPointBuilder.ProjectionVector = direction1
'Set Input points and Face
For i = -250 To 0 Step 20
For J = 0 To 250 Step 20
MyP3D.X = InputPoint.X
MyP3D.Y = InputPoint.Y + i
MyP3D.Z = InputPoint.Z + J
MyPoint = workPart.Points.CreatePoint(MyP3D)
ProjectPointBuilder.SectionToProject.AddSmartPoint(MyPoint, MyTol)
Next
Next
MsgBox("Points created")
Dim faceDumbRule1 As NXOpen.FaceDumbRule = Nothing
faceDumbRule1 = workPart.ScRuleFactory.CreateRuleFaceDumb(InputFaces)
Dim scCollector1 As NXOpen.ScCollector = Nothing
scCollector1 = workPart.ScCollectors.CreateCollector()
Dim rules2(0) As NXOpen.SelectionIntentRule
rules2(0) = faceDumbRule1
scCollector1.ReplaceRules(rules2, False)
Dim added1 As Boolean = Nothing
added1 = ProjectPointBuilder.FaceToProjectTo.Add(scCollector1)
'Commit Feature
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = ProjectPointBuilder.Commit()
theSession.SetUndoMarkName(markId1, "Project Curve")
ProjectPointBuilder.Destroy()
theSession.DeleteUndoMark(markId1, Nothing)
Catch ex As NXException
'Unable to project the points or No Obejects to project the points
End Try
End Sub
Sub MinimumRadiiCheck(ByVal InputFaces As List(Of Face))
Dim RadiiNumber As Integer = Nothing
Dim RadiiValue(1) As Double
Dim Positions(5) As Double
Dim Params(3) As Double
Dim i As Integer = Nothing
Dim j As Integer = Nothing
Dim aposition(2) As Double
Dim junk3(2) As Double
Dim junk2(1) As Double
Dim junk1 As Double = Nothing
Dim parm1(1) As Double
Dim parm2(1) As Double
Dim n1(2) As Double
Dim n2(2) As Double
Dim isparallel As Integer = Nothing
Dim MinRadii1 As Integer = 5
Dim MinRadii2 As Integer = 3.5
Dim Minradii3 As Integer = 3.5
Dim firstleveltangentfaces As ArrayList = New ArrayList
Dim secondleveltangentfaces As ArrayList = New ArrayList
lw.Open()
For i = 0 To InputFaces.Count - 1
Dim theedges() As Edge = InputFaces(i).GetEdges
Dim InputEdgeCount As Integer = Nothing
InputEdgeCount = theedges.Length
Dim ParallelCount As Integer = 0
Dim theedgefaces(1) As Face
Dim thesecondlevelfaces(1) As Face
'For Each e1 As Edge In theedges
' theedgefaces = e1.GetFaces
' For Each f1 As Face In theedgefaces
' If f1.Tag <> InputFaces(i).Tag Then
' ' check a point on the common edge for tangancy
' ufs.Modl.AskCurveProps(e1.Tag, 0.5, aposition, junk3, junk3, junk3, junk1, junk1)
' ufs.Modl.AskFaceParm(InputFaces(i).Tag, aposition, parm1, aposition)
' ufs.Modl.AskFaceParm(f1.Tag, aposition, parm2, aposition)
' ufs.Modl.AskFaceProps(InputFaces(i).Tag, parm1, aposition, junk3, junk3, junk3, junk3, n1, junk2)
' ufs.Modl.AskFaceProps(f1.Tag, parm2, aposition, junk3, junk3, junk3, junk3, n2, junk2)
' ufs.Vec3.IsParallel(n1, n2, 0.01, isparallel)
' If Not isparallel = 1 Then
' 'Create edge curve and make it Red
' Dim edgeArcTag As Tag
' ufs.Modl.CreateCurveFromEdge(e1.Tag, edgeArcTag)
' Dim MyCurve As TaggedObject = NXOpen.Utilities.NXObjectManager.Get(edgeArcTag)
' ApplyColorToSelectedItem(150, MyCurve)
' ChangeLineThickness(MyCurve)
' End If
' End If
' Next
'Next
ParallelCount = 0
ufs.Modl.AskFaceMinRadii(InputFaces(i).Tag, RadiiNumber, RadiiValue, Positions, Params)
If RadiiValue(0) < 0 Then
RadiiValue(0) = RadiiValue(0) * -1
End If
If RadiiValue(1) < 0 Then
RadiiValue(1) = RadiiValue(1) * -1
End If
RadiiValue(0) = Math.Round(RadiiValue(0), 1)
RadiiValue(1) = Math.Round(RadiiValue(1), 1)
If RadiiNumber = 0 Then
'Planar Face
ApplyColorToSelectedItem(108, InputFaces(i))
ElseIf RadiiNumber = 1 Then
'One radius face
Dim Radius1(1) As Double
MeasureOffsetFace(InputFaces(i), Radius1)
If Radius1(0) > MinRadii1 Or Radius1(1) > MinRadii1 Then
ApplyColorToSelectedItem(108, InputFaces(i))
ElseIf Radius1(0) > MinRadii2 And Radius1(0) < MinRadii1 Then
ApplyColorToSelectedItem(78, InputFaces(i))
ElseIf Radius1(1) > MinRadii2 And Radius1(1) < MinRadii1 Then
ApplyColorToSelectedItem(78, InputFaces(i))
ElseIf Radius1(0) > Minradii3 And Radius1(0) < MinRadii2 Then
ApplyColorToSelectedItem(117, InputFaces(i))
ElseIf Radius1(1) > Minradii3 And Radius1(1) < MinRadii2 Then
ApplyColorToSelectedItem(117, InputFaces(i))
Else
ApplyColorToSelectedItem(150, InputFaces(i))
End If
ElseIf RadiiNumber = 2 Then
'Two radius face
If RadiiValue(0) > MinRadii1 And RadiiValue(1) > MinRadii1 Then
ApplyColorToSelectedItem(108, InputFaces(i))
ElseIf RadiiValue(0) > MinRadii2 And RadiiValue(1) > MinRadii2 And RadiiValue(0) < MinRadii1 And RadiiValue(1) < MinRadii1 Then
ApplyColorToSelectedItem(78, InputFaces(i))
ElseIf RadiiValue(0) > Minradii3 And RadiiValue(1) > Minradii3 And RadiiValue(0) < MinRadii2 And RadiiValue(1) < MinRadii2 Then
ApplyColorToSelectedItem(117, InputFaces(i))
Else
ApplyColorToSelectedItem(150, InputFaces(i))
End If
End If
Next
End Sub
Public Sub ChangeLineThickness(ByRef RefObj As NXObject)
Dim DispModify As DisplayModification = Nothing
Dim ColObj(0) As DisplayableObject
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Edit Object Display")
DispModify = theSession.DisplayManager.NewDisplayModification()
DispModify.ApplyToAllFaces = True
DispModify.ApplyToOwningParts = False
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.Nine
DispModify.NewWidth = NXOpen.DisplayableObject.ObjectWidth.Thick
ColObj(0) = RefObj
DispModify.Apply(ColObj)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
ColObj(0) = Nothing
DispModify.Dispose()
End Sub
Public Function MeasureOffsetFace(ByRef MyFace As Face, ByVal Radius1() As Double)
Dim RadiiNumber As Integer = Nothing
Dim RadiiValue(1) As Double
Dim Positions(5) As Double
Dim Params(3) As Double
Dim MyFeature As NXOpen.Features.Feature = Nothing
Dim offsetSurfaceBuilder1 As NXOpen.Features.OffsetSurfaceBuilder = Nothing
offsetSurfaceBuilder1 = workPart.Features.CreateOffsetSurfaceBuilder(MyFeature)
offsetSurfaceBuilder1.Tolerance = 0.01
Dim scCollector1 As NXOpen.ScCollector = Nothing
scCollector1 = workPart.ScCollectors.CreateCollector()
Dim faces1(0) As NXOpen.Face
Dim face1 As NXOpen.Face = MyFace
faces1(0) = face1
Dim faceDumbRule1 As NXOpen.FaceDumbRule = Nothing
faceDumbRule1 = workPart.ScRuleFactory.CreateRuleFaceDumb(faces1)
Dim rules1(0) As NXOpen.SelectionIntentRule
rules1(0) = faceDumbRule1
scCollector1.ReplaceRules(rules1, False)
Dim faceSetOffset1 As NXOpen.GeometricUtilities.FaceSetOffset = Nothing
faceSetOffset1 = workPart.FaceSetOffsets.CreateFaceSet("0", scCollector1, False, 0)
offsetSurfaceBuilder1.FaceSets.Append(faceSetOffset1)
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = offsetSurfaceBuilder1.Commit()
offsetSurfaceBuilder1.Destroy()
Dim MyF As OffsetSurface = NXOpen.Utilities.NXObjectManager.Get(nXObject1.Tag)
Dim NewFacesList() As Face = MyF.GetFaces()
ufs.Modl.AskFaceMinRadii(NewFacesList(0).Tag, RadiiNumber, RadiiValue, Positions, Params)
If RadiiValue(0) < 0 Then
RadiiValue(0) = RadiiValue(0) * -1
End If
If RadiiValue(1) < 0 Then
RadiiValue(1) = RadiiValue(1) * -1
End If
Radius1(0) = Math.Round(RadiiValue(0), 1)
Radius1(1) = Math.Round(RadiiValue(1), 1)
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Delete")
theSession.UpdateManager.ClearErrorList()
Dim objects1(0) As NXOpen.NXObject
objects1(0) = MyF
Dim nErrs1 As Integer = Nothing
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)
Dim nErrs2 As Integer = Nothing
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
theSession.DeleteUndoMark(markId1, Nothing)
Return Radius1(1)
End Function
Function CreateSphere(ByVal InputPoint As Point, ByRef OutSphere As Sphere)
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
Dim NewSphere As Sphere = Nothing
Dim MySphereBuilder As NXOpen.Features.SphereBuilder = Nothing
MySphereBuilder = workPart.Features.CreateSphereBuilder(NewSphere)
MySphereBuilder.Diameter.RightHandSide = "165"
MySphereBuilder.BooleanOption.Type = NXOpen.GeometricUtilities.BooleanOperation.BooleanType.Create
MySphereBuilder.CenterPoint = InputPoint
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = MySphereBuilder.Commit()
OutSphere = NXOpen.Utilities.NXObjectManager.Get(nXObject1.Tag)
theSession.SetUndoMarkName(markId1, "Sphere")
MySphereBuilder.Destroy()
Return OutSphere
End Function
End Module
Regards,
Joe