naikss
/
vs
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
visual studio codes
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
3 Commits
2 Branches
0 Tags
476 KiB
 
Branch: naikss-patch-1
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'naikss-patch-1'
${ noResults }
vs/backup.vb

1468 lines
55 KiB
Raw Permalink Blame History

Imports System
Imports NXOpen
Imports NXOpenUI
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports System.Threading
Imports System.Threading.Tasks
Imports NXOpen.Assemblies
Imports Excel = Microsoft.Office.Interop.Excel
Module featureIdentification1
Public ufs As UFSession = UFSession.GetUFSession
Public thesession As Session = Session.GetSession
Public lw As ListingWindow = thesession.ListingWindow
Public workpart As Part = thesession.Parts.Work
Public wp = workpart
Public theUI As UI = UI.GetUI
Public arr As New List(Of String)
Public basePart1 As NXOpen.BasePart = Nothing
Public partLoadStatus1 As NXOpen.PartLoadStatus = Nothing
Public partstouse1(0) As NXOpen.BasePart
Const xlDown As Long = -4121
Const xlRight As Long = -4161
Public app As New Excel.Application()
Public workBooks As Excel.Workbooks = app.Workbooks
Public workBook As Excel.Workbook = app.Workbooks.Add()
Public sheet As Excel.Worksheet = workBook.ActiveSheet
Public cells As Excel.Range = sheet.Cells
Public cell_index = 2
Sub Main()
'Dim thevectorselection As vectorselection = Nothing
Dim dispPart As Part = thesession.Parts.Display
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = thesession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
Try
lw.Open()
lw.WriteLine("working")
Dim green As Integer = 101
Dim blue As Integer = 175
Dim pink As Integer = 150
Dim grey As Integer = 170
Dim brown As Integer = 190
Dim red As Integer = 186
Dim yellow As Integer = 6
load_tool("D:\tool1.prt")
ufs.Ui.SetStatus("Tools loaded from library")
Dim c As ComponentAssembly = dispPart.ComponentAssembly
'to process the work part rather than the display part, comment the previous line and uncomment the following line
'Dim c As ComponentAssembly = workPart.ComponentAssembly
ufs.Ui.SetStatus("creating tool access paths")
If Not IsNothing(c.RootComponent) Then
lw.WriteLine("Assembly: " & c.RootComponent.DisplayName)
'lw.WriteLine(" + Active Arrangement: " & c.ActiveArrangement.Name)
cycle_through_components(c.RootComponent, 0)
Else
lw.WriteLine("Part has no components")
End If
For Each r As String In arr
lw.WriteLine(r)
Next
cells(1, 1).value() = "PART NO"
cells(1, 2).value() = "DESCRIPTION"
cells(1, 3).value() = "BELONGING ASSEMBLY"
cells(1, 4).value() = "COORDINATES"
cells(1, 5).value() = "STANDARD(Y/N?)"
cells(1, 6).value() = "THREAD"
cells(1, 7).value() = "LENGTH"
cells(1, 8).value() = "BOLT/NUT TYPE"
workBook.SaveAs("D:\tool_access.xlsx")
workBook.Save()
workBook.Close()
app.Quit()
ufs.Ui.SetStatus("end")
thesession.SetUndoMarkName(markId1, " ")
Catch ex As Exception
lw.WriteLine("error" & ex.ToString)
End Try
End Sub
Function load_tool(t_path As String)
thesession.PdmSession.SetNativeMode(True, False)
basePart1 = thesession.Parts.OpenBase(t_path, partLoadStatus1)
partLoadStatus1.Dispose()
thesession.PdmSession.SetNativeMode(False, False)
Dim part1 As NXOpen.Part = CType(basePart1, NXOpen.Part)
partstouse1(0) = part1
End Function
Function add_tool(point6 As Point3d, orientation1 As NXOpen.Matrix3x3, c As String)
'################## COMPONENT BUILDER
Dim addComponentBuilder1 As NXOpen.Assemblies.AddComponentBuilder = Nothing
addComponentBuilder1 = workpart.AssemblyManager.CreateAddComponentBuilder()
'################## COMPONENT POSITIONER
Dim componentPositioner1 As NXOpen.Positioning.ComponentPositioner = Nothing
componentPositioner1 = workpart.ComponentAssembly.Positioner
componentPositioner1.ClearNetwork()
Dim arrangement1 As NXOpen.Assemblies.Arrangement = CType(workpart.ComponentAssembly.Arrangements.FindObject("Arrangement 1"), NXOpen.Assemblies.Arrangement)
componentPositioner1.PrimaryArrangement = arrangement1
componentPositioner1.BeginAssemblyConstraints()
Dim allowInterpartPositioning1 As Boolean = Nothing
allowInterpartPositioning1 = thesession.Preferences.Assemblies.InterpartPositioning
'Dim nullNXOpen_Unit As NXOpen.Unit = Nothing
'################## UNIT DEFINATION
Dim unit1 As NXOpen.Unit = CType(workpart.UnitCollection.FindObject("MilliMeter"), NXOpen.Unit)
Dim unit2 As NXOpen.Unit = CType(workpart.UnitCollection.FindObject("Degrees"), NXOpen.Unit)
'################## COMPONENT NETWOK
Dim network1 As NXOpen.Positioning.Network = Nothing
network1 = componentPositioner1.EstablishNetwork()
Dim componentNetwork1 As NXOpen.Positioning.ComponentNetwork = CType(network1, NXOpen.Positioning.ComponentNetwork)
componentNetwork1.MoveObjectsState = True
Dim nullNXOpen_Assemblies_Component As NXOpen.Assemblies.Component = Nothing
componentNetwork1.DisplayComponent = nullNXOpen_Assemblies_Component
componentNetwork1.MoveObjectsState = True
Dim markId2 As NXOpen.Session.UndoMarkId = Nothing
markId2 = thesession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Assembly Constraints Update")
Dim nullNXOpen_Assemblies_ProductInterface_InterfaceObject As NXOpen.Assemblies.ProductInterface.InterfaceObject = Nothing
'#####################################################################################################################################################
addComponentBuilder1.ReferenceSet = "Use Model"
addComponentBuilder1.Layer = -1
addComponentBuilder1.SetPartsToAdd(partstouse1)
'#####################################################################################################################################################
Dim markId3 As NXOpen.Session.UndoMarkId = Nothing
markId3 = thesession.SetUndoMark(NXOpen.Session.MarkVisibility.Invisible, "Start")
thesession.SetUndoMarkName(markId3, "Point")
workpart.MeasureManager.SetPartTransientModification()
workpart.MeasureManager.ClearPartTransientModification()
thesession.DeleteUndoMark(markId3, Nothing)
'#####################################################################################################################################################
'#####################################################################################################################################################
addComponentBuilder1.SetInitialLocationAndOrientation(point6, orientation1)
'#####################################################################################################################################################
componentNetwork1.Solve()
componentPositioner1.ClearNetwork()
Dim nErrs1 As Integer = Nothing
nErrs1 = thesession.UpdateManager.AddToDeleteList(componentNetwork1)
Dim nErrs2 As Integer = Nothing
nErrs2 = thesession.UpdateManager.DoUpdate(markId2)
componentPositioner1.EndAssemblyConstraints()
Dim logicalobjects1() As NXOpen.PDM.LogicalObject
addComponentBuilder1.GetLogicalObjectsHavingUnassignedRequiredAttributes(logicalobjects1)
Dim t = "TOOL1" + c
lw.WriteLine(t)
addComponentBuilder1.ComponentName = t
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = addComponentBuilder1.Commit()
Dim errorList1 As NXOpen.ErrorList = Nothing
errorList1 = addComponentBuilder1.GetOperationFailures()
errorList1.Dispose()
'
addComponentBuilder1.Destroy()
Dim nullNXOpen_Assemblies_Arrangement As NXOpen.Assemblies.Arrangement = Nothing
componentPositioner1.PrimaryArrangement = nullNXOpen_Assemblies_Arrangement
thesession.DeleteUndoMark(markId2, Nothing)
thesession.CleanUpFacetedFacesAndEdges()
End Function
Function cycle_through_components(ByVal comp As Component, ByVal indent As Integer)
Dim c As String
Dim y1 As String = Nothing
Dim thread As String = Nothing
Dim btype As String = Nothing
For Each child As Component In comp.GetChildren()
c = child.DisplayName.ToString
If Not child.ReferenceSet.ToString = "Empty" Then
lw.WriteLine(New String(" ", indent * 2) & child.DisplayName())
If child.GetUserAttribute("CATEGORY", NXObject.AttributeType.String, -1).StringValue = "HW (Hardware includes nuts,washers)" Then
lw.WriteLine("hardware")
If Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("WASHER") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("DOWEL") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CLAMP") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CIRCLIP") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("PIN") And child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("INSTALL") Then
lw.WriteLine(child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue)
If Not arr.Contains(child.DisplayName.ToString) Then
arr.Add(child.DisplayName.ToString)
arr.Add((child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue))
End If
lw.WriteLine("added")
Dim ref1 As NXOpen.Point3d = New NXOpen.Point3d(0, 0, 0)
Dim ref2 As NXOpen.Matrix3x3 = Nothing
child.GetPosition(ref1, ref2)
lw.WriteLine(ref1.ToString)
lw.WriteLine(ref2.ToString)
add_tool(ref1, ref2, c)
If child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("NUT") Then
btype = "FLANGED NUT"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("BUTTON") Or child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("SOCKET") Then
btype = "ALEN"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("BOLT") Then
btype = "HEX BOLT"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("SCREW") Then
btype = "SCREW"
Else
btype = "NA"
End If
Dim z As String = child.DisplayName.ToString
If z(0) = "K" Then
y1 = "Y"
thread = "{}{}".Format(z(4) + z(5))
Else
y1 = "N"
If child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M5") Then
thread = 5
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M6") Then
thread = 6
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M8") Then
thread = 8
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M10") Then
thread = 10
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M12") Then
thread = 12
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M14") Then
thread = 14
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M16") Then
thread = 16
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M18") Then
thread = 18
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("M24") Then
thread = 24
Else
thread = "NA"
End If
End If
cells(cell_index, 1).value() = child.DisplayName.ToString
cells(cell_index, 2).value() = child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue
cells(cell_index, 3).value() = child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue
cells(cell_index, 4).value() = ref1.ToString
cells(cell_index, 5).value() = y1
cells(cell_index, 6).value() = thread
cells(cell_index, 7).value() = btype
cell_index += 1
End If
End If
If child.GetChildren.Length <> 0 Then
lw.WriteLine(New String(" ", indent * 2) &
"* subassembly with " &
child.GetChildren.Length & " components")
lw.WriteLine(New String(" ", indent * 2) &
" + Active Arrangement: " &
child.OwningPart.ComponentAssembly.ActiveArrangement.Name)
If child.GetUserAttribute("CATEGORY", NXObject.AttributeType.String, -1).StringValue = "HW (Hardware includes nuts,washers)" Then
lw.WriteFullline("HW (Hardware includes nuts,washers)")
lw.WriteLine("hardware")
arr.Add(child.DisplayName.ToString)
If Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("WASHER") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("DOWEL") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CLAMP") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CIRCLIP") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("PIN") And child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("INSTALL") Then
lw.WriteLine(child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue)
lw.WriteLine(child.ReferenceSet.ToString)
If Not arr.Contains(child.DisplayName.ToString) Then
arr.Add(child.DisplayName.ToString)
arr.Add((child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue))
End If
lw.WriteLine(child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue(0))
lw.WriteLine("added")
Dim ref1 As NXOpen.Point3d = New NXOpen.Point3d(0, 0, 0)
Dim ref2 As NXOpen.Matrix3x3 = Nothing
child.GetPosition(ref1, ref2)
lw.WriteLine(ref1.ToString)
lw.WriteLine(ref2.ToString)
add_tool(ref1, ref2, c)
Dim z As String = child.DisplayName.ToString
If z(0) = "K" Then
y1 = "Y"
thread = "{}{}".Format(z(4) + z(5))
Else
y1 = "N"
thread = "NA"
End If
If child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("NUT") Then
btype = "FLANGED NUT"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("BUTTON") Or child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("SOCKET") Then
btype = "ALEN"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("BOLT") Then
btype = "HEX BOLT"
ElseIf child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("SCREW") Then
btype = "SCREW"
Else
btype = "NA"
End If
cells(cell_index, 1).value() = child.DisplayName.ToString
cells(cell_index, 2).value() = child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue
cells(cell_index, 3).value() = child.Parent.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue
cells(cell_index, 4).value() = ref1.ToString
cells(cell_index, 5).value() = y1
cells(cell_index, 6).value() = thread
cells(cell_index, 7).value() = btype
cell_index += 1
End If
End If
Else
'If child.GetUserAttribute("CATEGORY", NXObject.AttributeType.String, -1).StringValue = "HW (Hardware includes nuts,washers)" And Not arr.Contains(child.DisplayName.ToString) Then
' lw.WriteFullline("HW (Hardware includes nuts,washers)")
' lw.WriteLine("hardware")
' arr.Add(child.DisplayName.ToString)
' If Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("WASHER") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("DOWEL") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CLAMP") And Not child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue.Contains("CIRCLIP") Then
' arr.Add(child.DisplayName.ToString)
' lw.WriteLine(child.GetUserAttribute("DB_PART_NAME", NXObject.AttributeType.String, -1).StringValue)
' lw.WriteLine("added")
' End If
'End If
End If
End If
cycle_through_components(child, indent + 1)
Next
End Function
Function ProjectCurves(ByRef toProj() As Curve, ByRef projOnto() As Face, ByVal directionCurve As Line) As Curve()
Dim markId1 As Session.UndoMarkId
markId1 = thesession.SetUndoMark(Session.MarkVisibility.Visible, "Project Curve")
Dim nullFeatures_Feature As Features.Feature = Nothing
Dim projectCurveBuilder1 As Features.ProjectCurveBuilder
projectCurveBuilder1 = wp.Features.CreateProjectCurveBuilder(nullFeatures_Feature)
projectCurveBuilder1.ProjectionDirectionMethod = Features.ProjectCurveBuilder.DirectionType.AlongVector
Dim direction1 As Direction
direction1 = wp.Directions.CreateDirection(directionCurve, Sense.Forward, SmartObject.UpdateOption.WithinModeling)
projectCurveBuilder1.ProjectionVector = direction1
projectCurveBuilder1.ProjectionOption = Features.ProjectCurveBuilder.ProjectionOptionType.ProjectBothSides
projectCurveBuilder1.BridgedGapSize = 0.0393700787401575
projectCurveBuilder1.Tolerance = 0.001
projectCurveBuilder1.AngleToProjectionVector.RightHandSide = "0"
projectCurveBuilder1.BridgedGapSize = 0.0393700787401575
projectCurveBuilder1.SectionToProject.DistanceTolerance = 0.001
projectCurveBuilder1.SectionToProject.ChainingTolerance = 0.00095
projectCurveBuilder1.SectionToProject.SetAllowedEntityTypes(Section.AllowTypes.CurvesAndPoints)
Dim curveDumbRule1 As CurveDumbRule
curveDumbRule1 = wp.ScRuleFactory.CreateRuleCurveDumb(toProj)
projectCurveBuilder1.SectionToProject.AllowSelfIntersection(True)
Dim rules1(0) As SelectionIntentRule
rules1(0) = curveDumbRule1
Dim nullNXObject As NXObject = Nothing
Dim helpPoint1 As Point3d = New Point3d(0.0, 0.0, 0.0)
projectCurveBuilder1.SectionToProject.AddToSection(rules1, nullNXObject, nullNXObject, nullNXObject, helpPoint1, Section.Mode.Create, False)
Dim scCollector1 As ScCollector
scCollector1 = wp.ScCollectors.CreateCollector()
Dim faceDumbRule1 As FaceDumbRule
faceDumbRule1 = wp.ScRuleFactory.CreateRuleFaceDumb(projOnto)
Dim rules2(0) As SelectionIntentRule
rules2(0) = faceDumbRule1
scCollector1.ReplaceRules(rules2, False)
Dim added1 As Boolean
added1 = projectCurveBuilder1.FaceToProjectTo.Add(scCollector1)
Dim nXObject1 As Features.ProjectCurve
nXObject1 = projectCurveBuilder1.Commit()
projectCurveBuilder1.Destroy()
Dim curveList As ArrayList = New ArrayList
For Each aCurve As NXObject In nXObject1.GetEntities()
curveList.Add(aCurve)
Next
Return curveList.ToArray(GetType(Curve))
End Function
Function SelectCurves(ByRef prompt As String) As Curve()
Dim selectionMask(3) As Selection.MaskTriple
With selectionMask(0)
.Type = UFConstants.UF_line_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With selectionMask(1)
.Type = UFConstants.UF_circle_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With selectionMask(2)
.Type = UFConstants.UF_conic_type
.Subtype = 0
.SolidBodySubtype = 0
End With
With selectionMask(3)
.Type = UFConstants.UF_spline_type
.Subtype = 0
.SolidBodySubtype = 0
End With
Dim selected() As NXObject = Nothing
NXOpen.UI.GetUI.SelectionManager.SelectObjects("Select Curves", prompt, Selection.SelectionScope.WorkPart,
Selection.SelectionAction.ClearAndEnableSpecific, False, False, selectionMask, selected)
Dim curveList As ArrayList = New ArrayList
For Each aCurve As NXObject In selected
curveList.Add(aCurve)
Next
Return curveList.ToArray(GetType(Curve))
End Function
Function SelectFaces(ByRef prompt As String) As Face()
Dim selectionMask(0) As Selection.MaskTriple
With selectionMask(0)
.Type = UFConstants.UF_solid_type
.Subtype = 0
.SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
End With
Dim selected() As NXObject = Nothing
NXOpen.UI.GetUI.SelectionManager.SelectObjects("Select Faces", prompt, Selection.SelectionScope.WorkPart,
Selection.SelectionAction.ClearAndEnableSpecific, False, False, selectionMask, selected)
Dim faceList As ArrayList = New ArrayList
For Each aFace As NXObject In selected
faceList.Add(aFace)
Next
Return faceList.ToArray(GetType(Face))
End Function
'Function gettip(net As linkednetwork) As List(Of node)
' Dim tip As New List(Of node)
' For Each n As node In net.getnode
' If net.getl1node(n).Count = 1 Then
' tip.Add(n)
' End If
' Next
' Return tip
'End Function
Function label(f As Face, st As String)
'Dim f As Face = select_a_face("select face")
Dim type As Integer = Nothing
Dim point(2) As Double
Dim dir(2) As Double
Dim box(5) As Double
Dim rad As Double = Nothing
Dim rad_data As Double = Nothing
Dim norm_dir As Integer = Nothing
ufs.Modl.AskFaceData(f.Tag, type, point, dir, box, rad, rad_data, norm_dir)
Dim nullAnnotations_BalloonNote As Annotations.BalloonNote = Nothing
Dim balloonNoteBuilder1 As Annotations.BalloonNoteBuilder
balloonNoteBuilder1 = workpart.PmiManager.PmiAttributes.CreateBalloonNoteBuilder(nullAnnotations_BalloonNote)
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
balloonNoteBuilder1.Origin.Anchor = Annotations.OriginBuilder.AlignmentPosition.MidCenter
balloonNoteBuilder1.Title = "Balloon Note"
balloonNoteBuilder1.Category = "User Defined"
balloonNoteBuilder1.Identifier = "User Defined"
balloonNoteBuilder1.Revision = "-"
balloonNoteBuilder1.BalloonText = st
Dim text1(0) As String
text1(0) = ""
balloonNoteBuilder1.SetText(text1)
balloonNoteBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.UserDefined
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
Dim leaderData1 As Annotations.LeaderData
leaderData1 = workpart.Annotations.CreateLeaderData()
leaderData1.StubSize = 6.35
balloonNoteBuilder1.Leader.Leaders.Append(leaderData1)
leaderData1.StubSide = Annotations.LeaderSide.Inferred
balloonNoteBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.ModelView
Dim text2(0) As String
text2(0) = ""
balloonNoteBuilder1.SetText(text2)
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
balloonNoteBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.UserDefined
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
Dim xform1 As Xform
Dim p3 As Point3d = New Point3d(point(0), point(1), point(2))
Dim dc As DirectionCollection = workpart.Directions
Dim uvminmax(3) As Double
ufs.Modl.AskFaceUvMinmax(f.Tag, uvminmax)
Dim facepoint(2) As Double
ufs.Modl.AskFaceProps(f.Tag, {(uvminmax(1) - uvminmax(0)) / 2 + uvminmax(0), (uvminmax(3) - uvminmax(2)) / 2 + uvminmax(2)}, facepoint, {0, 0, 0}, {0, 0, 0}, {0, 0, 0}, {0, 0, 0}, {0, 0, 0}, {0, 0})
Dim p4 As Point3d = New Point3d(facepoint(0), facepoint(1), facepoint(2))
If f.SolidFaceType = Face.FaceType.Planar Then
xform1 = workpart.Xforms.CreateXform(f, SmartObject.UpdateOption.AfterModeling)
ElseIf f.SolidFaceType = Face.FaceType.Cylindrical Or f.SolidFaceType = Face.FaceType.Conical Then
Dim v3 As Vector3d = New Vector3d(dir(0), dir(1), dir(2))
Dim cr(2) As Double
cr(0) = crossproduct(point, dir)(0) / magnitude(crossproduct(point, dir))
cr(1) = crossproduct(point, dir)(1) / magnitude(crossproduct(point, dir))
cr(2) = crossproduct(point, dir)(2) / magnitude(crossproduct(point, dir))
Dim cr3 As Vector3d = New Vector3d(cr(0), cr(1), cr(2))
Dim d1 = dc.CreateDirection(p3, v3, SmartObject.UpdateOption.AfterModeling)
Dim d2 = dc.CreateDirection(p3, cr3, SmartObject.UpdateOption.AfterModeling)
Dim matrix(8) As Double
'ufs.Csys.AskMatrixValues(matidv, matrix)
Dim vecx(2), vecy(2), vecz(2) As Double
vecx = dir
vecy = cr
vecz = crossproduct(dir, cr)
matrix(0) = vecx(0)
matrix(1) = vecx(1)
matrix(2) = vecx(2)
matrix(3) = vecy(0)
matrix(4) = vecy(1)
matrix(5) = vecy(2)
matrix(6) = vecz(0)
matrix(7) = vecz(1)
matrix(8) = vecz(2)
Dim matid As Tag
ufs.Csys.CreateMatrix(matrix, matid)
Dim ctemp As Tag
ufs.Csys.CreateCsys(point, matid, ctemp)
xform1 = workpart.Xforms.CreateXform(d1, d2, SmartObject.UpdateOption.AfterModeling, 1)
Dim markId3 As Session.UndoMarkId
Dim no As NXObject = NXObjectManager.Get(ctemp)
Dim nErrs1 As Integer
nErrs1 = thesession.UpdateManager.AddToDeleteList(no)
Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = thesession.Preferences.Modeling.NotifyOnDelete
Dim nErrs2 As Integer
nErrs2 = thesession.UpdateManager.DoUpdate(markId3)
Else
Dim ctemp As Tag
ufs.Csys.AskWcs(ctemp)
Dim o As Point3d = New Point3d(p4.X, p4.Y, p4.Z)
Dim xv As Vector3d = New Vector3d(1, 0, 0)
Dim yv As Vector3d = New Vector3d(0, 1, 0)
Dim xd, yd As Direction
xd = dc.CreateDirection(o, xv, SmartObject.UpdateOption.AfterModeling)
yd = dc.CreateDirection(o, yv, SmartObject.UpdateOption.AfterModeling)
xform1 = workpart.Xforms.CreateXform(xd, yd, SmartObject.UpdateOption.AfterModeling, 1)
End If
'xform1 = workPart.Xforms.CreateXform(SmartObject.UpdateOption.AfterModeling, 1)
Dim point1 As Point
point1 = workpart.Points.CreatePoint(p4)
leaderData1.Leader.SetValue(point1, workpart.ModelingViews.WorkView, p4)
Dim cartesianCoordinateSystem1 As CartesianCoordinateSystem
cartesianCoordinateSystem1 = workpart.CoordinateSystems.CreateCoordinateSystem(xform1, SmartObject.UpdateOption.AfterModeling)
balloonNoteBuilder1.Origin.Plane.UserDefinedPlane = xform1
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
assocOrigin1.OriginType = Annotations.AssociativeOriginType.Drag
Dim nullView As View = Nothing
assocOrigin1.View = nullView
assocOrigin1.ViewOfGeometry = nullView
Dim nullPoint As Point = Nothing
assocOrigin1.PointOnGeometry = nullPoint
Dim nullAnnotations_Annotation As Annotations.Annotation = Nothing
assocOrigin1.VertAnnotation = nullAnnotations_Annotation
assocOrigin1.VertAlignmentPosition = Annotations.AlignmentPosition.MidCenter
assocOrigin1.HorizAnnotation = nullAnnotations_Annotation
assocOrigin1.HorizAlignmentPosition = Annotations.AlignmentPosition.MidCenter
assocOrigin1.AlignedAnnotation = nullAnnotations_Annotation
assocOrigin1.DimensionLine = 0
assocOrigin1.AssociatedView = nullView
assocOrigin1.AssociatedPoint = nullPoint
assocOrigin1.OffsetAnnotation = nullAnnotations_Annotation
assocOrigin1.OffsetAlignmentPosition = Annotations.AlignmentPosition.MidCenter
assocOrigin1.XOffsetFactor = 0.0
assocOrigin1.YOffsetFactor = 0.0
assocOrigin1.StackAlignmentPosition = Annotations.StackAlignmentPosition.Above
balloonNoteBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)
Dim point11 As Point3d = New Point3d(point(0), point(1), point(2))
balloonNoteBuilder1.Origin.Origin.SetValue(Nothing, nullView, point11)
balloonNoteBuilder1.Origin.SetInferRelativeToGeometry(True)
Dim nXObject1 As NXObject
nXObject1 = balloonNoteBuilder1.Commit()
balloonNoteBuilder1.Destroy()
End Function
Function CBin(ByVal n As Double) As String
If n = 0 Then
CBin = 0
ElseIf n > 0 Then
Dim i As Double
Dim c As Long
i = 2 ^ CLng(Math.Log(n) / Math.Log(2) + 0.1)
Do While i >= 1
c = Fix(n / i)
CBin = CBin & c
n = n - i * c
i = i / 2
Loop
End If
End Function
Function factorial(n As Integer) As Integer
If n = 0 Then
Return 1
Else
Dim f As Integer = 1
For i = 1 To n
f = f * i
Next
Return f
End If
End Function
Function momentofinertia(box() As Double) As Double()
Dim l, b, h As Double
l = box(3) - box(0)
b = box(4) - box(1)
h = box(5) - box(2)
Dim ix, iy, iz As Double
ix = (1 / 12) * (l * b * h) * (b * b + h * h)
iy = (1 / 12) * (l * b * h) * (l * l + h * h)
iz = (1 / 12) * (l * b * h) * (b * b + l * l)
Return {ix, iy, iz}
End Function
Function coincides(f1 As Face, f2 As Face) As Boolean
Dim type1 As Integer = Nothing
Dim point1(2) As Double
Dim dir1(2) As Double
Dim box1(5) As Double
Dim rad1 As Double = Nothing
Dim rad_data1 As Double = Nothing
Dim norm_dir1 As Integer = Nothing
ufs.Modl.AskFaceData(f1.Tag, type1, point1, dir1, box1, rad1, rad_data1, norm_dir1)
Dim type2 As Integer = Nothing
Dim point2(2) As Double
Dim dir2(2) As Double
Dim box2(5) As Double
Dim rad2 As Double = Nothing
Dim rad_data2 As Double = Nothing
Dim norm_dir2 As Integer = Nothing
ufs.Modl.AskFaceData(f2.Tag, type2, point2, dir2, box2, rad2, rad_data2, norm_dir2)
Dim mindis As Double
ufs.Modl.AskMinimumDist(f1.Tag, f2.Tag, 0, Nothing, 0, Nothing, mindis, {0, 0, 0}, {0, 0, 0})
If mindis <= 0.1 And Math.Round(dotproduct(dir1, dir2), 2) < -0.9 Then ' And Math.Round(dotproduct(r(point1, point2), dir1), 2) = 0 And
Return True
Else
Return False
End If
End Function
Function edgelength(e As Edge) As Double
Dim ctag As Tag
ufs.Modl.CreateCurveFromEdge(e.Tag, ctag)
Dim lenght As Double = 0
Dim pts As New List(Of Double())
For parm = 0 To 1 Step 0.1
Dim p(2), t(2), pn(2), bn(2) As Double
Dim tor, r As Double
ufs.Modl.AskCurveProps(ctag, parm, p, t, pn, bn, tor, r)
pts.Add(p)
Next
For i = 0 To pts.Count - 2
lenght = lenght + magnitude(r(pts.Item(i), pts.Item(i + 1)))
Next
Dim markId3 As Session.UndoMarkId
'markId3 = thesession.SetUndoMark(Session.MarkVisibility.Visible, "Delete")
Dim no As NXObject = NXObjectManager.Get(ctag)
Dim nErrs1 As Integer
nErrs1 = thesession.UpdateManager.AddToDeleteList(no)
Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = thesession.Preferences.Modeling.NotifyOnDelete
Dim nErrs2 As Integer
nErrs2 = thesession.UpdateManager.DoUpdate(markId3)
Return lenght
End Function
Public Function r(a() As Double, b() As Double) As Double()
Return {a(0) - b(0), a(1) - b(1), a(2) - b(2)}
End Function
Public Function getl1facesloop(fs As List(Of Face)) As List(Of Face)
Dim l1faces As New List(Of Face)
Dim el As New List(Of Edge)
For Each f As Face In fs
For Each e As Edge In f.GetEdges
If fs.Contains(e.GetFaces(0)) Xor fs.Contains(e.GetFaces(1)) Then
el.Add(e)
'e.Highlight()
End If
Next
Next
For Each e As Edge In el
For Each f As Face In e.GetFaces
If Not fs.Contains(f) Then
l1faces.Add(f)
End If
Next
Next
Return l1faces
End Function
Public Function dispvec(a() As Double)
Dim s As String = String.Join(" ", a)
lw.WriteFullline(s)
End Function
Public Function getrow(a(,) As Integer, i As Integer) As Double()
Dim b(a.GetLength(1) - 1) As Double
For j = 0 To a.GetLength(0) - 1
If i = j Then
For k = 0 To a.GetLength(1) - 1
b(k) = a(i, k)
Next
Exit For
End If
Next
Return b
End Function
Function getedgeloops(fs As List(Of Edge)) As List(Of List(Of Edge))
Dim completedface As New List(Of Edge)
Dim loops As New List(Of List(Of Edge))
For Each f As Edge In fs
If Not completedface.Contains(f) Then
Dim temploop As New List(Of Edge)
temploop.Add(f)
completedface.Add(f)
For Each f1 As Edge In fs
For Each fd As Edge In fs
If Not temploop.Contains(fd) And Not completedface.Contains(fd) Then 'Not temploop.Contains(fd) And
If connectededge(temploop.Item(temploop.Count - 1), fd) Then
temploop.Add(fd)
completedface.Add(fd)
Exit For
End If
End If
Next
Next
loops.Add(temploop)
End If
Next
Return loops
End Function
Function connectededge(f1 As Edge, f2 As Edge) As Boolean
Dim mindis As Double
ufs.Modl.AskMinimumDist(f1.Tag, f2.Tag, 0, Nothing, 0, Nothing, mindis, {0, 0, 0}, {0, 0, 0})
If Math.Round(mindis, 2) < 0.01 Then
Return True
Else
Return False
End If
End Function
Function getfaceloopsnew(fs As List(Of Face)) As List(Of List(Of Face))
Dim completedface As New List(Of Face)
Dim loops As New List(Of List(Of Face))
Dim facelist As List(Of Face) = fs
For Each f As Face In fs
If Not completedface.Contains(f) Then
Dim temploop As New List(Of Face)
temploop.Add(f)
completedface.Add(f)
completeloop(temploop, facelist, completedface)
loops.Add(temploop)
End If
Next
Return loops
End Function
Function intersection(f1 As List(Of Face), f2 As List(Of Face)) As List(Of Face)
Dim intersectionlist As New List(Of Face)
For Each f As Face In f1
If f2.Contains(f) Then
intersectionlist.Add(f)
End If
Next
Return intersectionlist
End Function
Function completefacefilter(ByRef potentialloopfaces As List(Of Face), completedface As List(Of Face))
Dim newlist As New List(Of Face)
For Each f As Face In potentialloopfaces
If Not completedface.Contains(f) Then
newlist.Add(f)
End If
Next
potentialloopfaces.RemoveRange(0, potentialloopfaces.Count)
potentialloopfaces.AddRange(newlist)
End Function
Function completeloop(ByRef temploop As List(Of Face), fs As List(Of Face), ByRef completedface As List(Of Face))
Dim l1temp As List(Of Face) = getl1facesloop(temploop) 'Dim l1temp As List(Of Face) = getl1faces(temploop.Item(temploop.Count - 1))
Dim potentialloopfaces As List(Of Face) = intersection(l1temp, fs) 'l1temp.Intersect(fs)
completefacefilter(potentialloopfaces, completedface)
If potentialloopfaces.Count = 0 Then
Exit Function
Else
For Each f As Face In potentialloopfaces
If Not completedface.Contains(f) Then
temploop.Add(f)
completedface.Add(f)
Exit For
End If
Next
completeloop(temploop, fs, completedface)
End If
End Function
Public Function getl1faces(f As Face) As List(Of Face)
Dim l1faces As New List(Of Face)
Dim edges() As Edge = f.GetEdges
For Each e As Edge In edges
Dim l1face_p() As Face = e.GetFaces
'l1face_p.ToList.Remove(f)
'l1faces.Add(l1face_p(0))
For Each l1_face As Face In l1face_p
If Not f.Tag = l1_face.Tag Then
l1faces.Add(l1_face)
Exit For
End If
Next
Next
Return l1faces
End Function
Public Function getcommonedges(f1 As Face, f2 As Face) As List(Of Edge)
Dim commonedges As New List(Of Edge)
Dim e1 As Array = f1.GetEdges
Dim e2 As Array = f2.GetEdges
For Each e As Edge In e1
For Each ee As Edge In e2
If e.Tag = ee.Tag Then
commonedges.Add(e)
End If
Next
Next
Return commonedges
End Function
Public Function getl2faces(f As Face) As List(Of Face)
Dim l2faces As New List(Of Face)
Dim l1faces As List(Of Face) = getl1faces(f)
For Each l1 As Face In l1faces
Dim edges1 As Array = l1.GetEdges
For Each e1 As Edge In edges1
Dim l2faces_p As Array = e1.GetFaces
For Each l2 As Face In l2faces_p
If Not (l1faces.Contains(l2)) And Not (l2.Tag = f.Tag) Then
l2faces.Add(l2)
End If
Next
Next
Next
Return l2faces
End Function
Function select_a_body(ByVal prompt As String) As Body
Dim mask() As Selection.MaskTriple = {New Selection.MaskTriple(
UFConstants.UF_solid_type, 0, UFConstants.UF_UI_SEL_FEATURE_BODY)}
Dim cursor As Point3d = Nothing
Dim obj As TaggedObject = Nothing
Dim resp As Selection.Response =
UI.GetUI().SelectionManager.SelectTaggedObject("Select a body", prompt,
Selection.SelectionScope.AnyInAssembly,
Selection.SelectionAction.ClearAndEnableSpecific,
False, False, mask, obj, cursor)
Return obj
End Function
Function select_a_face(ByVal prompt As String) As Face
Dim mask() As Selection.MaskTriple = {New Selection.MaskTriple(
UFConstants.UF_solid_type, 0, UFConstants.UF_UI_SEL_FEATURE_ANY_FACE)}
Dim cursor As Point3d = Nothing
Dim obj As TaggedObject = Nothing
Dim resp As Selection.Response =
UI.GetUI().SelectionManager.SelectTaggedObject("Select a face", prompt,
Selection.SelectionScope.AnyInAssembly,
Selection.SelectionAction.ClearAndEnableSpecific,
False, False, mask, obj, cursor)
Return obj
End Function
Public Function crossproduct(a() As Double, b() As Double) As Double()
Dim c() As Double = {a(1) * b(2) - b(1) * a(2), -a(0) * b(2) + b(0) * a(2), a(0) * b(1) - b(0) * a(1)}
Return c
End Function
Public Function dotproduct(a() As Double, b() As Double) As Double
Dim dot As Double = a(0) * b(0) + a(1) * b(1) + a(2) * b(2)
Return dot
End Function
Public Function getangle(a() As Double, b() As Double) As Double
Dim a1 = magnitude(a)
Dim a2 = magnitude(b)
Dim a3 = dotproduct(a, b)
Dim c As Double
c = Math.Acos(Math.Abs(a3 / (a1 * a2)))
Return c
End Function
Public Function magnitude(a() As Double) As Double
Return Math.Sqrt(a(0) ^ 2 + a(1) ^ 2 + a(2) ^ 2)
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return CType(NXOpen.Session.LibraryUnloadOption.Immediately, Integer)
End Function
Function get_tangent_faces(f As Face) As List(Of Face)
Dim selectionFaces() As TaggedObject
Dim lstSelFaces As List(Of Face) = New List(Of Face)
Dim scCollector1 As ScCollector = workpart.ScCollectors.CreateCollector
Dim boundaryFaces1(-1) As Face
Dim faceTangentRule1 As FaceTangentRule
faceTangentRule1 = workpart.ScRuleFactory.CreateRuleFaceTangent(f, boundaryFaces1)
Dim rules1(0) As SelectionIntentRule
rules1(0) = faceTangentRule1
scCollector1.ReplaceRules(rules1, False)
selectionFaces = scCollector1.GetObjects
'MsgBox("number selected: " & selectionFaces.Length.ToString)
For Each obj As TaggedObject In selectionFaces
'MsgBox("type: " & obj.GetType.ToString)
lstSelFaces.Add(obj)
Next
'For Each f1 As Face In lstSelFaces
' f1.Highlight()
'Next
Return lstSelFaces
End Function
Function SelectObjects(ByVal prompt As String, ByRef selObj() As TaggedObject) As Selection.Response
Dim title As String = "Select the functional holes"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction =
Selection.SelectionAction.ClearAndEnableSpecific
Dim scope As Selection.SelectionScope = Selection.SelectionScope.AnyInAssembly
Dim selectionMask_array(1) As Selection.MaskTriple
With selectionMask_array(0)
.Type = UFConstants.UF_solid_type
.Subtype = 0
.SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_ANY_FACE
End With
With selectionMask_array(1)
.Type = UFConstants.UF_solid_type
.Subtype = 0
.SolidBodySubtype = 0
End With
Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObjects(prompt, title, scope, selAction, includeFeatures, keepHighlighted, selectionMask_array, selObj)
If resp = Selection.Response.Ok Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If
End Function
Public Function classify_pierce(pierceloops As List(Of List(Of Face)), midsurf As Body) As List(Of List(Of Face))
Dim pierceloops_seq As New List(Of List(Of Face))
Dim tippingface As Face = select_a_face("Select a tipping direction")
Dim type1 As Integer = Nothing
Dim point1(2) As Double
Dim dir1(2) As Double
Dim box1(5) As Double
Dim rad1 As Double = Nothing
Dim rad_data1 As Double = Nothing
Dim norm_dir1 As Integer = Nothing
ufs.Modl.AskFaceData(tippingface.Tag, type1, point1, dir1, box1, rad1, rad_data1, norm_dir1)
For Each fsa As List(Of Face) In pierceloops
For Each f As Face In fsa
If f.SolidFaceType = Face.FaceType.Cylindrical Or f.SolidFaceType = Face.FaceType.Conical Then
Dim type As Integer = Nothing
Dim point(2) As Double
Dim dir(2) As Double
Dim box(5) As Double
Dim rad As Double = Nothing
Dim rad_data As Double = Nothing
Dim norm_dir As Integer = Nothing
ufs.Modl.AskFaceData(f.Tag, type, point, dir, box, rad, rad_data, norm_dir)
Dim fa = getangle(dir1, dir)
'lw.WriteLine(dir(0) & " " & dir(1) & " " & dir(2))
'lw.WriteLine(fa)
If fa < 0.27 Then
pierceloops_seq.Add(fsa)
End If
Else
Dim mindis2 As Double
For Each e As Edge In f.GetEdges
ufs.Modl.AskMinimumDist(midsurf.Tag, e.Tag, 0, Nothing, 0, Nothing, mindis2, {0, 0, 0}, {0, 0, 0})
If mindis2 < 0.1 Then
Dim bvert1(2) As Double
Dim bvert2(2) As Double
Dim bvertc As Integer
ufs.Modl.AskEdgeVerts(e.Tag, bvert1, bvert2, bvertc)
Dim bvert(2) As Double
bvert(0) = bvert1(0) - bvert2(0)
bvert(1) = bvert1(1) - bvert2(1)
bvert(2) = bvert1(2) - bvert2(2)
Dim fa = getangle(dir1, bvert)
'lw.WriteLine(bvert(0) & " " & bvert(1) & " " & bvert(2))
'lw.WriteLine(fa)
If fa < 0.27 Then
pierceloops_seq.Add(fsa)
End If
Exit For
End If
Next
End If
Next
Next
Return pierceloops_seq
End Function
Public Function classify_Trim(boundary As List(Of Face), midsurf As Body) As List(Of Face)
Dim trim_seq As New List(Of Face)
Dim Normal_face As Face = select_a_face("Select a normal direction")
Dim Normal_face2 As Face = select_a_face("Select a normal direction")
Dim type1 As Integer = Nothing
Dim point1(2) As Double
Dim dir1(2) As Double
Dim box1(5) As Double
Dim rad1 As Double = Nothing
Dim rad_data1 As Double = Nothing
Dim norm_dir1 As Integer = Nothing
ufs.Modl.AskFaceData(Normal_face.Tag, type1, point1, dir1, box1, rad1, rad_data1, norm_dir1)
Dim type2 As Integer = Nothing
Dim point2(2) As Double
Dim dir2(2) As Double
Dim box2(5) As Double
Dim rad2 As Double = Nothing
Dim rad_data2 As Double = Nothing
Dim norm_dir2 As Integer = Nothing
ufs.Modl.AskFaceData(Normal_face.Tag, type2, point2, dir2, box2, rad2, rad_data2, norm_dir2)
Dim dir3() As Double = crossproduct(dir1, dir2)
For Each f As Face In boundary
If f.SolidFaceType = Face.FaceType.Cylindrical Or f.SolidFaceType = Face.FaceType.Conical Then
Dim type As Integer = Nothing
Dim point(2) As Double
Dim dir(2) As Double
Dim box(5) As Double
Dim rad As Double = Nothing
Dim rad_data As Double = Nothing
Dim norm_dir As Integer = Nothing
ufs.Modl.AskFaceData(f.Tag, type, point, dir, box, rad, rad_data, norm_dir)
Dim fa = getangle(dir1, dir)
'lw.WriteLine(dir(0) & " " & dir(1) & " " & dir(2))
'lw.WriteLine(fa)
If fa < 0.27 Then
trim_seq.Add(f)
End If
Else
Dim mindis2 As Double
For Each e As Edge In f.GetEdges
ufs.Modl.AskMinimumDist(midsurf.Tag, e.Tag, 0, Nothing, 0, Nothing, mindis2, {0, 0, 0}, {0, 0, 0})
If mindis2 < 0.1 Then
Dim bvert1(2) As Double
Dim bvert2(2) As Double
Dim bvertc As Integer
ufs.Modl.AskEdgeVerts(e.Tag, bvert1, bvert2, bvertc)
Dim bvert(2) As Double
bvert(0) = bvert1(0) - bvert2(0)
bvert(1) = bvert1(1) - bvert2(1)
bvert(2) = bvert1(2) - bvert2(2)
Dim fa = getangle(dir1, bvert)
'lw.WriteLine(bvert(0) & " " & bvert(1) & " " & bvert(2))
'lw.WriteLine(fa)
If fa < 0.27 Then
trim_seq.Add(f)
End If
Exit For
End If
Next
End If
Next
Return trim_seq
End Function
Function centroid_of_face(planarFace As Face) As Point3d
Dim uvMinMax(3) As Double
ufs.Modl.AskFaceUvMinmax(planarFace.Tag, uvMinMax)
Dim ptMin(2) As Double
Dim ptMax(2) As Double
'get mid point of given face
Dim param() As Double = {(uvMinMax(0) + uvMinMax(1)) / 2, (uvMinMax(2) + uvMinMax(3)) / 2}
Dim pt(2) As Double
Dim u1(2) As Double
Dim v1(2) As Double
Dim u2(2) As Double
Dim v2(2) As Double
Dim unitNormal(2) As Double
Dim radii(1) As Double
ufs.Modl.AskFaceProps(planarFace.Tag, param, pt, u1, v1, u2, v2, unitNormal, radii)
Dim midPt As New Point3d(pt(0), pt(1), pt(2))
Return midPt
End Function
Function area_boundedbox(bb1() As Double) As Double
Dim bbx = Math.Abs(bb1(0) - bb1(3))
Dim bby = Math.Abs(bb1(1) - bb1(4))
Dim bbz = Math.Abs(bb1(2) - bb1(5))
Dim a1 = bbx * bby
Dim a2 = bbx * bbz
Dim a3 = bby * bbz
Dim areaf1 As Double = Math.Max(a1, a2)
Dim areaf2 As Double = Math.Max(a1, a3)
If areaf1 >= areaf2 Then
Return areaf1
Else
Return areaf1
End If
End Function
End Module