Welcome to eMastercam

January 17, 2017

I updated the Script, works better. Has more functionality and more ways to safely exit.

January 16, 2017

'////////////////////////////////////////////////////////////////////////////////
'//
'//        Author:   Jesse T.
'//       Credits:   Mick George [email protected] (I learned from his examples)
'//          Date:   06/2016
'//     File Name:   Fixture Plate Setup.vbs
'//
'//   Description:   This script Imports solids and moves them to fixture locations
'//
'////////////////////////////////////////////////////////////////////////////////

' ////////////////////
' Constants
' ////////////////////
Const ZZero = 0
Const Origin = 0
Const TopView = 1

' -- Start Script
Call Main()

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

Dim intLevelNumber
Dim iX, iY, SetDistX, SetDistY, intCountX, intCountY
Dim File_or_Level
Dim Sort_or_Center
Dim SetAngle
Dim NumParts

' -- Initialize
SetAngle = 0
SetDistX = 2.0
SetDistY = 2.0
intCountX = 2
intCountY = 2
intLevelNumber = 2
NumParts = 0
' -- Ask our user for some values
   File_or_Level = askYesNoCancel("This VB Script will help you set up multiple parts on a fixture plate."_
     &VbCrLf&"""CANCEL"" if you want to exit this VBScript."_
     &VbCrLf&"""NO"" if your parts are on seperate LEVELS and the file is already open"_
     &VbCrLf&"""YES"" if your parts are in seperate FILES"_
     &VbCrLf&VbCrLf&"		FILES	          LEVELS	    CANCEL")
  If File_or_Level = 0 Then
   Sort_or_Center = askYesNoCancel("If you want to move your parts to center select ""YES"""_
     &VbCrLf&"If you want to layout a fixture plate select ""No"""_
     &VbCrLf&VbCrLf&"   Parts NOT on center     Parts on center    CANCEL")
  End If
   If File_or_Level = -1 Then Exit Sub
   If Sort_or_Center = -1 Then Exit Sub
  If Sort_or_Center = mcMSG_NO Then
   If Not askValue("Do you have to rotate the part?", -360 , 360, SetAngle) Then Exit Sub
  End If
   If Not askNumber("How many Parts along the X axis?", 1 , 50, intCountX) Then Exit Sub
   If Not askNumber("How many parts along the Y axis?", 1 , 50, intCountY) Then Exit Sub
   If Not askValue("Input X spacing of Parts", 0 , 20, SetDistX) Then Exit Sub
   If Not askValue("Input Y spacing of Parts", 0 , 20, SetDistY) Then Exit Sub

   ' -- Do some math
   Redim Preserve arrPartPosX(intCountX*intCountY)
   Redim Preserve arrPartPosY(intCountX*intCountY)
      For iY = 0 To intCountY - 1
         For iX = 0 To intCountX - 1
         arrPartPosX(NumParts) = (iX * SetDistX)-(((intCountX-1)*SetDistX)/2)
         arrPartPosY(NumParts) = (-(iY * SetDistY))+(((intCountY-1)*SetDistY)/2)
'ShowString "Part# "& NumParts + 1 &" = "& arrPartPosX(NumParts)&", "&arrPartPosY(NumParts)
         NumParts = NumParts + 1
	     Next
      Next
   Call Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)
End Sub
' ////////////////////
' The Sub that does it all
' ////////////////////
Sub Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)

Dim YLoc
Dim XLoc
Dim strLevelName
Dim Revert_Back

Redim Preserve arrLevelUsed(intCountX*intCountY)

'Loads files and translates into fixture locations
If File_or_Level = mcMSG_YES And Sort_or_Center = mcMSG_NO Then
          ShowString "Please select a starting level, parts will load in sequential levels"
          If askLevel(intLevelNumber) Then
   ' -- Rotate and Position Parts
      For NumParts = 0 To (intCountX*intCountY) - 1
      strLevelName = "Position #" & NumParts + 1
        If mc_appversion < 19 Then 'Renames levels if MCam is older than 2017 Version
         Call SetLevelName (intLevelNumber, strLevelName)
        End If
   	     YLoc = arrPartPosY(NumParts)
         XLoc = arrPartPosX(NumParts)
         arrLevelUsed(NumParts) = intLevelNumber
             SetLevelVisibleByNumber intLevelNumber, False
             SelectAll()
             SetLevelByNumber (intLevelNumber)
             Call RepaintScreen(True)
             Call RunMastercamCommand ("DoPattern")
             SetLevelVisibleByNumber intLevelNumber,True
             Call RunMastercamCommand ("GSInvertSelection")
If StartDBSearch(mc_selected, -1)= 0  Then NumParts = (intCountX*intCountY) - 1
             Rotate Origin, Origin, Origin, SetAngle, False
             SetLevelVisibleByNumber intLevelNumber, False
             SelectAll()
             SetLevelByNumber (intLevelNumber)
             SetLevelVisibleByNumber intLevelNumber,True
             Call RunMastercamCommand ("GSInvertSelection")
             Call Move_to_location(XLoc, YLoc, NumParts)
         intLevelNumber = intLevelNumber + 1
      Next
          End If
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts

'Translates individual levels into fixture locations
If File_or_Level = mcMSG_NO And Sort_or_Center = mcMSG_NO Then
   ' -- Rotate and Position Parts
   For NumParts = 0 To (intCountX*intCountY) - 1
      intLevelNumber = intLevelNumber + 1
   	  YLoc = arrPartPosY(NumParts)
      XLoc = arrPartPosX(NumParts)
        If askLevel(intLevelNumber) Then
          arrLevelUsed(NumParts) = intLevelNumber
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Rotate Origin, Origin, Origin, SetAngle, False
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Call Move_to_location(XLoc, YLoc, NumParts)
        End If
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts
'---- Unsorts individual parts to center
If Sort_or_Center = mcMSG_YES Then
   For NumParts = 0 To (intCountX*intCountY) - 1
   	  YLoc = -arrPartPosY(NumParts)
      XLoc = -arrPartPosX(NumParts)
        If AskForEntity("SELECT PART #"&numparts+1,-1) Then
          arrLevelUsed(NumParts) = GetEntityLevel()
          Call Move_to_location(XLoc, YLoc, NumParts)
          Rotate Origin, Origin, Origin, - SetAngle, False
        End If
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts

