分享

自制UG标准零件系库[源代码]

 战神之家 2014-09-28
自制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)文件默认导入坐标系(000 " & 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.GetEnvironmentVariable("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 Main()

        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

                partImporter1.LayerOption = PartImporter.LayerOptionType.Original

            Else

                partImporter1.LayerOption = PartImporter.LayerOptionType.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 = partImporter1.Commit()

 

            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

 

 

 

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多