Jump to content

Welcome to eMastercam

Register now to participate in the forums, access the download area, buy Mastercam training materials, post processors and more. This message will be removed once you have signed in.

Use your display name or email address to sign in:

Recommended Posts

Hi All, I have the following snippet:

 

bRet = AskExcelValue(strCellF, dblBarrelPosition)' Grab barrel Position (Z Value for the Lathe)

If bRet = False Then ' Exit clean if value in column F is not a valid input

ShowString(" Incorrect Value in cell " & strCellF )

Exit Do

End If

 

Question is Is there any way to get a value from the a specific sheet? the excel file will have 4 different sheets that I need to retrieve values from. I will have the name of the sheet already

 

Thanks

Karl

Link to comment
Share on other sites

Truth be told, I never used the .ExcelFilemanager routines because I didnt see support for multiple sheets,

and I use multiple sheets/workbooks constantly. So I write my own.

 

Below is some old-fashioned, late-binding OLE code that will work with many versions of Excel. Using this method,

you can read/write from multiple worksheets, in multiple workbooks, simultaneously. It's part of a routine

that Opens a workbook, gets a specific worksheet, then loops down the rows reading multiple columns, assigning the

data to an array of structures. (Specifically, it reads in tool data to make MCX tool libraries). It stops reading

rows once it runs into blank cells. Modify to suit your taste.

 


Imports Mastercam.Support

Module Module1
   Const XL_SPREADSHEET_FILESPEC As String = "C:\TMP\tooling list.xls"   ' Filespec of your file
   Const XL_TOOLSHEET_NAME As String = "TOOLDATA"                        ' Sheet name
   Const MAX_BLANK_XL_ROWS As Integer = 4  ' number of consecutive blank rows to read before quitting

   ' Store Tool data into Structure
   Structure McxToolType
       Dim intToolNum As Integer
       Dim dblToolDia As Double
       Dim intDiaOffset As Integer
       Dim dblToolLen As Double
       Dim intLenOffset As Double
       Dim dblFluteLen As Double
       Dim strToolType As String
       Dim dblCornerRad As Double
       Dim strToolName As String
   End Structure

   Dim arrToolInfo() As McxToolType
   Dim intToolCount As Integer = -1

   Public Function GetXlTools() As Boolean
       ' opens Spreadsheet and Reads In Tool Info


       Dim objExcel As Object = Nothing
       Dim objWkBook As Object = Nothing
       Dim objWkSheet As Object = Nothing
       Dim StartXlRow As Integer = 0
       Dim singleToolData As McxToolType
       Dim blDataValid As Boolean = False
       Dim BlankRowCount As Integer = 0
       Dim OurFiles As String = String.Empty


       intToolCount = -1         ' RESET ARRAY BOUNDS
       Mastercam.IO.PromptManager.Clear()
       Mastercam.IO.PromptManager.WriteString("Reading Tools from Excel ....")


       ' ensure we have our file at the correct locations
       Try
           OurFiles = Dir(XL_SPREADSHEET_FILESPEC)
       Catch ex As Exception
       End Try

       If OurFiles = "" Then
           MsgBox("Cannot Locate the Tool SpreadSheet file at:" & vbCrLf & XL_SPREADSHEET_FILESPEC)
           GetXlTools = False : Exit Function
       End If

       ' Start Excel and get Application object.
       objExcel = CreateObject("Excel.Application")

       ' Open Our WorkBook
       objWkBook = objExcel.Workbooks.Open(XL_SPREADSHEET_FILESPEC, False, True)
       If Not (objWkBook Is Nothing) Then   ' we have our workbook, get the worksheet

           objWkSheet = objWkBook.Sheets(XL_TOOLSHEET_NAME) ' see if we can get our worksheet
           If Not (objWkSheet Is Nothing) Then
               ' Parse Down and Read the data
               For StartXlRow = 1 To 1000   ' read in max tool data
                   singleToolData.intToolNum = objWkSheet.Cells(StartXlRow, 1).value
                   singleToolData.dblToolDia = objWkSheet.Cells(StartXlRow, 2).value
                   singleToolData.intDiaOffset = objWkSheet.Cells(StartXlRow, 3).value
                   singleToolData.dblToolLen = objWkSheet.Cells(StartXlRow, 4).value
                   singleToolData.intLenOffset = objWkSheet.Cells(StartXlRow, 5).value
                   singleToolData.dblFluteLen = objWkSheet.Cells(StartXlRow, 6).value
                   singleToolData.strToolType = objWkSheet.Cells(StartXlRow, 7).value
                   singleToolData.dblCornerRad = objWkSheet.Cells(StartXlRow, 8).value
                   singleToolData.strToolName = objWkSheet.Cells(StartXlRow, 9).value

                   ' Now check the validity of the data
                   blDataValid = True
                   If singleToolData.intToolNum = 0 Then blDataValid = False
                   If singleToolData.dblToolDia < 0.001 Then blDataValid = False
                   If singleToolData.intDiaOffset = 0 Then blDataValid = False
                   If singleToolData.dblToolLen <= 0.001 Then blDataValid = False
                   If singleToolData.intLenOffset = 0 Then blDataValid = False
                   If singleToolData.dblFluteLen <= 0.001 Then blDataValid = False
                   If singleToolData.strToolType = "" Then blDataValid = False

                   ' if blDataValid = True then we can add the record
                   If blDataValid = True Then
                       BlankRowCount = 0
                       intToolCount = intToolCount + 1
                       ReDim Preserve arrToolInfo(intToolCount)
                       arrToolInfo(intToolCount) = singleToolData
                   Else
                       BlankRowCount = BlankRowCount + 1
                       If BlankRowCount > MAX_BLANK_XL_ROWS Then Exit For
                   End If
               Next
           End If
       End If

       Mastercam.IO.PromptManager.WriteString(intToolCount + 1 & " Tool Records retrieved")
       If intToolCount > -1 Then GetXlTools = True

       ' close excel
       Try
           objWkBook.Close(False)
           objExcel.Quit()
           ReleaseObj(objWkSheet)
           ReleaseObj(objWkBook)
           ReleaseObj(objExcel)
       Catch ex As Exception
       End Try

       GC.Collect()

   End Function

   Private Sub ReleaseObj(ByVal o As Object)
       Try
           System.Runtime.InteropServices.Marshal.ReleaseComObject(o)
       Catch ex As Exception
       Finally
           o = Nothing
       End Try
   End Sub
