UG NX二次开发源码分享：VB创建自定义加工车间文档
Option Strict Off
Imports System
Imports System.IO
Imports NXOpen
Imports NXOpen.CAM
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports System.Drawing
Imports System.Windows.Forms
Module Module1
Dim theSession As Session = Session.GetSession()
Dim myUI As UI = UI.GetUI()
Dim theUFSession As UFSession = UFSession.GetUFSession()
Dim theWorkPart As Part = theSession.Parts.Work
Dim mytag() As NXOpen.Tag '选择的加工操作标记数组
Dim mcount As Integer '选择的加工操作数量
Sub Main()
Shell(Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\Post\SnapPic.exe", AppWinStyle.NormalFocus, True)
Try
'获取选择的操作数
theUFSession.UiOnt.AskSelectedNodes(mcount, mytag)
If mcount = 0 Then
MsgBox("没有选择加工操作!", MsgBoxStyle.OkOnly, "提示信息")
Exit Sub
End If
'设置车间文档EXCEL模板路径
Dim fp As String = Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\Post\WorkShop.xls"
'打开与写出车间文档
If String.IsNullOrEmpty(fp) = False Then
Dim myExcel As New MY_EXCEL
myExcel.Create()
myExcel.Open(fp)
myExcel.Write("M4", AskDisplatyPartName())
myExcel.Write("S4", Format(Now, "yyyy/MM/dd"))
myExcel.InsertPicture("b4", Environment.GetEnvironmentVariable("UGII_USER_DIR") + "\UDO\Post\jietu.jpg")
For i = 0 To mcount - 1
'输出结果
myExcel.Write("B" + (i + 17).ToString, (i + 1).ToString)
myExcel.Write("D" + (i + 17).ToString, GetGemoGroup_Name(mytag(i)))
myExcel.Write("E" + (i + 17).ToString, GetToolPathName(mytag(i)))
myExcel.Write("F" + (i + 17).ToString, GetToolName(mytag(i)))
myExcel.Write("G" + (i + 17).ToString, GetToolNumber(mytag(i)).ToString)
myExcel.Write("H" + (i + 17).ToString, GetToolDiameter(mytag(i)).ToString)
myExcel.Write("I" + (i + 17).ToString, GetToolCornerRadius(mytag(i)).ToString)
myExcel.Write("J" + (i + 17).ToString, GetToolHeight(mytag(i)).ToString)
myExcel.Write("K" + (i + 17).ToString, GetToolFluteLength(mytag(i)).ToString)
myExcel.Write("L" + (i + 17).ToString, GetStockPart(mytag(i)).ToString)
myExcel.Write("M" + (i + 17).ToString, GetStockFloor(mytag(i)).ToString)
myExcel.Write("N" + (i + 17).ToString, GetSpeedValue(mytag(i)).ToString)
myExcel.Write("O" + (i + 17).ToString, GetFeedValue(mytag(i)).ToString)
myExcel.Write("Q" + (i + 17).ToString, CInt(GetCutTime(mytag(i))).ToString)
Next
myExcel.SaveAs()
'myExcel.Quit()
End If
'出错处理：
Catch ex As Exception
MsgBox(ex)
End Try
End Sub
'当前文档文件名
Function AskDisplatyPartName() As String
Dim UFS As UFSession = UFSession.GetUFSession()
Dim part_name As String = ""
Dim part_tag As NXOpen.Tag = UFS.Part.AskDisplayPart
UFS.Part.AskPartName(part_tag, part_name)
Dim aa() As String
Dim bb() As String
aa = Split(part_name, ".prt")
part_name = aa(0)
bb = Split(part_name, "\")
part_name = bb(bb.Length - 1)
Return part_name
End Function
'取加工几何试图程序组
Function GetGemoGroup_Name(ByVal camObjectTag As NXOpen.Tag) As String
Dim theGemoGroup_Tag As NXOpen.Tag
Dim GemoGroupName As String = ""
theUFSession.Oper.AskGeomGroup(camObjectTag, theGemoGroup_Tag)
theUFSession.Obj.AskName(theGemoGroup_Tag, GemoGroupName)
Return GemoGroupName
End Function
'取操作名称
Function GetToolPathName(ByVal camObjectTag As NXOpen.Tag) As String
Dim ToolPathName As String = ""
theUFSession.Oper.AskNameFromTag(camObjectTag, ToolPathName)
Return ToolPathName
End Function
'获取刀具名称
Function GetToolName(ByVal camObjectTag As NXOpen.Tag) As String
Dim ToolName As String = ""
Dim ToolTag As NXOpen.Tag
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Obj.AskName(ToolTag, ToolName)
Return ToolName
End Function
'获取刀具号码
Function GetToolNumber(ByVal camObjectTag As NXOpen.Tag) As Integer
Dim ToolTag As NXOpen.Tag
Dim ToolNumber As Integer
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Param.AskIntValue(ToolTag, UFConstants.UF_PARAM_TL_NUMBER, ToolNumber)
Return ToolNumber
End Function
'获取刀具长度
Function GetToolHeight(ByVal camObjectTag As NXOpen.Tag) As Double
Dim ToolTag As NXOpen.Tag
Dim ToolHeight As Double
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Param.AskDoubleValue(ToolTag, UFConstants.UF_PARAM_TL_HEIGHT, ToolHeight)
Return ToolHeight
End Function
'获取刀具直径
Function GetToolDiameter(ByVal camObjectTag As NXOpen.Tag) As Double
Dim ToolTag As NXOpen.Tag
Dim ToolDiameter As Double
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Param.AskDoubleValue(ToolTag, UFConstants.UF_PARAM_TL_DIAMETER, ToolDiameter)
Return ToolDiameter
End Function
'获取刀具刃长
Function GetToolFluteLength(ByVal camObjectTag As NXOpen.Tag) As Double
Dim ToolTag As NXOpen.Tag
Dim ToolFluteLength As Double
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Param.AskDoubleValue(ToolTag, UFConstants.UF_PARAM_TL_FLUTE_LN, ToolFluteLength)
Return ToolFluteLength
End Function
'获取刀具R角
Function GetToolCornerRadius(ByVal camObjectTag As NXOpen.Tag) As Double
Dim ToolTag As NXOpen.Tag
Dim ToolCornerRadius As Double
theUFSession.Oper.AskCutterGroup(camObjectTag, ToolTag)
theUFSession.Param.AskDoubleValue(ToolTag, UFConstants.UF_PARAM_TL_COR1_RAD, ToolCornerRadius)
Return ToolCornerRadius
End Function
'取部件侧部余量
Function GetStockPart(ByVal camObjectTag As NXOpen.Tag) As Double
Dim StockPart As Double
theUFSession.Param.AskDoubleValue(camObjectTag, UFConstants.UF_PARAM_STOCK_PART, StockPart)
Return StockPart
End Function
'取部件底部余量
Function GetStockFloor(ByVal camObjectTag As NXOpen.Tag) As Double
Dim Stockfloor As Double
theUFSession.Param.AskDoubleValue(camObjectTag, UFConstants.UF_PARAM_STOCK_FLOOR, Stockfloor)
Return Stockfloor
End Function
'取主轴转速
Function GetSpeedValue(ByVal camObjectTag As NXOpen.Tag) As Double
Dim SpeedVale As Double
theUFSession.Param.AskDoubleValue(camObjectTag, UFConstants.UF_PARAM_SPINDLE_RPM, SpeedVale)
Return SpeedVale
End Function
'取进给速度
Function GetFeedValue(ByVal camObjectTag As NXOpen.Tag) As Double
Dim FeedValue As Double
Dim _camObject As NXObject = NXObjectManager.Get(camObjectTag)
Dim params(0) As CAM.Operation
params(0) = CType(_camObject, Operation)
Dim FeedsBuilder1 As ObjectsFeedsBuilder = theSession.Parts.Work.CAMSetup.CreateFeedsBuilder(params)
FeedValue = FeedsBuilder1.FeedsBuilder.FeedCutBuilder.Value
FeedsBuilder1.Destroy()
Return FeedValue
End Function
'取切削时间
Function GetCutTime(ByVal camObjectTag As NXOpen.Tag) As Double
Dim CutTime As Double
theUFSession.Param.AskDoubleValue(camObjectTag, 142, CutTime)
Return CutTime
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
'----Other unload options-------
'Unloads the image when the NX session terminates
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination
'Unloads the image explicitly, via an unload dialog
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Explicitly
'-------------------------------
End Function
End Module
Public Class MY_EXCEL
Private app As Object
Private book As Object
Private sheet As Object
'表格名称
Public Property xlSheetName() As String
Get
Return sheet.Name
End Get
Set(ByVal value As String)
sheet.Name = value
End Set
End Property
'新建程序
Public Function Create() As Boolean
app = CreateObject("Excel.Application")
If app Is Nothing Then
Return False
Else
app.Visible = True
Return True
End If
End Function
'打开文件
Public Sub Open(ByVal xlFileName As String)
book = app.Workbooks.Open(xlFileName)
sheet = book.ActiveSheet
End Sub
'写单元格
Public Sub Write(ByVal _Range As String, ByVal value As Object)
If _Range <> "" Then
sheet.Range(_Range).Value = value
End If
End Sub
'插入图片
Public Sub InsertPicture(ByVal _Range As String, ByVal imageFile As String)
If _Range <> "" Then
Dim ExcelRange As Object = sheet.Range(_Range)
Dim Ins_image As Image
Ins_image = Image.FromFile(imageFile)
Dim HeightScale As Double = Math.Round((ExcelRange.Height * 12 - 6) / Ins_image.Height, 2)
Dim WidthScale As Double = Math.Round((ExcelRange.Width * 15 - 6) / Ins_image.Width, 2)
Dim ScaleHW As Double = Math.Min(HeightScale, WidthScale)
sheet.Shapes.AddPicture(imageFile, 0, 1, ExcelRange.Left + 2, ExcelRange.Top + 2, Ins_image.Width * ScaleHW, Ins_image.Height * ScaleHW)
Ins_image.Dispose()
End If
End Sub
'取指定单元格值
Public Function GetValue(ByVal _table As Integer, ByVal _Range As String) As String
Dim sheet As Object = book.Sheets.Item(_table)
Return sheet.Range(_Range).value
End Function
Public Function Save() As Boolean
book.Save()
End Function
Public Function SaveAs() As Boolean
Dim Sdlg As SaveFileDialog = New SaveFileDialog '定义一个保存对话框
Sdlg.FileName = AskDisplatyPartName() + "加工工序单.xls" '保存对话框的默认文件名
Sdlg.Filter = "EXCEL档案(*.xls)|*.xls" '过滤器设置
If Sdlg.ShowDialog = Windows.Forms.DialogResult.OK Then '如果保存对话框的确认按钮被按下
book.SaveAs(Sdlg.FileName) '保存文件
End If
End Function
'结束EXCEL对象
Public Function Quit() As Boolean
book.close()
app.Quit()
app = Nothing
GC.Collect()
End Function
'取数组
Public Function GetArryValue(ByRef _table As Integer, ByVal _Row As String, ByVal _Cell As String, ByRef ArryString() As String) As Integer
Dim sheet As Object = book.Sheets.Item(_table)
Dim rowvalue As String = sheet.Range(_Row).value
Dim cellvalue As String = sheet.Range(_Cell).value
Dim k As Integer = 0
If rowvalue <> "" And cellvalue <> "" Then
Dim rowstr() As String = Split(rowvalue, "/")
Dim cellstring() As String = Split(cellvalue, "/")
Dim a, b, c, d As Integer
If rowstr.Length > 1 And cellstring.Length > 0 Then
a = Convert.ToInt32(rowstr(0))
b = Convert.ToInt32(rowstr(1))
If a > 0 And b > a Then
ReDim Preserve ArryString(b - a)
For i As Integer = 0 To b - a
ArryString(i) = cellstring(0) & Convert.ToString(a + i)
k += 1
Next
If rowstr.Length > 3 And cellstring.Length > 1 Then
c = Convert.ToInt32(rowstr(2))
d = Convert.ToInt32(rowstr(3))
If c > 0 And d > c Then
ReDim Preserve ArryString(b - a + d - c + 1)
For j As Integer = 0 To d - c
ArryString(b - a + j + 1) = cellstring(1) & Convert.ToString(c + j)
k += 1
Next
End If
End If
End If
End If
End If
Return k
End Function
End Class
页:
[1]