自制UG标准零件系库
窗体代码：
Imports System.IO
Imports System.Windows.Forms
Public Class Form1
Public Button_Result As Integer = -1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Me.PictureBox1.ImageLocation = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD\logo.jpg"
Dim node As New TreeNode
TreeView1.Nodes.Clear()
node.ImageIndex = 0
node.Text = "标准零件库"
node.SelectedImageIndex = -1
TreeView1.Nodes.Add(node)
Dim i As Integer
Dim str() As String = IO.Directory.GetDirectories(Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD")
For i = 0 To str.GetUpperBound(0)
'调用遍历过程
AddDirectory(Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD", str(i), node)
Next
node = Nothing
End Sub
Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Dim AppPath As String = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD" '获取应用程序的当前工作目录
Process.Start(AppPath) '打开当前目录
End Sub
Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
MsgBox("1）文件是依据文件夹进行分类，可根据需求自行建立，支持中文" & vbCrLf & _
"2）文件导入后的图层可选当前工作或者原始图层" & vbCrLf & _
"3）选择[包含CAM]选项，可导入加工操作，可用于同类型加工模板" & vbCrLf & _
"4）文件默认导入坐标系（0，0，0 ）" & vbCrLf & _
"5）自建文件时，缩略图尺寸275*274像素最佳" & vbCrLf & _
"----------制作：逍遥客", MsgBoxStyle.OkOnly, "标准零件库使用说明")
End Sub
'TreeView1选择后事件
Private Sub TreeView1_AfterSelect(sender As System.Object, e As System.Windows.Forms.TreeViewEventArgs) Handles TreeView1.AfterSelect
If InStr(Me.TreeView1.SelectedNode.Text, ".prt") <> 0 Then
Dim PrtPath As String() = Split(Me.TreeView1.SelectedNode.FullPath, "标准零件库")
Dim PrtPath1 As String() = Split(PrtPath(1), ".prt")
Me.PictureBox1.ImageLocation = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD" + PrtPath1(0) + ".jpg"
End If
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
If InStr(Me.TreeView1.SelectedNode.Text, ".prt") <> 0 Then
Dim PrtPath As String() = Split(Me.TreeView1.SelectedNode.FullPath, "标准零件库")
Dim path As String = Environment.GetEnvironme
ntVariable("UGII_USER_DIR") + "\UDO\STANDARD" + PrtPath(1)
Dim path1 As String = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD\temp.prt"
File.Copy(path, path1, True)
Button_Result = 1
Close()
Else
MsgBox("请先选择要导入的标准件！")
End If
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
Button_Result = 0
Close()
End Sub
'遍历所有目录
Public Sub AddDirectory(ByVal strFatherPath As String, ByVal strPath As String, ByVal nodeFather As TreeNode)
Dim i As Integer
Dim node As New TreeNode
'先添加本目录，从文件夹路径分析出文件夹名称
node.Text = Strings.Replace(strPath, strFatherPath & "\", "", , 1)
'为单个节点指定节点未被选中时显示的图标
node.ImageIndex = 1
'为单个节点指定节点被选中时显示的图标
node.SelectedImageIndex = 2
nodeFather.Nodes.Add(node)
Application.DoEvents()
Try
Dim str() As String = IO.Directory.GetFiles(strPath)
'遍历该目录的文件
For i = 0 To str.GetUpperBound(0)
AddFileList(strPath, str(i), node)
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Try
Dim str() As String = IO.Directory.GetDirectories(strPath)
'遍历该目录的子文件夹
For i = 0 To str.GetUpperBound(0)
AddDirectory(strPath, str(i), node)
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
node = Nothing
End Sub
'遍历PRT文件
Public Sub AddFileList(ByVal strFatherPath As String, ByVal strPath As String, ByVal nodeFather As TreeNode)
Dim node As New TreeNode
'先添加本目录，从文件夹路径分析出文件名称
node.Text = Strings.Replace(strPath, strFatherPath & "\", "", , 1)
'为单个节点指定节点未被选中时显示的图标
node.ImageIndex = 3
'为单个节点指定节点被选中时显示的图标
node.SelectedImageIndex = 3
If InStr(node.Text, ".prt") <> 0 Then
nodeFather.Nodes.Add(node)
Application.DoEvents()
End If
node = Nothing
End Sub
End Class
===============================================================================
Stantard模块代码：
=================================================================================
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Module Stantard
Sub Ma
in()
Dim theSession As Session = Session.GetSession()
Dim theUI As UI = UI.GetUI()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim form As New Form1()
form.ShowDialog() '显示窗体
If form.Button_Result = 1 Then
Dim partImporter1 As PartImporter = workPart.ImportManager.CreatePartImporter()
partImporter1.FileName = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\STANDARD\temp.prt"
partImporter1.Scale = 1.0
partImporter1.CreateNamedGroup = True
partImporter1.ImportViews = False
If form.CheckBox1.Checked = True Then
partImporter1.ImportCamObjects = True
Else
partImporter1.ImportCamObjects = False
End If
If form.CheckBox2.Checked = True Then
https://www.doczj.com/doc/9c6286581.html,yerOption = https://www.doczj.com/doc/9c6286581.html,yerOptionType.Original
Else
https://www.doczj.com/doc/9c6286581.html,yerOption = https://www.doczj.com/doc/9c6286581.html,yerOptionType.Work
End If
partImporter1.DestinationCoordinateSystemSpecification = PartImporter.DestinationCoordinateSystemSpecificationType.Work
Dim nXMatrix1 As NXMatrix = CType(workPart.NXMatrices.FindObject("WCS"), NXMatrix)
partImporter1.DestinationCoordinateSystem = nXMatrix1
Dim destinationPoint1 As Point3d = New Point3d(0.0, 0.0, 0.0)
partImporter1.DestinationPoint = destinationPoint1
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Import Part Commit")
Dim nXObject1 As NXObject
nXObject1 = https://www.doczj.com/doc/9c6286581.html,mit()
theSession.DeleteUndoMark(markId1, Nothing)
partImporter1.Destroy()
End If
End Sub
Public Function GetUnloadOption(ByVal dummy As String) As Integer
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
End Module