Sub Main()
  ' writes Dimension-data to excel sheet
  ' the excel sheet must be saved manually
  
  ' Dim Something
    Dim pcDMISApp As Object
    Set pcDMISApp = CreateObject("PCDLRN.Application")
    Dim pcDMISPart As Object
    Set pcDMISPart = pcDMISApp.ActivePartProgram
    Dim pcDMISCmds As Object
    Set pcDMISCmds = pcDMISPart.Commands
    Dim pcDMISCmd As Object
    Dim pcDMISDIMCmd As Object
  
    Dim objExcel As Object
    Dim objNewBook As Object
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    Dim sPath, sTemp, sTemp2 As String
    Dim iRowCount, iIndex, iType As Integer
    Dim dMeas, dTol As Double

  ' write excel heading
    objExcel.ScreenUpdating = False
    objNewBook.Sheets(1).Cells(1, 1).Value = "ID"
    objNewBook.Sheets(1).Cells(1, 2).Value = "Ref"
    objNewBook.Sheets(1).Cells(1, 3).Value = "AxisLetter"
    objNewBook.Sheets(1).Cells(1, 4).Value = "Nominal"
    objNewBook.Sheets(1).Cells(1, 5).Value = "Measured"
    objNewBook.Sheets(1).Cells(1, 6).Value = "Plus"
    objNewBook.Sheets(1).Cells(1, 7).Value = "Minus"
    objNewBook.Sheets(1).Cells(1, 8).Value = "OutTol"
    objNewBook.Sheets(1).Cells(1, 9).Value = "Length"
    objNewBook.Sheets(1).Cells(1, 10).Value = "Deviation"
    objNewBook.Sheets(1).Cells(1, 11).Value = "Max"
    objNewBook.Sheets(1).Cells(1, 12).Value = "Min"
    objNewBook.Sheets(1).Cells(1, 13).Value = "Bonus"
    objNewBook.Sheets(1).Cells(1, 14).Value = "Units"
    objNewBook.Sheets(1).Cells(1, 15).Value = "Standard"
    
  ' search pcDMIS for Dimension command
    iRowCount = 2
    For Each pcDMISCmd In pcDMISCmds
      ' ### get Command Type ###################################################
        iType = -1
        If (pcDMISCmd.IsDimension) Then iType = 1
        If (pcDMISCmd.Type = FEATURE_CONTROL_FRAME) Then iType = 2
        If (pcDMISCmd.Type = ISO_TOLERANCE_COMMAND) Or (pcDMISCmd.Type = ASME_TOLERANCE_COMMAND) Then iType = 3
        If (pcDMISCmd.Type = ISO_SIZE_COMMAND) Or (pcDMISCmd.Type = ASME_SIZE_COMMAND) Then iType = 4
        If iType = -1 Then GoTo nextLoopIndex
      
      ' ### select Type ###################################################
        Select Case iType
          Case 1 'Dimension
              If pcDMISCmd.Type = DATDEF_COMMAND Then GoTo nextLoopIndex
              If pcDMISCmd.GetText(ID, 0) <> "" Then
                If (pcDMISCmd.GetText(REF_ID, 2) <> pcDMISCmd.GetText(REF_ID, 1)) Then
                  sTemp = pcDMISCmd.GetText(ID, 0)
                  sTemp2 = pcDMISCmd.GetText(REF_ID, 1) + "; " + pcDMISCmd.GetText(REF_ID, 2)
                Else
                  sTemp = pcDMISCmd.GetText(ID, 0)
                  sTemp2 = pcDMISCmd.GetText(REF_ID, 0)
                End If
              End If

              If pcDMISCmd.Type = DIMENSION_START_LOCATION Then GoTo nextLoopIndex
              If pcDMISCmd.Type = DIMENSION_END_LOCATION Then GoTo nextLoopIndex
              If pcDMISCmd.Type = DIMENSION_START_LOCATION Then
                sTemp = pcDMISCmd.GetText(ID, 0)
                sTemp2 = pcDMISCmd.GetText(REF_ID, 0)
                GoTo nextLoopIndex
              End If
              
            ' get DimensionCommand
              Set pcDMISDIMCmd = pcDMISCmd.DimensionCommand
          
            ' write DimensionCommand data to Excel
              objNewBook.Sheets(1).Cells(iRowCount, 1).Value = sTemp 'ID
              objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp2 'ref-Feature ID
              objNewBook.Sheets(1).Cells(iRowCount, 3).Value = pcDMISDIMCmd.AxisLetter
              objNewBook.Sheets(1).Cells(iRowCount, 4).Value = pcDMISDIMCmd.Nominal
              objNewBook.Sheets(1).Cells(iRowCount, 5).Value = pcDMISDIMCmd.Measured
              objNewBook.Sheets(1).Cells(iRowCount, 6).Value = pcDMISDIMCmd.Plus
              objNewBook.Sheets(1).Cells(iRowCount, 7).Value = pcDMISDIMCmd.Minus
              objNewBook.Sheets(1).Cells(iRowCount, 8).Value = pcDMISDIMCmd.OutTol
              objNewBook.Sheets(1).Cells(iRowCount, 9).Value = pcDMISDIMCmd.Length
              objNewBook.Sheets(1).Cells(iRowCount, 10).Value = pcDMISDIMCmd.Deviation
              objNewBook.Sheets(1).Cells(iRowCount, 11).Value = pcDMISDIMCmd.Max
              objNewBook.Sheets(1).Cells(iRowCount, 12).Value = pcDMISDIMCmd.Min
              objNewBook.Sheets(1).Cells(iRowCount, 13).Value = pcDMISDIMCmd.Bonus
              If pcDMISDIMCmd.Units = 1 Then
                objNewBook.Sheets(1).Cells(iRowCount, 14).Value = "MM"
              Else
                objNewBook.Sheets(1).Cells(iRowCount, 14).Value = "INCH"
              End If
              objNewBook.Sheets(1).Cells(iRowCount, 15).Value = ""
              
            ' new Excel row
              iRowCount = iRowCount + 1
              
          Case 2 'FCF
            ' write ExMeas-Command data to Excel
              iIndex = 1
              sTemp = pcDMISCmd.GetText(LINE2_FEATNAME, iIndex)
              Do While sTemp <> ""
                objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.ID
                objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp
                objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "FCF"  'AxisLetter
          
                dTol = pcDMISCmd.GetText(LINE2_TOL, 0)
                dMeas = pcDMISCmd.GetText(LINE2_DEV, iIndex)

                objNewBook.Sheets(1).Cells(iRowCount, 4).Value = 0    'Nominal
                objNewBook.Sheets(1).Cells(iRowCount, 5).Value = dMeas  'Measured
                objNewBook.Sheets(1).Cells(iRowCount, 6).Value = dTol   'Plus
                objNewBook.Sheets(1).Cells(iRowCount, 7).Value = 0  'Minus
                If dMeas > dTol Then
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = dTol - dMeas  'OutTol
                Else
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = 0  'OutTol
                End If
                objNewBook.Sheets(1).Cells(iRowCount, 9).Value = 0   'Length
                objNewBook.Sheets(1).Cells(iRowCount, 10).Value = dMeas  'Deviation
                objNewBook.Sheets(1).Cells(iRowCount, 11).Value = 0  'Max
                objNewBook.Sheets(1).Cells(iRowCount, 12).Value = 0  'Min
                objNewBook.Sheets(1).Cells(iRowCount, 13).Value = pcDMISCmd.GetText(LINE2_BONUS, iIndex)  'Bonus
                objNewBook.Sheets(1).Cells(iRowCount, 14).Value = pcDMISCmd.GetText(UNIT_TYPE, 0)  'Units
                objNewBook.Sheets(1).Cells(iRowCount, 15).Value = pcDMISCmd.GetText(STANDARD, 0)
          
          
              ' new GeoTol Row
                iIndex = iIndex + 1
                sTemp = pcDMISCmd.GetText(LINE2_FEATNAME, iIndex)
                
              ' new Excel row
                iRowCount = iRowCount + 1
              Loop
              
          Case 3 'GEO
            ' write GeoTol-Command data to Excel
              iIndex = 1
              sTemp = pcDMISCmd.GetText(REF_ID, iIndex)
              Do While sTemp <> ""
                objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.ID
                objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp
                objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "GEO"  'AxisLetter
          
                dTol = pcDMISCmd.GetText(FORM_TOLERANCE, 1)
                dMeas = pcDMISCmd.GetTextEx(DIM_DEVIATION, iIndex, "SEG=1")

                objNewBook.Sheets(1).Cells(iRowCount, 4).Value = 0    'Nominal
                objNewBook.Sheets(1).Cells(iRowCount, 5).Value = dMeas  'Measured
                objNewBook.Sheets(1).Cells(iRowCount, 6).Value = dTol   'Plus
                objNewBook.Sheets(1).Cells(iRowCount, 7).Value = 0  'Minus
                If dMeas > dTol Then
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = dTol - dMeas  'OutTol
                Else
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = 0  'OutTol
                End If
                objNewBook.Sheets(1).Cells(iRowCount, 9).Value = 0   'Length
                objNewBook.Sheets(1).Cells(iRowCount, 10).Value = dMeas  'Deviation
                objNewBook.Sheets(1).Cells(iRowCount, 11).Value = 0  'Max
                objNewBook.Sheets(1).Cells(iRowCount, 12).Value = 0  'Min
                objNewBook.Sheets(1).Cells(iRowCount, 13).Value = pcDMISCmd.GetTextEx(DIM_BONUS, iIndex, "SEG=1")  'Bonus
                objNewBook.Sheets(1).Cells(iRowCount, 14).Value = pcDMISCmd.GetText(UNIT_TYPE, 0)   'Units
                objNewBook.Sheets(1).Cells(iRowCount, 15).Value = pcDMISCmd.GetText(STANDARD, 0)   'STANDARD
          
              ' new GeoTol Row
                iIndex = iIndex + 1
                sTemp = pcDMISCmd.GetText(REF_ID, iIndex)
                
              ' new Excel row
                iRowCount = iRowCount + 1
              Loop
              
          Case 4 'Size
            ' write ToleranceCommand data to Excel
              objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.GetText(ID, 0)
              objNewBook.Sheets(1).Cells(iRowCount, 2).Value = pcDMISCmd.GetText(REF_ID, 0)
              objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "SIZE"
          
              objNewBook.Sheets(1).Cells(iRowCount, 4).Value = pcDMISCmd.GetText(Nominal, 0)   'Nominal
              objNewBook.Sheets(1).Cells(iRowCount, 5).Value = CDbl(pcDMISCmd.GetText(Nominal, 0)) + CDbl(pcDMISCmd.GetText(DIM_DEVIATION, 0)) 'Measured
              objNewBook.Sheets(1).Cells(iRowCount, 6).Value = pcDMISCmd.GetText(UPPER_TOLERANCE, 0)   'Plus
              objNewBook.Sheets(1).Cells(iRowCount, 7).Value = pcDMISCmd.GetText(LOWER_TOLERANCE, 0)  'Minus
              objNewBook.Sheets(1).Cells(iRowCount, 8).Value = 0    'OutTol
              objNewBook.Sheets(1).Cells(iRowCount, 9).Value = 0   'Length
              objNewBook.Sheets(1).Cells(iRowCount, 10).Value = pcDMISCmd.GetText(DIM_DEVIATION, 0)  'Deviation
              objNewBook.Sheets(1).Cells(iRowCount, 11).Value = 0  'Max
              objNewBook.Sheets(1).Cells(iRowCount, 12).Value = 0  'Min
              objNewBook.Sheets(1).Cells(iRowCount, 13).Value = 0  'Bonus
              objNewBook.Sheets(1).Cells(iRowCount, 14).Value = pcDMISCmd.GetText(UNIT_TYPE, 0) 'Units
              objNewBook.Sheets(1).Cells(iRowCount, 15).Value = pcDMISCmd.GetText(STANDARD, 0)
          
            ' new Excel row
              iRowCount = iRowCount + 1
              
        End Select
      
nextLoopIndex:
    Next pcDMISCmd

    
  ' close excel
    objExcel.ScreenUpdating = True
    objExcel.Visible = True
    sPath = "C:\Users\qs\Desktop\TEST.XLSX"
    'objNewBook.SaveAs sPath
    'objExcel.Quit

  ' unDim Something
    Set objNewBook = Nothing
    Set objExcel = Nothing
    Set pcDMISCmd = Nothing
    Set pcDMISCmds = Nothing
    Set pcDMISPart = Nothing
    Set pcDMISApp = Nothing
End Sub