Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Features
Imports NXOpen.Utilities
Imports NXOpen.Annotations
Module TabNote
Dim s As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim workPart As Part = s.Parts.Work
Dim ui As UI = ui.GetUI()
Sub Main()
Dim no_pts As Integer = Nothing
Dim pos1 As Integer = Nothing
Dim junk3(2) As Double
Dim junk2(1) As Double
Dim junk1 As Double
Dim theSweep As Feature = Nothing
Dim response1 As Selection.Response = Selection.Response.Cancel
Dim message1 As String = "Select the sweep Feature"
start1:
response1 = select_a_feature(message1, theSweep)
If response1 = Selection.Response.Cancel Or response1 = Selection.Response.Back Then GoTo end1
Dim name1 As String = Nothing
name1 = theSweep.GetFeatureName.Substring(0, 5)
If name1 <> "Sweep" Then
MsgBox("Selected feature is not a Sweep along Guide feature")
GoTo end1
End If
Dim pt1(2) As Double
Dim pt2(2) As Double
Dim line1 As Line
Dim arc1 As Arc
Dim noprofilecurves As Integer = Nothing
Dim profilecurvetags(-1) As NXOpen.Tag
Dim nosectioncurves As Integer = Nothing
Dim sectioncurvetags(-1) As NXOpen.Tag
ufs.Modl.AskSweepCurves(theSweep.Tag, nosectioncurves, sectioncurvetags, noprofilecurves, profilecurvetags)
Dim obj1(noprofilecurves - 1) As NXObject
Dim strpt(noprofilecurves - 1) As Point3d
Dim endpt(noprofilecurves - 1) As Point3d
Dim radii(noprofilecurves - 1) As Double
Dim lengths(noprofilecurves - 1) As Double
Dim angle1(noprofilecurves - 1) As Double
Dim strangle As Double = Nothing
Dim endangle As Double = Nothing
Dim lengths2(noprofilecurves - 1) As Double
For i As Integer = 0 To noprofilecurves - 1
obj1(i) = NXObjectManager.Get(profilecurvetags(i))
' get the end points, radius and length
If (TypeOf obj1(i) Is Line) Then
line1 = DirectCast(obj1(i), Line)
strpt(i) = line1.StartPoint
endpt(i) = line1.EndPoint
radii(i) = 0.0
lengths(i) = line1.GetLength()
angle1(i) = 0.0
lengths2(i) = 0.0
ElseIf (TypeOf obj1(i) Is Arc) Then
arc1 = DirectCast(obj1(i), Arc)
ufs.Modl.AskCurveProps(profilecurvetags(i), 0.0, pt1, junk3, junk3, junk3, junk1, junk1)
ufs.Modl.AskCurveProps(profilecurvetags(i), 1.0, pt2, junk3, junk3, junk3, junk1, junk1)
strpt(i) = New Point3d(pt1(0), pt1(1), pt1(2))
endpt(i) = New Point3d(pt2(0), pt2(1), pt2(2))
radii(i) = arc1.Radius
lengths(i) = arc1.GetLength()
strangle = arc1.StartAngle
endangle = arc1.EndAngle
angle1(i) = (endangle - strangle) / 2.0
lengths2(i) = radii(i) * Math.Tan(angle1(i))
Else
MsgBox("Sweep guide curve is not a line or arc")
End If
Next
' order the points for tabnote
Dim orderedpts(noprofilecurves) As Point3d
Dim l1 As Double = 0.0
l1 = Distancepoint3d(strpt(0), strpt(1))
If l1 = 0.0 Then
orderedpts(0) = endpt(0)
orderedpts(1) = strpt(1)
orderedpts(2) = endpt(1)
GoTo continue2
End If
l1 = Distancepoint3d(strpt(0), endpt(1))
If l1 = 0.0 Then
orderedpts(0) = endpt(0)
orderedpts(1) = endpt(1)
orderedpts(2) = strpt(1)
GoTo continue2
End If
l1 = Distancepoint3d(endpt(0), strpt(1))
If l1 = 0.0 Then
orderedpts(0) = strpt(0)
orderedpts(1) = strpt(1)
orderedpts(2) = endpt(1)
GoTo continue2
End If
l1 = Distancepoint3d(endpt(0), endpt(1))
If l1 = 0.0 Then
orderedpts(0) = strpt(0)
orderedpts(1) = endpt(1)
orderedpts(2) = strpt(1)
GoTo continue2
End If
continue2:
For i As Integer = 2 To noprofilecurves - 2
l1 = Distancepoint3d(orderedpts(i), strpt(i + 1))
If l1 = 0.0 Then
orderedpts(i + 1) = endpt(i + 1)
If i = noprofilecurves - 2 Then
orderedpts(i + 2) = strpt(i + 1)
End If
Else
orderedpts(i + 1) = strpt(i + 1)
If i = noprofilecurves - 2 Then
orderedpts(i + 2) = endpt(i + 1)
End If
End If
Next
' now determine the intersection points
Dim newnopoints As Integer = noprofilecurves - 3
Dim newpoints(newnopoints - 1) As Point3d
newpoints(0) = orderedpts(0)
newpoints(newnopoints - 1) = orderedpts(noprofilecurves - 4)
For i As Integer = 1 To newnopoints - 2
newpoints(i) = calculateIntesectionPoint(orderedpts((i - 1) * 2), orderedpts((i - 1) * 2 + 1), lengths2(i * 2 - 1))
Next
' select point for tabnote
Dim dwgview As View = Nothing
Dim cursor As Point3d
Dim response As Selection.DialogResponse = SelectScreenPos(cursor, dwgview)
If response <> Selection.DialogResponse.Pick Then
Return
End If
' Create the tabular note
Dim n_new_columns As Integer = 5
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(0, n_new_columns, cursor)
' Get the column tags
Dim columns(n_new_columns - 1) As NXOpen.Tag
For ii As Integer = 0 To n_new_columns - 1
ufs.Tabnot.AskNthColumn(tabnote, ii, columns(ii))
Next
Dim row As NXOpen.Tag
Dim cell As NXOpen.Tag
Dim cells(4) As NXOpen.Tag
' Add points Header Row
Dim headerrow As NXOpen.Tag
ufs.Tabnot.CreateRow(10, headerrow)
ufs.Tabnot.AddRow(tabnote, headerrow, UFConstants.UF_TABNOT_APPEND)
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(0), cell)
ufs.Tabnot.SetCellText(cell, "Point")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(1), cell)
ufs.Tabnot.SetCellText(cell, " X ")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(2), cell)
ufs.Tabnot.SetCellText(cell, " Y ")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(3), cell)
ufs.Tabnot.SetCellText(cell, " Z ")
ufs.Tabnot.AskCellAtRowCol(headerrow, columns(4), cell)
ufs.Tabnot.SetCellText(cell, "Radius")
' Add a row for each point leaving out the first point ???
For i As Integer = 0 To newpoints.Length - 1
ufs.Tabnot.CreateRow(10, row)
ufs.Tabnot.AddRow(tabnote, row, UFConstants.UF_TABNOT_APPEND)
ufs.Tabnot.AskCellAtRowCol(row, columns(0), cell)
ufs.Tabnot.SetCellText(cell, (i + 1).ToString())
ufs.Tabnot.AskCellAtRowCol(row, columns(1), cell)
ufs.Tabnot.SetCellText(cell, FormatNumber(newpoints(i).X, 1).ToString())
ufs.Tabnot.AskCellAtRowCol(row, columns(2), cell)
ufs.Tabnot.SetCellText(cell, FormatNumber(newpoints(i).Y, 1).ToString())
ufs.Tabnot.AskCellAtRowCol(row, columns(3), cell)
ufs.Tabnot.SetCellText(cell, FormatNumber(newpoints(i).Z, 1).ToString())
ufs.Tabnot.AskCellAtRowCol(row, columns(4), cell)
If i = 0 Then
ufs.Tabnot.SetCellText(cell, FormatNumber(radii(0), 1).ToString())
ElseIf i = newpoints.Length - 1 Then
ufs.Tabnot.SetCellText(cell, FormatNumber(radii(i * 2 - 2), 1).ToString())
Else
ufs.Tabnot.SetCellText(cell, FormatNumber(radii(i * 2 - 1), 1).ToString())
End If
Next
' Developed Length
Dim devlength As String = "Developed Length"
Dim sum1 As Double = Nothing
For i As Integer = 0 To noprofilecurves - 1
sum1 = sum1 + lengths(i)
Next
ufs.Tabnot.CreateRow(10, row)
ufs.Tabnot.AddRow(tabnote, row, UFConstants.UF_TABNOT_APPEND)
For i As Integer = 0 To 4
ufs.Tabnot.AskCellAtRowCol(row, columns(i), cells(i))
Next
ufs.Tabnot.MergeCells(cells(0), cells(3))
ufs.Tabnot.SetCellText(cells(0), devlength)
ufs.Tabnot.SetCellText(cells(4), FormatNumber(sum1, 1).ToString())
end1:
End Sub
Function calculateIntesectionPoint(ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal l1 As Double) As Point3d
Dim v1 As Vector3d
v1.X = pt2.X - pt1.X
v1.Y = pt2.Y - pt1.Y
v1.Z = pt2.Z - pt1.Z
' unitize
Dim u1 As Vector3d
Dim sub1 As Double
sub1 = Math.Sqrt(v1.X * v1.X + v1.Y * v1.Y + v1.Z * v1.Z)
u1.X = v1.X / sub1
u1.Y = v1.Y / sub1
u1.Z = v1.Z / sub1
Dim p3 As Point3d
p3.X = pt2.X + u1.X * l1
p3.Y = pt2.Y + u1.Y * l1
p3.Z = pt2.Z + u1.Z * l1
Return p3
End Function
Function select_a_feature(ByRef prompt As String, ByRef sweep1 As Feature) As Selection.Response
Dim featurearray(-1) As Features.Feature
Dim feattype As NXOpen.Selection.SelectionFeatureType = Selection.SelectionFeatureType.Browsable
Dim response1 As Selection.Response = Selection.Response.Cancel
response1 = ui.GetUI.SelectionManager.SelectFeatures(prompt, feattype, featurearray)
sweep1 = featurearray(0)
Return response1
End Function
Public Function SelectScreenPos(ByRef pos As Point3d, ByVal view As View) As Selection.DialogResponse
Return (ui.SelectionManager.SelectScreenPosition("Select location for tabnote", view, pos))
End Function
Public Function CreateTabnoteWithSize( _
ByVal nRows As Integer, ByVal nColumns As Integer, ByVal loc As Point3d) As NXOpen.Tag
' Create the tabular note. Based on annotation preferences Fit methods with auto size row on, auto size text on,
' auto size column on and all others off
Dim secPrefs As UFTabnot.SectionPrefs
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)
' Delete all existing columns and rows (we create them as needed)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows - 1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns - 1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next
' Now add our columns as needed
Dim columns(nColumns - 1) As NXOpen.Tag
For ii As Integer = 0 To nColumns - 1
' ufs.Tabnot.SetColumnWidth(columns(ii), 10)
ufs.Tabnot.CreateColumn(40, columns(ii))
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next
' Now add our rows as needed
Dim rows(nRows - 1) As NXOpen.Tag
For ii As Integer = 0 To nRows - 1
ufs.Tabnot.CreateRow(40, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next
Return tabnote
End Function
Public Function Distancepoint3d(ByVal pt1 As Point3d, ByVal pt2 As Point3d) As Double
Dim l1 As Double = 0.0
If Math.Abs(pt1.X - pt2.X) < 0.01 And _
Math.Abs(pt1.Y - pt2.Y) < 0.01 And _
Math.Abs(pt1.Z - pt2.Z) < 0.01 Then
l1 = 0.0
Else
l1 = Math.Sqrt((pt2.X - pt1.X) * (pt2.X - pt1.X) + _
(pt2.Y - pt1.Y) * (pt2.X - pt1.Y) + _
(pt2.Z - pt1.Z) * (pt2.Z - pt1.Z))
End If
Return l1
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
End Module