mnash60
Materials
- Feb 21, 2012
- 29
I found a vb file on here that supplies me with xyz data for all points. I want to filter the selection of type of points by a type or feature name(welding objects). Attached you'll find the vb file and images of the feature i want to filter.
' NX 7.5.0.32
' eng-tips thread561-314774
' return information on points and arcs for bend table info
Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpenUI
Imports NXOpen.UF
Module NXJournal
Dim ufs As UFSession = UFSession.GetUFSession()
Sub Main
D theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
'layer to interrogate
dim layerNumber as Integer = 1
Dim lw As ListingWindow = theSession.ListingWindow
Dim allObjects as NXObject()
Dim pointObject as Point
Dim pointXYZ as Point3d
Dim arcObject as Arc
Dim myPoints as New ArrayList()
Dim myArcs as New ArrayList()
Dim pointName as String
Dim arcName as String
allObjects = workPart.Layers.GetAllObjectsOnLayer(layerNumber)
lw.Open
for each someObject as NXObject in allObjects
' lw.WriteLine(someObject.GetType.ToString)
if someObject.GetType.ToString = "NXOpen.Point" then
myPoints.Add(someObject)
end if
if someObject.GetType.ToString = "NXOpen.Arc" then
myArcs.Add(someObject)
end if
next
'myPoints.Sort
'info dump, not guaranteed to be in any specific order
lw.WriteLine("Point Name,Point X,Point Y,Point Z")
for each pointObject in myPoints
pointXYZ = pointObject.Coordinates
pointXYZ = Abs2WCS(pointXYZ)
'pointName = pointObject.Name
Try
pointName = pointObject.GetStringAttribute("NM")
Catch
'attribute does not exist
pointName = "<no 'NM' attribute>"
End Try
lw.WriteLine(pointName & "," & Math.Round(pointXYZ.X, 3) & "," & Math.Round(pointXYZ.Y, 3) & "," & Math.Round(pointXYZ.Z, 3))
next
lw.WriteLine("")
lw.WriteLine("Arc Name, Radius")
for each arcObject in myArcs
Try
arcName = arcObject.GetStringAttribute("NM")
Catch
'attribute does not exist
arcName = "<no 'NM' attribute>"
End Try
lw.WriteLine(arcName & "," & arcObject.Radius)
next
lw.Close
End Sub
'**************************************************************************************************
'function taken from GTAC example
Function Abs2WCS(ByVal inPt As Point3d) As Point3d
Dim pt1(2), pt2(2) As Double
pt1(0) = inPt.X
pt1(1) = inPt.Y
pt1(2) = inPt.Z
ufs.Csys.MapPoint(UFConstants.UF_CSYS_ROOT_COORDS, pt1, UFConstants.UF_CSYS_ROOT_WCS_COORDS, pt2)
Abs2WCS.X = pt2(0)
Abs2WCS.Y = pt2(1)
Abs2WCS.Z = pt2(2)
End Function
'**************************************************************************************************
End Module
' NX 7.5.0.32
' eng-tips thread561-314774
' return information on points and arcs for bend table info
Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpenUI
Imports NXOpen.UF
Module NXJournal
Dim ufs As UFSession = UFSession.GetUFSession()
Sub Main
D theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
'layer to interrogate
dim layerNumber as Integer = 1
Dim lw As ListingWindow = theSession.ListingWindow
Dim allObjects as NXObject()
Dim pointObject as Point
Dim pointXYZ as Point3d
Dim arcObject as Arc
Dim myPoints as New ArrayList()
Dim myArcs as New ArrayList()
Dim pointName as String
Dim arcName as String
allObjects = workPart.Layers.GetAllObjectsOnLayer(layerNumber)
lw.Open
for each someObject as NXObject in allObjects
' lw.WriteLine(someObject.GetType.ToString)
if someObject.GetType.ToString = "NXOpen.Point" then
myPoints.Add(someObject)
end if
if someObject.GetType.ToString = "NXOpen.Arc" then
myArcs.Add(someObject)
end if
next
'myPoints.Sort
'info dump, not guaranteed to be in any specific order
lw.WriteLine("Point Name,Point X,Point Y,Point Z")
for each pointObject in myPoints
pointXYZ = pointObject.Coordinates
pointXYZ = Abs2WCS(pointXYZ)
'pointName = pointObject.Name
Try
pointName = pointObject.GetStringAttribute("NM")
Catch
'attribute does not exist
pointName = "<no 'NM' attribute>"
End Try
lw.WriteLine(pointName & "," & Math.Round(pointXYZ.X, 3) & "," & Math.Round(pointXYZ.Y, 3) & "," & Math.Round(pointXYZ.Z, 3))
next
lw.WriteLine("")
lw.WriteLine("Arc Name, Radius")
for each arcObject in myArcs
Try
arcName = arcObject.GetStringAttribute("NM")
Catch
'attribute does not exist
arcName = "<no 'NM' attribute>"
End Try
lw.WriteLine(arcName & "," & arcObject.Radius)
next
lw.Close
End Sub
'**************************************************************************************************
'function taken from GTAC example
Function Abs2WCS(ByVal inPt As Point3d) As Point3d
Dim pt1(2), pt2(2) As Double
pt1(0) = inPt.X
pt1(1) = inPt.Y
pt1(2) = inPt.Z
ufs.Csys.MapPoint(UFConstants.UF_CSYS_ROOT_COORDS, pt1, UFConstants.UF_CSYS_ROOT_WCS_COORDS, pt2)
Abs2WCS.X = pt2(0)
Abs2WCS.Y = pt2(1)
Abs2WCS.Z = pt2(2)
End Function
'**************************************************************************************************
End Module