Hi! I am Korean PC-DMIS User.
I Use excel report basic script.
But my script can report only regacy dimension data.
If I report GD&T geometric data, my script can't report to excel.
How can I use regacy + GD&T data to report excel file?
Please, Support.
------------------------- Our Script File ------------------------
Sub Main
'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer
'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
Set xlWorkbook = xlWorkbooks.Open("c:\cmmdata\성적서.xls")
Set xlSheet = xlWorkbook.Worksheets(1)
'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
'Write data
xlSheet.Range("A2").Value = "Dimension"
xlSheet.Range("B2").Value = "Axis"
xlSheet.Range("C2").Value = "Nominal"
xlSheet.Range("D2").Value = "Measured"
xlSheet.Range("E2").Value = "Plus"
xlSheet.Range("F2").Value = "Minus"
xlSheet.Range("G2").Value = "Deviation"
xlSheet.Range("H2").Value = "Out of Tolerance"
count=3
For Each Cmd In Cmds
If Cmd.IsDimension Then
If Cmd.Type = DIMENSION_START_LOCATION Then
Set DcmdID = Cmd.DimensionCommand
DimID = DcmdID.ID
End If
If Cmd.Type <> DIMENSION_START_LOCATION And _
Cmd.Type <> DIMENSION_END_LOCATION And _
Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
Set DCmd = Cmd.DimensionCommand
If DCmd.ID = "" Then
xlSheet.Range("A" & count).Value = DimID
xlSheet.Range("B" & count).Value = DCmd.AxisLetter
Else
xlSheet.Range("A" & count).Value = DCmd.ID
xlSheet.Range("B" & count).Value = "M"
End If
xlSheet.Range("C" & count).Value = DCmd.Nominal
xlSheet.Range("D" & count).Value = DCmd.Measured
xlSheet.Range("E" & count).Value = DCmd.Plus
xlSheet.Range("F" & count).Value = DCmd.Minus
xlSheet.Range("G" & count).Value = DCmd.Deviation
xlSheet.Range("H" & count).Value = DCmd.OutTol
count=count+1
End If
End If
Next Cmd
'Save And Cleanup
Set xlSheet = Nothing
SaveName = "C:\cmmdata\" & Part.partname & Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & ".xls"
xlWorkBook.SaveAs SaveName
xlWorkbook.Close
Set xlWorkbook = Nothing
xlWorkbooks.Close
Set xlWorkbooks = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