Revert_Back = askYesNo("Do you want to keep these new locations?")
'---- Reverses Translated individual levels back to original locations
If Revert_Back = mcMSG_NO Then
   For NumParts = 0 To (intCountX*intCountY) - 1
      intLevelNumber = arrLevelUsed(NumParts)
If Sort_or_Center = mcMSG_YES Then
   	  YLoc = arrPartPosY(NumParts)
      XLoc = arrPartPosX(NumParts)
Else
   	  YLoc = -arrPartPosY(NumParts)
      XLoc = -arrPartPosX(NumParts)
End If
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Call Move_to_location(XLoc, YLoc, NumParts)
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Rotate Origin, Origin, Origin, - SetAngle, False
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts 
If askYesNo("Repeat the same setup?") = mcMSG_YES Then
   Call Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)
End If
End Sub

' ////////////////////
' Sub Declaration
' ////////////////////

Sub Move_to_location(XLoc, YLoc, NumParts)   

Const DEF_GIVE_ME_EVERYTHING = -1

Dim bRet

bRet = StartDBSearch(mc_selected, DEF_GIVE_ME_EVERYTHING)

   If bRet Then
     Do 
       ' Change the location of each "selected" entity that we find. 
       Call Translate (Origin, Origin, Origin, XLoc, YLoc, ZZero, TopView, TopView, False)
       bRet = NextDBSearch    
     Loop While bRet  
   End If
' Like it says...
UnselectAll()

End Sub

I accidental deleted my original post. Here is an updated version that has more options. (This one works MUCH better).

This script will sort or un-sort parts into a grid so they can be cut on a fixture plate. The reason I made this is because we typically get .X_T files of several parts that are pretty much the same except for cavity numbers or stacking lugs. Sometimes we'll get a single file with each part on it's own level, other times we'll get each individual part in it's own .X_t file. I feel I don't contribute enough to this forum to make up for how much help I've received. Hopefully this script will help someone else out.

Just copy and paste the code into a text file and save that file as "Fixture Plate Setup.vbs" then run within MasterCam.

July 3, 2016

Are all your planes set to the same WCS?

May 15, 2015

be,

Are you using the script above? I am not exactly clear on your problem, can you shed a little more light on the exact steps you take etc.

HI Mick

BTW, thanks for all your help on the Script! I've made a lot of changes since you last saw it, but learned a lot from what you had before I fiddled with it.

I can't seem to figure out how to get the script to create a setup sheet according to each individual machine group. The tools get recorded from all the operations in the program, but it seems to be random as to which of the tools it decides to record.

An example would be if I have two machine groups (each of which have a different NCI file name), but I have T1 as a 3/4" ST in the first machine group and T1 is a 1/2" SB in the second machine group. I'm never sure which one is going to be output to the setup sheet.

May 1, 2015

I am trying to use the VBS script from above. It seems to only post the tools from the 1st machine/toolpath group. How do you get it to post from a second machine group?

Unfortunately MasterCam only gives one set of information for each tool number for me to use in the VB Script. I end up deleting the machine group I don't want, creating my setup sheet and re-opening the MasterCam file without saving the modified one. The Active Reports setup sheet that some people in our shop use also seems to have the same problem.

I personally don't like the Active Reports setup sheet since I can't modify the HTML file after it was created and the tool list is displayed out of order if the tools were used out of order in the program. If I accidentally have a tool length wrong I'd have to make the change to the tool and wait for all the segments to regenerate (when using dovetail cutters with Surface/finish/contour this can take a while). Then I have to re-create the setup sheet. I wish I had a better solution. In older versions of MasterCam, the VB Script pulled in the info from whatever Machine group was active, not sure why this went away.

April 19, 2015

So..... I've been obsessing over the VB setup sheet since I "took it over" from John to tweek problems and add functions. One of these "updates" is so that I don't have to re-type all the information for each setup sheet when I have multiple parts for the same job. Not sure how many people will use this but here it is. Please give some feedback if you use it.

'////////////////////////////////////////////////////////////////////////////////
'//
'//        Author:   Jesse Thering, John Thompson, and with MUCH help from Mick George and Bullines!
'//          Date:   02/09/2015
'//     File Name:   New Mastercam Script
'//
'//   Description:   Setupsheet.vbs setup sheet 
'//
'//      Comments:   Job Setup Doc sheet
'//
'////////////////////////////////////////////////////////////////////////////////


'///////////////// My Constants /////////////////


'///////////////// My Global Variables //////////


' -- Start Script


' ////////////////////
' Sub Declaration
' ////////////////////
Dim wordDoc

'///////////////// My Constants ///////////////// 
Dim companyname 
Dim Program 
Dim Description 
Dim Post 
Dim PostName
Dim programmer 
Dim notes 
Dim tlo
Dim whatever
Dim thisstring

Dim nCount ' number of operations
Dim nToolNum ' tool number
Dim arrToolNumber() ' array of tool numbers 
Dim arrToolComment() ' array of tool comments 
Dim arrToolDiameter() ' array of tool diameters 
Dim arrToolFluteLength() ' array of tool flute lengths 
Dim arrToolLength() ' array of tool lengths 
Dim arrOperationType() ' array to store the operation type, Drill = 2, Pocket = 3, transformed operation = 4
dim arrtools(24)
Dim idx 
Dim toolcount 
Dim strText 
Dim Position 
Dim FileName 
Dim graphic 
Dim stockx 
Dim stocky 
Dim stockz 
Dim material 
Dim saveworddoc
dim blah
dim tn
dim tdesc
dim tdiam
dim tflute
Dim toverall

Dim CompanyChar 'Number of characters in company name
Dim DescChar	'Number of characters in Description
Dim FileChar	'Number of Characters in Filename
Dim PIC
Dim LastDotPos