End Module

Link to comment
Share on other sites

Thanks for the reply. I was looking for something using mastercam VBA but maybe this can be made to work. I'll try to massage this and if I come up with anything I'll post here.

 

Karl

 

oops! You are using VBSCript ?

 

Below is another snippet, in VBScript, not written by me... and no author name, so Im unable to give credit.

' -- Start Script
Call Main()


' ////////////////////
' Sub Declaration
' ////////////////////
Sub Main()

  ' On Error Resume Next

   Dim CellPart1, K, XLString1, CellPart2, CellPart3, CellPart4 
   Dim strData, strResults

   Dim xlExcel, xlWorkBook, xlWorkSheet

   ' -- Check for Excel first
   Set xlExcel = CreateObject("Excel.Application")

   If xlExcel Is Nothing Then
      ShowString "Excel is not installed on this PC"
      Exit Sub
   End If     

   ' -- Prompt for a file
   If Not AskForFileName(".XLS", mcFILE_ACCESS_READ , strData)  Then Exit Sub     

   ' -- Get the workbook
   Set xlWorkBook = xlExcel.Workbooks.Open(strData)

   ' -- Get the first worksheet
   Set xlWorkSheet = xlWorkbook.Worksheets(1)

   ' -- Loop 19 rows 
   For K = 1 To 19

        CellPart1 = "A"& K
        CellPart2 = "B"& K
        CellPart3 = "C"& K
        CellPart4 = "D"& K

        strResults = xlWorkSheet.Range(CellPart1).Text & " is in " & CellPart1 &  vbCrLf & _
                     xlWorkSheet.Range(CellPart2).Text & " is in " & CellPart2 &  vbCrLf & _
                     xlWorkSheet.Range(CellPart3).Text & " is in " & CellPart3 &  vbCrLf & _
                     xlWorkSheet.Range(CellPart4).Text & " is in " & CellPart4

        ShowString strResults

    Next

  ' -- Cool?  
  If Err Then
     ShowString "Error occured in Sub Main: " & Err.Description
  End If

 ' -- Release Excel  
 If Not xlExcel Is Nothing Then
     xlExcel.Quit
     Set xlExcel = Nothing
  End If        


End Sub

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.

Join us!

eMastercam - your online source for all things Mastercam.

Together, we are the strongest Mastercam community on the web with over 56,000 members, and our online store offers a wide selection of training materials for all applications and skill levels.

Follow us

×
×
  • Create New...