社区活动 技术论坛 PC-DIMS有关数据开发的代码,大家参考
PC-DIMS有关数据开发的代码,大家参考
2011-07-11 19:47 115 0 3
坛子上好多朋友需要数据导出等二次开发操作,但海克斯康的原始程序导出的数据不一定符合要求,以下是程序中的一段主要代码,请参考 不懂的可以提问,共同学习!! Private Sub Command2_Click() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim app As PCDLRN.Application Dim cmds As PCDLRN.Commands Dim cmd As PCDLRN.Command Dim part As PCDLRN.PartProgram Dim lngR As Long Dim lngC As Long Dim i As Long Dim arrValue() As String Dim strName As String ReDim arrValue(5000, 8) If Text1.Text = "" Then MsgBox "无效保存路径!", vbCritical + vbOKOnly, "提示" Exit Sub End If Set app = CreateObject("PCDLRN.Application") Set part = app.ActivePartProgram Set cmds = part.Commands lngR = 0 lngC = 0 i = 1 For Each cmd In cmds If cmd.IsDimension Then If cmd.Type = DIMENSION_TRUE_START_POSITION Or cmd.Type = DIMENSION_END_LOCATION Or cmd.Type = DIMENSION_START_LOCATION Or cmd.Type = DIMENSION_TRUE_END_POSITION Or cmd.Type = DIMENSION_2D_DISTANCE Or cmd.Type = DIMENSION_3D_DISTANCE Or cmd.Type = DIMENSION_FLATNESS Then arrValue(lngR + i, lngC + 1) = cmd.DimensionCommand.ID: strName = cmd.DimensionCommand.ID Else arrValue(lngR + i, lngC + 1) = strName End If If cmd.Type = DIMENSION_2D_DISTANCE Or cmd.Type = DIMENSION_3D_DISTANCE Or cmd.Type = DIMENSION_FLATNESS Or cmd.Type = DIMENSION_X_LOCATION Or cmd.Type = DIMENSION_Y_LOCATION Or cmd.Type = DIMENSION_Z_LOCATION Or cmd.Type = DIMENSION_T_LOCATION Then Select Case cmd.Type Case DIMENSION_X_LOCATION arrValue(lngR + i, lngC + 2) = "X" Case DIMENSION_Y_LOCATION arrValue(lngR + i, lngC + 2) = "Y" Case DIMENSION_Z_LOCATION arrValue(lngR + i, lngC + 2) = "Z" Case DIMENSION_T_LOCATION arrValue(lngR + i, lngC + 2) = "T" Case DIMENSION_2D_DISTANCE arrValue(lngR + i, lngC + 2) = "2D距离" Case DIMENSION_FLATNESS arrValue(lngR + i, lngC + 2) = "平面度" Case DIMENSION_3D_DISTANCE arrValue(lngR + i, lngC + 2) = "3D距离" End Select arrValue(lngR + i, lngC + 3) = Format(cmd.DimensionCommand.NOMINAL, "0.00") arrValue(lngR + i, lngC + 4) = Format(cmd.DimensionCommand.Measured, "0.00") arrValue(lngR + i, lngC + 5) = cmd.DimensionCommand.Plus arrValue(lngR + i, lngC + 6) = -cmd.DimensionCommand.Minus arrValue(lngR + i, lngC + 7) = Format(cmd.DimensionCommand.Deviation, "0.00") arrValue(lngR + i, lngC + 8) = Format(cmd.DimensionCommand.OutTol, "0.00") i = i + 1 End If End If DoEvents Next cmd Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add xlApp.Visible = False Sheets("Sheet1").Name = "Data" Sheets("Sheet2").Delete Sheets("Sheet3").Delete Set xlSheet = xlBook.Worksheets("Data") With xlSheet .Range("A1:H1").Merge .Rows("1:1").RowHeight = 30 .Range("A1:H1").FormulaR1C1 = "CMM" .Range("A1:H1").Font.Size = 26 .Range("A1:H1").HorizontalAlignment = xlCenter .Cells(2, 1) = "ID" .Cells(2, 2) = "AXIS" .Cells(2, 3) = "Nominal" .Cells(2, 4) = "Measured" .Cells(2, 5) = "Plus" .Cells(2, 6) = "Minus" .Cells(2, 7) = "Deviation" .Cells(2, 8) = "OutTol" .Range("A2:H2").HorizontalAlignment = xlCenter .Range(.Cells(3, 1), .Cells(i + 3, 8)) = arrValue End With Application.ScreenUpdating = True xlApp.ActiveWorkbook.SaveAs FileName:=Text1.Text Set xlSheet = Nothing xlBook.Close Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing End Sub
我要回复

登陆后才能评论