Const wdTabLeaderSpaces = 0


Dim DateTimeFormat()

Const wdAlertsNone=0
Const wdWindowStateMaximize=1
Const wdLine=5
Const wdEnglishUS = 1033
Const wdCalendarWestern = 0
Const wdColorDarkRed=128
Const wdAlignParagraphCenter=1
Const msoTextOrientationHorizontal = 1
Const wdTextOrientationDownward = 3
Const msoFalse=0
Const DEF_SPACING_ONEANDAHALF=1
Const DEF_SPACING_ONE=0
Const wdAlignTabRight = 2
Const wdAlignTabLeft=2
Const Clip_Board="clipbrd"

'///////////////// My Global Variables //////////


' -- Start Script
Call Main()


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

On Error Resume Next

'///////////////// Extract info Constants /////////////////
Dim CurrentFolder
Dim strDOCPath
Dim OldJobInfo
Dim txtBoxTwo
Dim txtBoxFive
Dim arrBoxTwo
Dim arrBoxFive
Dim strCompany
Dim arrCompany
Dim strDesc
Dim arrDesc
Dim strPartNum
Dim arrPartNum
Dim strName
Dim arrName
Const ConfirmConversions = 0
Const Readonly = 1
Const AddToRecentFiles = 0
Const Revert = True
Const wdDoNotSaveChanges = 0

