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:

setup sheet options?


Chrisselfstarter
 Share

Recommended Posts

  • 1 month later...

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
  • Like 3
Link to comment
Share on other sites
  • 2 months later...

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
Link to comment
Share on other sites

NIce

 

Would be nice if the tool list parsed out as a single line and under each line to the Tool comments were out out as well. Nice to have that information without have to dig through the program to find it

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

 

 

 

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.

Link to comment
Share on other sites

Since there is an Mcam employee here, can we exchange some emails? I'd like to tweak a few things I'm doing in Active Reports Designer. PM me an email address if you'll help me. I'm almost there but I'm missing something.

Link to comment
Share on other sites
  • 2 weeks later...

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.

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...