登录
所有回贴(3)
坛子上好多朋友需要数据导出等二次开发操作,但海克斯康的原始程序导出的数据不一定符合要求,以下是程序中的一段主要代码,请参考 不懂的可以提问,共同学习!! Private Sub Command2_Click() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim app As PCDLRN.Application Dim cmds As PCDLRN.Commands Dim cmd As PCDLRN.Command Dim part As PCDLRN.PartProgram Dim lngR As Long Dim lngC As Long Dim i As Long Dim arrValue() As String Dim strName As String ReDim arrValue(5000, 8) If Text1.Text = "" Then MsgBox "无效保存路径!", vbCritical + vbOKOnly, "提示" Exit Sub End If Set app = CreateObject("PCDLRN.Application") Set part = app.ActivePartProgram Set cmds = part.Commands lngR = 0 lngC = 0 i = 1 For Each cmd In cmds If cmd.IsDimension Then If cmd.Type = DIMENSION_TRUE_START_POSITION Or cmd.Type = DIMENSION_END_LOCATION Or cmd.Type = DIMENSION_START_LOCATION Or cmd.Type = DIMENSION_TRUE_END_POSITION Or cmd.Type = DIMENSION_2D_DISTANCE Or cmd.Type = DIMENSION_3D_DISTANCE Or cmd.Type = DIMENSION_FLATNESS Then arrValue(lngR + i, lngC + 1) = cmd.DimensionCommand.ID: strName = cmd.DimensionCommand.ID Else arrValue(lngR + i, lngC + 1) = strName End If If cmd.Type = DIMENSION_2D_DISTANCE Or cmd.Type = DIMENSION_3D_DISTANCE Or cmd.Type = DIMENSION_FLATNESS Or cmd.Type = DIMENSION_X_LOCATION Or cmd.Type = DIMENSION_Y_LOCATION Or cmd.Type = DIMENSION_Z_LOCATION Or cmd.Type = DIMENSION_T_LOCATION Then Select Case cmd.Type Case DIMENSION_X_LOCATION arrValue(lngR + i, lngC + 2) = "X" Case DIMENSION_Y_LOCATION arrValue(lngR + i, lngC + 2) = "Y" Case DIMENSION_Z_LOCATION arrValue(lngR + i, lngC + 2) = "Z" Case DIMENSION_T_LOCATION arrValue(lngR + i, lngC + 2) = "T" Case DIMENSION_2D_DISTANCE arrValue(lngR + i, lngC + 2) = "2D距离" Case DIMENSION_FLATNESS arrValue(lngR + i, lngC + 2) = "平面度" Case DIMENSION_3D_DISTANCE arrValue(lngR + i, lngC + 2) = "3D距离" End Select arrValue(lngR + i, lngC + 3) = Format(cmd.DimensionCommand.NOMINAL, "0.00") arrValue(lngR + i, lngC + 4) = Format(cmd.DimensionCommand.Measured, "0.00") arrValue(lngR + i, lngC + 5) = cmd.DimensionCommand.Plus arrValue(lngR + i, lngC + 6) = -cmd.DimensionCommand.Minus arrValue(lngR + i, lngC + 7) = Format(cmd.DimensionCommand.Deviation, "0.00") arrValue(lngR + i, lngC + 8) = Format(cmd.DimensionCommand.OutTol, "0.00") i = i + 1 End If End If DoEvents Next cmd Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add xlApp.Visible = False Sheets("Sheet1").Name = "Data" Sheets("Sheet2").Delete Sheets("Sheet3").Delete Set xlSheet = xlBook.Worksheets("Data") With xlSheet .Range("A1:H1").Merge .Rows("1:1").RowHeight = 30 .Range("A1:H1").FormulaR1C1 = "CMM" .Range("A1:H1").Font.Size = 26 .Range("A1:H1").HorizontalAlignment = xlCenter .Cells(2, 1) = "ID" .Cells(2, 2) = "AXIS" .Cells(2, 3) = "Nominal" .Cells(2, 4) = "Measured" .Cells(2, 5) = "Plus" .Cells(2, 6) = "Minus" .Cells(2, 7) = "Deviation" .Cells(2, 8) = "OutTol" .Range("A2:H2").HorizontalAlignment = xlCenter .Range(.Cells(3, 1), .Cells(i + 3, 8)) = arrValue End With Application.ScreenUpdating = True xlApp.ActiveWorkbook.SaveAs FileName:=Text1.Text Set xlSheet = Nothing xlBook.Close Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing End Sub
2011-07-11 19:47
回复
取消
提交
高手,你有没有关于pc-dmis的常量的详细说明呀?我要中英文对照的,如果有,请发到我邮箱里好吗?多谢了! 邮箱:[email]859027136@qq.com[/email]
2011-07-12 08:09
回复
取消
提交
这个挺好的,不过有很多中尺寸和轴的类型没有处理。 我弄过一个直接从报告中取值的,就是重新组织报告的格式,不过只能针对特定的程序。 学习了。
2011-07-12 14:02
回复
取消
提交
在线咨询
关注我们

海克斯康制造智能

电话咨询
400-6580-400

热线电话(工作时间8:30-17:30)

关注我们 电话咨询 在线咨询

海克斯康制造智能