'If extract info= yes, pull info from old setup sheet
If askYesNo ("Do you want to extract job info from a previous setup sheet?")=mcMSG_YES Then
OldJobInfo=1
End If
	If OldJobInfo=1 Then
	CurrentFolder = Left(GetCurrentFileName(),InStrRev(GetCurrentFileName(),"\"))
	FileName= CurrentFolder & ".DOC*"
		If Not (AskForFileName(FileName, mcFILE_ACCESS_READ, strDOCPath)) Then ' Prompt the user for a DOC file.  Bail if the user cancels the dialog.
		ShowString("No file selected")
		Exit Sub
		End If
	Set WordDoc = CreateObject( "Word.Application" )
		wordDoc.Documents.Open strDOCPath,ConfirmConversions,Readonly,AddToRecentFiles, , ,Revert
		With WordDoc
		.Visible = False
		.ActiveDocument.Shapes.Range(2).Select
		.ActiveDocument.Select
		txtBoxTwo=.Selection
		.ActiveDocument.Shapes.Range(5).Select
		.ActiveDocument.Select
		txtBoxFive=.Selection
	.ActiveDocument.Close wdDoNotSaveChanges
	.Quit

Set wordDoc = Nothing
		End With
	End If

'Pull info from individual fields
arrBoxTwo = Split(txtBoxTwo, vbCr)				'Breaks information txt boxes into seperate lines
arrBoxFive = Split(txtBoxFive, vbCr)
arrCompany = Split(arrBoxTwo(0), vbTab)			'extracts company name
	strCompany = arrCompany(1)
If Err.Number = 0 Then
    ' Successfully extracted company name
Else
    ' Maybe someone deleted the Tab?
	strCompany = Replace(arrBoxTwo(0),"Company: ","")
End If
Err.Number = 0
'whatever=AskString("Company", strCompany)
arrDesc = Split(arrBoxTwo(1), vbTab)			'extracts Description
	strDesc = arrDesc(1)
If Err.Number = 0 Then
    ' Successfully extracted Description
Else
    ' Maybe someone deleted the Tab?
	strDesc = Replace(arrBoxTwo(1),"Description: ","")
End If
Err.Number = 0
arrPartNum = Split(arrBoxTwo(2), vbTab)			'extracts Part Number
	strPartNum =arrPartNum(1)
If Err.Number = 0 Then
    ' Successfully extracted Part Number
Else
    ' Maybe someone deleted the Tab?
	strPartNum = Replace(arrBoxTwo(2),"Part Num: ","")
End If
Err.Number = 0
arrName = Split(arrBoxFive(0), vbTab)					'extracts Programmer name
	strName = Replace(arrName(0),"Name: ","")
'////////////////////////////////////////////////////////////////////////////////////////////////

'Gather Info from user
Do
companyname=AskString("Input a company name", strCompany)  'ask until a real company name is entered
Loop While companyname="Company Name?" Or companyname="((ESC))" Or companyname=""  

CompanyChar = Len (companyname)

Do        'ask until a real program number is used
Program=AskString("Part Number?", strPartNum)
Loop While Program="Part Number?" Or Program="" Or Program="((ESC))"

Do        'ask until a real description is used
Description=AskString("Description", strDesc) 
Loop While Description="description" Or Description="" Or Description="((ESC))"

DescChar = Len (Description)

Post=AskString("Post", Left(Mid(Mid(GetPostName(), InStrRev(GetPostName(), "/") + 1), InStrRev(GetPostName(), "\") + 1),_
InStrRev(Mid(Mid(GetPostName(), InStrRev(GetPostName(), "/") + 1), InStrRev(GetPostName(), "\") + 1),".")-1))

Do        'ask until a real programmer name is input
programmer=AskString("Programmer?", strName)
Loop While programmer="programmer?" Or programmer="" Or programmer="((ESC))"

notes=AskString("Notes", "")
    If notes="Notes" Or notes="" Then
    notes=""
    End If

Do        
tlo=AskString("TL0", "TOS")
Loop While tlo="TL0" Or tlo="" Or tlo="((ESC))"

'get stock setup sizes
stockx=GetJobSetupStockSizeX
stocky=GetJobSetupStockSizeY
stockz=GetJobSetupStockSizeZ

    Do
    material=AskString("Material type?", "Aluminum")    
    Loop While material="NONE" Or material="" Or material="Material type?"
    
'check stock size for 0
If stockx=0 Then
    If askYesNo ("Stock size is zero, do you want to change it?")=mcMSG_YES Then
    stockx=AskString ("X stock size?", "")
    stocky=AskString ("Y stock size?", "")
    stockz=AskString ("Z stock size", "")
    End If
End If
   
'Load tool information 

' get the number of operations
nCount = GetOperationCount("") 

If nCount = 0 Then ShowString "No operations found in current drawing": Exit Sub              

Dim id


dim tc
dim doit
Dim temp

whatever=""

For idx = 0 To nCount-1

    ' get the tool number using the current operation
    nToolNum = GetToolNumberFromOperationID("", idx)   
    whatever=formatnumber(idx)
    
    Redim Preserve arrToolNumber(idx)
    Redim Preserve arrToolComment(idx) 
    Redim Preserve arrToolDiameter(idx)
    Redim Preserve arrToolFluteLength(idx)
    Redim Preserve arrToolLength(idx) 
    Redim Preserve arrOperationType(idx)

    arrOperationType(idx)  = GetOperationTypeFromID("", idx)
    
    ' copy tool data into our individual arrays 
    arrToolNumber(idx) = nToolNum
Next

	' Sort Tools in ascending order	
For idx = 0 To Ubound(arrToolNumber) - 1
        For temp = idx + 1 To Ubound(arrToolNumber)
            If (arrToolNumber(idx) > arrToolNumber(temp)) Then
                TN = arrToolNumber(idx)
                arrToolNumber(idx) = arrToolNumber(temp)
                arrToolNumber(temp) = TN
            End If
        Next
    Next

    ' copy tool data into our individual arrays
For idx = 0 To nCount-1
	nToolNum = arrToolNumber(idx)
    arrToolComment(idx) = GetToolComment(nToolNum)     
    arrToolDiameter(idx) = GetToolDiameter(nToolNum)
    arrToolFluteLength(idx) = GetToolFluteLength(nToolNum)
    arrToolLength(idx) = GetToolLength(nToolNum)

Next

'Save number of characters in Filename
FileChar = Len (GetCurrentFileName())

'open word
Set wordDoc=CreateObject("Word.Application")

wordDoc.Documents.Add

With wordDoc  
    .Visible=True
    .WindowState=wdWindowStateMaximize
    .DisplayAlerts=wdAlertsNone
    .Activate
    
    'Sets Margins
    .Selection.PageSetup.LeftMargin = .InchesToPoints(0.5) 'start of margin setting macro
    .Selection.PageSetup.RightMargin = .InchesToPoints(0.5)
    .Selection.PageSetup.TopMargin = .InchesToPoints(0.5)
    .ActiveWindow.ActivePane.VerticalPercentScrolled = 20
    .Selection.PageSetup.BottomMargin = .InchesToPoints(0.5) 'end of margin setting macro
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
    'Puts "Program Info" top center                                                                                 
    .Selection.Font.Bold=True
    .Selection.Font.Size=16
    .Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter
    .Selection.Font.Name="staccato222 BT"
    .Selection.TypeText "PROGRAM INFO"
    .Selection.TypeText vbNewLine
    
    'Puts program number in sideways box, right side
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 525, 75, 45, 117).Select 'start of macro code
    .Selection.ShapeRange.TextFrame.TextRange.Select 
    .Selection.Collapse 
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.ShapeRange.Select
    .Selection.ShapeRange.IncrementLeft 36
    .Selection.ShapeRange.IncrementTop -18
    .Selection.Orientation = wdTextOrientationDownward
    .Selection.Font.Size = 24 
    .Selection.Font.Name="Times New Roman"        
    .Selection.TypeText Program    
    

    'double text boxes for header info

    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20,70, 222.3, 60).Select 'first box left side
    .Selection.ShapeRange.TextFrame.TextRange.Select                                            'First box header info goes this section
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
	.Selection.Font.Size = 12
    .Selection.TypeText "Company: "&vbTab    'Company Name
If CompanyChar > 21 Then
    .Selection.Font.Size = 10
Else If CompanyChar <= 21 Then
    .Selection.Font.Size = 12
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText companyname&vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Description: "&vbTab     'Description
If DescChar > 21 Then
    .Selection.Font.Size = 10
If DescChar > 26 Then
    .Selection.Font.Size = 9
Else If DescChar <= 21 Then
    .Selection.Font.Size = 12
End If
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText Description &vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Part Num: "&vbTab     'Part number
    .Selection.Font.Bold=False
    .Selection.TypeText Program &vbNewLine
    .Selection.Font.Bold=True
    .Selection.Font.Bold=True
    .Selection.TypeText "Material: "&vbTab     'Material type
    .Selection.Font.Bold=False
    .Selection.TypeText material &vbNewLine

    'Second Header box
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 245,70, 320, 60).Select 'second box right side
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
If FileChar >= 48 Then
    .Selection.Font.Size = 9
Else If FileChar < 48 Then
    .Selection.Font.Size = 12
End If
End If
    .Selection.Font.Bold=True
    .Selection.TypeText "Filename: "        'File Name
If FileChar <= 28 Then
    .Selection.TypeText vbTab&vbTab
End If
If FileChar > 34 Then
    .Selection.Font.Size = 10
If FileChar >= 40 Then
    .Selection.Font.Size = 9
If FileChar >= 44 Then
    .Selection.Font.Size = 8
Else If FileChar <= 34 Then
    .Selection.Font.Size = 12
End If
End If
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText GetCurrentFileName()&vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Post: "&vbTab&vbTab&vbTab       'Post
    .Selection.Font.Bold=False
    .Selection.TypeText Post &vbNewLine
    .Selection.Font.Bold=True
    .Selection.TypeText "Stock Size: "&vbTab&vbTab       'Stock size IF in job setup
    .Selection.Font.Bold=False
    .Selection.TypeText "X"&stockx&" Y"&stocky&" Z"&stockz &vbNewLine
    .Selection.Font.Bold=True
    .Selection.TypeText "Stock Origin: "&vbTab     'Stock origin from job setup. Almost always 0,0
    .Selection.Font.Bold=False
    .Selection.TypeText "X"& GetJobSetupStockOriginX&" Y"& GetJobSetupStockOriginY&" (On Center)"&vbNewLine

     'Print out notes
     
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 130, 530, 35).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman" 
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "NOTES: "
    .Selection.Font.Bold=False
    .Selection.TypeText notes

    'Revisions listing
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 168, 575.7, 36).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.6)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3.1)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(4.6)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(6.1)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible=msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Name: "&programmer&vbTab&"Name:________"&vbTab&"Name:________"&vbTab&"Name:_______"&vbTab&"Name:________"&vbNewLine
    .Selection.TypeText "Date: "     'Date
    .Selection.InsertDateTime "M/D/YY", False, False, wdEnglishUS, wdCalendarWestern 'get the date
    .Selection.TypeText vbTab&"Date:________"&vbTab&"Date:________"&vbTab&"Date:_______"&vbTab&"Date:________"         

    'puts out tool list

    'creat 2 text boxes
    'left side box
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 213, 270, 225).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(.4)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.75)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.375)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Tool"&vbTab&"Description"&vbTab&"  "&"Dia "&vbTab&"Flute"&vbTab&"Overall"
    .Selection.Font.Bold=False


    toolcount=1

    For idx=0 To nCount-1
    	If toolcount<=10 Then
				strText = "Transformed operation copy"
				tdesc=Left(arrToolComment(idx),17)
				tdiam=formatnumber(arrToolDiameter(idx),3,0,-2,-2)
				tflute=formatnumber(arrToolFluteLength(idx),2,0,-2,-2)
				toverall=formatnumber(arrToolLength(idx),2,0,-2,-2)
				strText="T"&arrToolNumber(idx)&vbTab&tdesc&vbTab&"  " &tdiam &vbTab&" "&tflute &vbTab&toverall
		thisstring="Left "&formatnumber(idx)&" " & arrtoolnumber(idx)
		'whatever=AskString(thisstring, strText)    
				doit="y"

				for tc=1 to toolcount
					If arrtools(tc)=arrtoolnumber(idx) Then doit="n"
				next

				If arrtoolnumber(idx)="0" Then doit="n"
				if doit<>"n" then Call WriteToWord(strText)
				arrtools(toolcount)=arrtoolnumber(idx)
				If doit<>"n" Then toolcount=toolcount+1

		End If
    Next

    'Right side box
  
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 310, 213, 270, 225).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(.4)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.75)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.375)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Tool"&vbTab&"Description"&vbTab&"  "&"Dia"&vbTab&"Flute"&vbTab&"Overall"
    .Selection.Font.Bold=False
    
    'Second column of tools
    toolcount=1        
        For idx=0 To nCount-1
				strText = "Transformed operation copy"
				tdesc=Left(arrToolComment(idx),17)
				tdiam=formatnumber(arrToolDiameter(idx),3,0,-2,-2)
				tflute=formatnumber(arrToolFluteLength(idx),2,0,-2,-2)
				toverall=formatnumber(arrToolLength(idx),2,0,-2,-2)
          			strText = "T"&arrToolNumber(idx)& vbTab & _
          			tdesc & vbTab &"  " & _
          			tdiam & vbTab&" "& _
          			tflute &vbTab& _
          			toverall
		'whatever=AskString(thisstring, strText)    
				doit="y"

				For tc=1 To toolcount
					If arrtools(tc)=arrtoolnumber(idx) Then doit="n"
				Next
				If arrtoolnumber(idx)="0" Then doit="n"
				If doit<>"n" And toolcount>= 10  Then Call WriteToWord(strText)
				arrtools(toolcount)=arrtoolnumber(idx)
				If doit<>"n" Then toolcount=toolcount+1

    Next
    
    'Put TL0 information in
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 445, 564.3, 35).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Select
    .Selection.ShapeRange.Line.Visible = msoFalse 
    .Selection.Font.Bold=True
    .Selection.TypeText "T.L.0. Location: "
    .Selection.Font.Bold=False
    .Selection.TypeText tlo&vbNewLine
    .Selection.TypeText "_________________________________________________________________________________________" 
        
	'Check for "temp" directory
	Dim fso, fldr, objFolder
   	Set fso = CreateObject("Scripting.FileSystemObject")
	If Not fso.FolderExists("C:\temp") Then
   	Set fldr = fso.CreateFolder("C:\temp")
	Set objFolder = fso.getFolder("C:\temp")
	objFolder.Attributes = 2
   	End If

'Load Graphic into textbox
	Call SetGViewNumber (mcVIEW_TOP)		'  Top view picture
    Call RepaintScreen (True)				'  that is centered	
    graphic="c:\temp\test.emf"
    DoMetafile graphic
         
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 115, _
            480, 390, 302).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
	
	Set PIC = .Selection.InlineShapes.AddPicture (graphic,False,True)
	PIC.LockAspectRatio = True
	Dim Aspect
	Aspect = PIC.Width / PIC.Height
	If (PIC.Width > 520) Then
	PIC.Width = 520
	PIC.Height = PIC.Width / Aspect
	ElseIf (PIC.Height > 260) Then
	PIC.Height = 260
	PIC.Width = PIC.Height * Aspect
	End If
    
    'save word document to same directory as MC file

	'removes file extension
 
 LastDotPos = InStrRev(GetCurrentFileName(),".")
 Filename = Left(GetCurrentFileName(),LastDotPos-1)
 
On Error Resume Next
    saveworddoc = Filename & ".DOC"
    'ShowString(saveworddoc)
    .ActiveDocument.SaveAs saveworddoc
If Err.Number = 0 Then
    ' Successfully Saved file
Else
    ' Save file failed
	ShowString  "Cannot Save File, File Already Open "&saveworddoc: Exit Sub
End If

End With 'end output to word
On Error Goto 0  
  
If Not wordDoc Is Nothing Then Set wordDoc = Nothing  
  
ShowString "Setup Sheet Finished"&vbNewLine&"file saved as "&saveworddoc


End Sub

       
' Writes tool list to word
Public Sub WriteToWord(strOutText)
    Dim wordCounts

    With wordDoc         
    	.Selection.MoveDown wdLine, .ActiveDocument.Words.Count
    	.Selection.TypeParagraph
    	.Selection.TypeText strOutText
    End With
End Sub

February 9, 2015

I have a VB script you could try. You'll need Microsoft office to use it.

'////////////////////////////////////////////////////////////////////////////////
'//
'//        Author:   Jesse Thering, John Thompson, and with MUCH help from Mick George and Bullines!
'//          Date:   02/09/2015
'//     File Name:   New Mastercam Script
'//
'//   Description:   Setupsheet.vbs setup sheet 
'//
'//      Comments:   Job Setup Doc sheet
'//
'////////////////////////////////////////////////////////////////////////////////


'///////////////// My Constants /////////////////


'///////////////// My Global Variables //////////


' -- Start Script


' ////////////////////
' Sub Declaration
' ////////////////////
Dim wordDoc

'///////////////// My Constants ///////////////// 
Dim companyname 
Dim Program 
Dim Description 
Dim Post 
Dim programmer 
Dim notes 
Dim tlo

Dim nCount ' number of operations
Dim nToolNum ' tool number
Dim arrToolNumber() ' array of tool numbers 
Dim arrToolComment() ' array of tool comments 
Dim arrToolDiameter() ' array of tool diameters 
Dim arrToolFluteLength() ' array of tool flute lengths 
Dim arrToolLength() ' array of tool lengths 
Dim arrOperationType() ' array to store the operation type, Drill = 2, Pocket = 3, transformed operation = 4
dim arrtools(24)
Dim idx 
Dim toolcount 
Dim strText 
Dim Position 
Dim FileName 
Dim graphic 
Dim stockx 
Dim stocky 
Dim stockz 
Dim material 
Dim saveworddoc
dim blah
dim tn
dim tdesc
dim tdiam
dim tflute
Dim toverall

Dim CompanyChar 'Number of characters in company name
Dim DescChar	'Number of characters in Description
Dim FileChar	'Number of Characters in Filename
Dim PIC

Const wdTabLeaderSpaces = 0


Dim DateTimeFormat()

Const wdAlertsNone=0
Const wdWindowStateMaximize=1
Const wdLine=5
Const wdEnglishUS = 1033
Const wdCalendarWestern = 0
Const wdColorDarkRed=128
Const wdAlignParagraphCenter=1
Const msoTextOrientationHorizontal = 1
Const wdTextOrientationDownward = 3
Const msoFalse=0
Const DEF_SPACING_ONEANDAHALF=1
Const DEF_SPACING_ONE=0
Const wdAlignTabRight = 2
Const wdAlignTabLeft=2
Const Clip_Board="clipbrd"

'///////////////// My Global Variables //////////


' -- Start Script
Call Main()


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

'On Error Resume Next
  

Do        'ask until a real company name is entered
companyname=AskString("Input a company name", "") 
Loop While companyname="Company Name?" Or companyname="((ESC))" Or companyname=""  

CompanyChar = Len (companyname)

Do        'ask until a real program number is used
Program=AskString("Part Number?", "")
Loop While Program="Part Number?" Or Program="" Or Program="((ESC))"

Do        'ask until a real description is used
Description=AskString("Description", "") 
Loop While Description="description" Or Description="" Or Description="((ESC))"

DescChar = Len (Description)

Post=AskString("Post", "Fadal")

Do        'ask until a real programmer name is input
programmer=AskString("Programmer?", "")
Loop While programmer="programmer?" Or programmer="" Or programmer="((ESC))"

notes=AskString("Notes", "")
    If notes="Notes" Or notes="" Then
    notes=""
    End If

Do        
tlo=AskString("TL0", "TOS")
Loop While tlo="TL0" Or tlo="" Or tlo="((ESC))"

'get stock setup sizes
stockx=GetJobSetupStockSizeX
stocky=GetJobSetupStockSizeY
stockz=GetJobSetupStockSizeZ

    Do
    material=AskString("Material type?", "Aluminum")    
    Loop While material="NONE" Or material="" Or material="Material type?"
    
'check stock size for 0
If stockx=0 Then
    If askYesNo ("Stock size is zero, do you want to change it?")=mcMSG_YES Then
    stockx=AskString ("X stock size?", "")
    stocky=AskString ("Y stock size?", "")
    stockz=AskString ("Z stock size", "")
    End If
End If
   
'Load tool information 

' get the number of operations
nCount = GetOperationCount("") 

If nCount = 0 Then ShowString "No operations found in current drawing": Exit Sub              

Dim id
dim whatever
dim thisstring
dim tc
dim doit
Dim temp

whatever=""

For idx = 0 To nCount-1

    ' get the tool number using the current operation
    nToolNum = GetToolNumberFromOperationID("", idx)   
    whatever=formatnumber(idx)
    
    Redim Preserve arrToolNumber(idx)
    Redim Preserve arrToolComment(idx) 
    Redim Preserve arrToolDiameter(idx)
    Redim Preserve arrToolFluteLength(idx)
    Redim Preserve arrToolLength(idx) 
    Redim Preserve arrOperationType(idx)

    arrOperationType(idx)  = GetOperationTypeFromID("", idx)
    
    ' copy tool data into our individual arrays 
    arrToolNumber(idx) = nToolNum
Next

	' Sort Tools in ascending order	
For idx = 0 To Ubound(arrToolNumber) - 1
        For temp = idx + 1 To Ubound(arrToolNumber)
            If (arrToolNumber(idx) > arrToolNumber(temp)) Then
                TN = arrToolNumber(idx)
                arrToolNumber(idx) = arrToolNumber(temp)
                arrToolNumber(temp) = TN
            End If
        Next
    Next

    ' copy tool data into our individual arrays
For idx = 0 To nCount-1
	nToolNum = arrToolNumber(idx)
    arrToolComment(idx) = GetToolComment(nToolNum)     
    arrToolDiameter(idx) = GetToolDiameter(nToolNum)
    arrToolFluteLength(idx) = GetToolFluteLength(nToolNum)
    arrToolLength(idx) = GetToolLength(nToolNum)

Next

'Save number of characters in Filename
FileChar = Len (GetCurrentFileName())

'open word
Set wordDoc=CreateObject("Word.Application")

wordDoc.Documents.Add

With wordDoc  
    .Visible=True
    .WindowState=wdWindowStateMaximize
    .DisplayAlerts=wdAlertsNone
    
    'Sets Margins
    .Selection.PageSetup.LeftMargin = .InchesToPoints(0.5) 'start of margin setting macro
    .Selection.PageSetup.RightMargin = .InchesToPoints(0.5)
    .Selection.PageSetup.TopMargin = .InchesToPoints(0.5)
    .ActiveWindow.ActivePane.VerticalPercentScrolled = 20
    .Selection.PageSetup.BottomMargin = .InchesToPoints(0.5) 'end of margin setting macro
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
    'Puts "Program Info" top center                                                                                 
    .Selection.Font.Bold=True
    .Selection.Font.Size=16
    .Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter
    .Selection.Font.Name="staccato222 BT"
    .Selection.TypeText "PROGRAM INFO"
    .Selection.TypeText vbNewLine
    
    'Puts program number in sideways box, right side
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 525, 75, 45, 117).Select 'start of macro code
    .Selection.ShapeRange.TextFrame.TextRange.Select 
    .Selection.Collapse 
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.ShapeRange.Select
    .Selection.ShapeRange.IncrementLeft 36
    .Selection.ShapeRange.IncrementTop -18
    .Selection.Orientation = wdTextOrientationDownward
    .Selection.Font.Size = 24 
    .Selection.Font.Name="Times New Roman"        
    .Selection.TypeText Program    
    

    'double text boxes for header info

    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20,70, 222.3, 60).Select 'first box left side
    .Selection.ShapeRange.TextFrame.TextRange.Select                                            'First box header info goes this section
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
	.Selection.Font.Size = 12
    .Selection.TypeText "Company: "&vbTab    'Company Name
If CompanyChar > 21 Then
    .Selection.Font.Size = 10
Else If CompanyChar <= 21 Then
    .Selection.Font.Size = 12
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText companyname&vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Description: "&vbTab     'Description
If DescChar > 21 Then
    .Selection.Font.Size = 10
If DescChar > 26 Then
    .Selection.Font.Size = 9
Else If DescChar <= 21 Then
    .Selection.Font.Size = 12
End If
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText Description &vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Part Num: "&vbTab     'Part number
    .Selection.Font.Bold=False
    .Selection.TypeText Program &vbNewLine
    .Selection.Font.Bold=True
    .Selection.Font.Bold=True
    .Selection.TypeText "Material: "&vbTab     'Material type
    .Selection.Font.Bold=False
    .Selection.TypeText material &vbNewLine

    'Second Header box
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 245,70, 320, 60).Select 'second box right side
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
If FileChar >= 48 Then
    .Selection.Font.Size = 9
Else If FileChar < 48 Then
    .Selection.Font.Size = 12
End If
End If
    .Selection.Font.Bold=True
    .Selection.TypeText "Filename: "        'File Name
If FileChar <= 28 Then
    .Selection.TypeText vbTab&vbTab
End If
If FileChar > 34 Then
    .Selection.Font.Size = 10
If FileChar >= 40 Then
    .Selection.Font.Size = 9
If FileChar >= 44 Then
    .Selection.Font.Size = 8
Else If FileChar <= 34 Then
    .Selection.Font.Size = 12
End If
End If
End If
End If
    .Selection.Font.Bold=False
    .Selection.TypeText GetCurrentFileName()&vbNewLine
    .Selection.Font.Size = 12
    .Selection.Font.Bold=True
    .Selection.TypeText "Post: "&vbTab&vbTab&vbTab       'Post
    .Selection.Font.Bold=False
    .Selection.TypeText Post &vbNewLine
    .Selection.Font.Bold=True
    .Selection.TypeText "Stock Size: "&vbTab&vbTab       'Stock size IF in job setup
    .Selection.Font.Bold=False
    .Selection.TypeText "X"&stockx&" Y"&stocky&" Z"&stockz &vbNewLine
    .Selection.Font.Bold=True
    .Selection.TypeText "Stock Origin: "&vbTab     'Stock origin from job setup. Almost always 0,0
    .Selection.Font.Bold=False
    .Selection.TypeText "X"& GetJobSetupStockOriginX&" Y"& GetJobSetupStockOriginY&" (On Center)"&vbNewLine

     'Print out notes
     
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 130, 530, 35).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman" 
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "NOTES: "
    .Selection.Font.Bold=False
    .Selection.TypeText notes

    'Revisions listing
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 168, 575.7, 36).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.6)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3.1)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(4.6)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(6.1)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible=msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Name: "&programmer&vbTab&"Name:________"&vbTab&"Name:________"&vbTab&"Name:_______"&vbTab&"Name:________"&vbNewLine
    .Selection.TypeText "Date: "     'Date
    .Selection.InsertDateTime "M/D/YY", False, False, wdEnglishUS, wdCalendarWestern 'get the date
    .Selection.TypeText vbTab&"Date:________"&vbTab&"Date:________"&vbTab&"Date:_______"&vbTab&"Date:________"         

    'puts out tool list

    'creat 2 text boxes
    'left side box
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 213, 270, 225).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(.4)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.75)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.375)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Tool"&vbTab&"Description"&vbTab&"  "&"Dia "&vbTab&"Flute"&vbTab&"Overall"
    .Selection.Font.Bold=False


    toolcount=1

    For idx=0 To nCount-1
    	If toolcount<=10 Then
				strText = "Transformed operation copy"
				tdesc=Left(arrToolComment(idx),17)
				tdiam=formatnumber(arrToolDiameter(idx),3,0,-2,-2)
				tflute=formatnumber(arrToolFluteLength(idx),2,0,-2,-2)
				toverall=formatnumber(arrToolLength(idx),2,0,-2,-2)
				strText="T"&arrToolNumber(idx)&vbTab&tdesc&vbTab&"  " &tdiam &vbTab&" "&tflute &vbTab&toverall
		thisstring="Left "&formatnumber(idx)&" " & arrtoolnumber(idx)
		'whatever=AskString(thisstring, strText)    
				doit="y"

				for tc=1 to toolcount
					If arrtools(tc)=arrtoolnumber(idx) Then doit="n"
				next

				If arrtoolnumber(idx)="0" Then doit="n"
				if doit<>"n" then Call WriteToWord(strText)
				arrtools(toolcount)=arrtoolnumber(idx)
				If doit<>"n" Then toolcount=toolcount+1

		End If
    Next

    'Right side box
  
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 310, 213, 270, 225).Select
    .ActiveDocument.Paragraphs.TabStops.ClearAll
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(.4)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.75)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.375)
    .Selection.ParagraphFormat.TabStops.Add .InchesToPoints(3)
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Line.Visible = msoFalse
    .Selection.Font.Bold=True
    .Selection.TypeText "Tool"&vbTab&"Description"&vbTab&"  "&"Dia"&vbTab&"Flute"&vbTab&"Overall"
    .Selection.Font.Bold=False
    
    'Second column of tools
    toolcount=1        
        For idx=0 To nCount-1
				strText = "Transformed operation copy"
				tdesc=Left(arrToolComment(idx),17)
				tdiam=formatnumber(arrToolDiameter(idx),3,0,-2,-2)
				tflute=formatnumber(arrToolFluteLength(idx),2,0,-2,-2)
				toverall=formatnumber(arrToolLength(idx),2,0,-2,-2)
          			strText = "T"&arrToolNumber(idx)& vbTab & _
          			tdesc & vbTab &"  " & _
          			tdiam & vbTab&" "& _
          			tflute &vbTab& _
          			toverall
		'whatever=AskString(thisstring, strText)    
				doit="y"

				For tc=1 To toolcount
					If arrtools(tc)=arrtoolnumber(idx) Then doit="n"
				Next
				If arrtoolnumber(idx)="0" Then doit="n"
				If doit<>"n" And toolcount>= 10  Then Call WriteToWord(strText)
				arrtools(toolcount)=arrtoolnumber(idx)
				If doit<>"n" Then toolcount=toolcount+1

    Next
    
    'Put TL0 information in
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 445, 564.3, 35).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
	.Selection.ParagraphFormat.SpaceBeforeAuto = False
	.Selection.ParagraphFormat.SpaceAfterAuto = False
	.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONE
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceAfter = 0
	.Selection.ParagraphFormat.Alignment = 0
    .Selection.Font.Name="Times New Roman"  
	.Selection.Font.Size = 12
    .Selection.ShapeRange.Select
    .Selection.ShapeRange.Line.Visible = msoFalse 
    .Selection.Font.Bold=True
    .Selection.TypeText "T.L.0. Location: "
    .Selection.Font.Bold=False
    .Selection.TypeText tlo&vbNewLine
    .Selection.TypeText "_________________________________________________________________________________________" 
        
	'Check for "temp" directory
	Dim fso, fldr, objFolder
   	Set fso = CreateObject("Scripting.FileSystemObject")
	If Not fso.FolderExists("C:\temp") Then
   	Set fldr = fso.CreateFolder("C:\temp")
	Set objFolder = fso.getFolder("C:\temp")
	objFolder.Attributes = 2
   	End If

'Load Graphic into textbox
	Call SetGViewNumber (mcVIEW_TOP)		'  Top view picture
    Call RepaintScreen (True)				'  that is centered	
    graphic="c:\temp\test.emf"
    DoMetafile graphic
         
    .Selection.ShapeRange.Select
    .ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 115, _
            480, 390, 302).Select
    .Selection.ShapeRange.TextFrame.TextRange.Select
    .Selection.Collapse
    .Selection.ShapeRange.Line.Visible = msoFalse
	
	Set PIC = .Selection.InlineShapes.AddPicture (graphic,False,True)
	PIC.LockAspectRatio = True
	Dim Aspect
	Aspect = PIC.Width / PIC.Height
	If (PIC.Width > 520) Then
	PIC.Width = 520
	PIC.Height = PIC.Width / Aspect
	ElseIf (PIC.Height > 260) Then
	PIC.Height = 260
	PIC.Width = PIC.Height * Aspect
	End If
    
    'save word document to same directory as MC file

	'removes file extension
 Dim LastDotPos
 LastDotPos = InStrRev(GetCurrentFileName(),".")
 Filename = Left(GetCurrentFileName(),LastDotPos-1)
 
On Error Resume Next
    saveworddoc = Filename & ".DOCX"
    'ShowString(saveworddoc)
    .ActiveDocument.SaveAs saveworddoc
If Err.Number = 0 Then
    ' Successfully Saved file
Else
    ' Save file failed
	ShowString  "Cannot Save File, File Already Open "&saveworddoc: Exit Sub
End If

End With 'end output to word
On Error Goto 0  
  
If Not wordDoc Is Nothing Then Set wordDoc = Nothing  
  
ShowString "Setup Sheet Finished"&vbNewLine&"file saved as "&saveworddoc


End Sub

       
' Writes tool list to word
Public Sub WriteToWord(strOutText)
    Dim wordCounts

    With wordDoc         
    	.Selection.MoveDown wdLine, .ActiveDocument.Words.Count
    	.Selection.TypeParagraph
    	.Selection.TypeText strOutText
    End With
End Sub

Sign In

Welcome to eMastercam

be

Posts

Joined

Last visited

Content Type

Profiles

Forums

Downloads

Store

eMastercam Wiki

Blogs

Gallery

Events

Posts posted by be

VBScript for setting up fixture plate

VBScript for setting up fixture plate

posting problem

setup sheet options?

setup sheet options?

setup sheet options?

setup sheet options?

Join us!

Useful Links

Legal

Follow us

Home

Forums

Store

Posts

Downloads