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:

using VBscript to format Word Document

John T.
 Share

Recommended Posts

John T. Newbie

John T.

Posted
  • Author
Posted

Here's what I've done so far tonight.

 

code:
Dim wordDoc

 

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

Dim companyname

Dim Program

Dim Description

Dim Post

Dim programmer

Dim notes

'Dim whatdate()

 

 

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

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

 

 

 

' -- Start Script

Call Main()

 

 

' ////////////////////

' Sub Declaration

' ////////////////////

Sub Main()

 

'WriteString("Company Name?")

companyname=AskString("company Name?")

Program=AskString("program number?")

Description=AskString("description")

Post=AskString("fadal") ' -- You can call GetPostName() mag

programmer=AskString("programmer?")

notes=AskString("Notes")

 

Set wordDoc=CreateObject("Word.Application")

 

wordDoc.Documents.Add

 

With wordDoc

 

.Visible=True

.WindowState=wdWindowStateMaximize

.DisplayAlerts=wdAlertsNone

 

' -- InchesToPoints is an App method mag

.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

 

'Puts "Program Info" top center

.Selection.Font.Bold=True

.Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter

.Selection.Font.Name="staccato222 BT"

'.Selection.Font.Color =wdColorDarkRed 'Running low on red ink!

.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 ' -- Removed # not valid in VBS mag

.Selection.ShapeRange.IncrementTop -18

.Selection.Orientation = wdTextOrientationDownward

.Selection.Font.Size = 24

.Selection.TypeText Program

 

 

'double text boxes for header info

 

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20.3,72, 222.3, 80).Select 'first box left side

.Selection.ShapeRange.TextFrame.TextRange.Select 'First box header info goes this section

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Company: "&vbTab 'Company Name

.Selection.Font.Bold=False

.Selection.TypeText companyname&vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Description: "&vbTab 'Description

.Selection.Font.Bold=False

.Selection.TypeText Description &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "PI Num: "&vbTab 'PI number

.Selection.Font.Bold=False

.Selection.TypeText Program &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Name: "&vbTab 'Programmer Name

.Selection.Font.Bold=False

.Selection.TypeText programmer&vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Date "&vbTab 'Date

.Selection.Font.Bold=False

'.Selection.InsertDateTime (DateTimeFormat= "M/d/yy", InsertAsField =False,DateLanguage =wdEnglishUS, CalendarType= wdCalendarWestern,InsertAsFullWidth= False) 'Earlier attempt at getting the date

' Call getthedate()

'.Selection.TypeText Time

 

'Second Header box

.Selection.ShapeRange.Select

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 259,72, 280.35, 80).Select 'second box right side

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Filename: "&vbTab&vbTab 'File Name

.Selection.Font.Bold=False

.Selection.TypeText GetCurrentFileName()&vbNewLine

.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 "Material Type "&vbTab 'Material type IF in Job setup

.Selection.Font.Bold=False

.Selection.TypeText GetJobSetupMaterial() &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Stock Size: "&vbTab&vbTab 'Stock size IF in job setup

.Selection.Font.Bold=False

.Selection.TypeText "X"&GetJobSetupStockSizeX&" Y"&GetJobSetupStockSizeY&" Z"&GetJobSetupStockSizeZ &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&vbNewLine

 

'Print out notes

 

End With

 

 

If Not wordDoc Is Nothing Then Set wordDoc = Nothing

 

ShowString "Script has ended"

 

 

 

 

End Sub

 

'Sub getthedate()

' whatdate=InsertDateTime (DateTimeFormat= "M/d/yy", InsertAsField =False,DateLanguage =wdEnglishUS, CalendarType= wdCalendarWestern,InsertAsFullWidth= False)

'End Sub

 

You'll notice I have the askstring and date stuff commented out. I don't know how to have the prompt string show above the input line at the bottom of mastercam like it does on the .SET sheets.

 

Second, I couldn't get the datetime thing to work. If I understand it right, its supposed to be a subroutine, but I can't get it to work right. The one in the above code is pretty hacked up from the Word macro, but as it is right now, I get a "mismatch" error message.

 

You'll notice I use textboxes for the information. I think I'll have to use these through the whole document? I next need to make a text box for the notes two lines long across the whole page, then 2 longer side by side boxes for the tool list, then a one line text box below then for the TL0 location, then finally one more text box filling the remainder of the page for the graphic of the part.

 

John

Link to comment
Share on other sites
  • Replies 56
  • Created
  • Last Reply

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Bullines Newbie

Bullines

Posted
Posted

I'm at home and have OpenOffice, whose BASIC scripting language is very similar to Word's (and the rest of Office) but the objects are very different. But I'm pretty sure that Word's InsertDateTime method for Selections is overloaded (bad term to use with VB, I know). That is, some of the parameters are optional. Maybe all you'd need is:

 

code:
.Selection.InsertDateTime DateTimeFormat= "M/d/yy", InsertAsField = False

Otherwise, you could always get the current date on your own and insert it as text.

 

code:
' these are the constants for the date formats

Const DEF_GENERAL_DATE = 0

Const DEF_LONG_DATE = 1

Const DEF_SHORT_DATE = 2 ' looks like you want this one

Const DEF_LONG_TIME = 3 ' and this one, too

Const DEF_SHORT_TIME = 4

 

Dim strCurrDate ' string to hold the current date

Dim strCurrTime ' string to hold the current time

 

' get the date and format it (depends on your Regional Settings in your Control Panel)

strCurrDate = FormatDateTime(Date, DEF_SHORT_DATE)

 

' get the time and format it (depends on your Regional Settings too)

strCurrTime = FormatDateTime(Tim, DEF_LONG_TIME)

 

' now write strCurrDate and strCurrTime to the Word document with Selection's TypeText

HTH

Link to comment
Share on other sites
crazy^millman Veteran

crazy^millman

Posted
Posted

Well Hope James doesn't get mad becuase he took this off very soon after

he put it up because the person he put it for didnt care for the help

but maybe you can use something out of it.

 

This is from James Meyette:

code:
Sub MakeToolTable()

'

' MakeToolTable Macro

'

'Remove spaces

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = " "

.Replacement.Text = " "

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True

Selection.Find.Execute Replace:=wdReplaceAll

Loop

 

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "^p "

.Replacement.Text = "^p"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True

Selection.Find.Execute Replace:=wdReplaceAll

Loop

 

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = " "

.Replacement.Text = "^t"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True

Selection.Find.Execute Replace:=wdReplaceAll

Loop

 

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "i^t"

.Replacement.Text = "^t"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True

Selection.Find.Execute Replace:=wdReplaceAll

Loop

 

'Remove extra lines at top of program

Selection.HomeKey Unit:=wdStory

Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.HomeKey Unit:=wdStory

Selection.EndKey Unit:=wdStory, Extend:=wdExtend

Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=7

', _

' NumRows:=19, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _

' :=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _

' ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _

' AutoFit:=False

 

'Remove "tool type" and "radius type" columns

Selection.Find.ClearFormatting

With Selection.Find

.Text = "tool type"

End With

Selection.Find.Execute

Selection.SelectColumn

Selection.Columns.Delete

Selection.Find.ClearFormatting

With Selection.Find

.Text = "radius type"

End With

Selection.Find.Execute

Selection.SelectColumn

Selection.Columns.Delete

Selection.SelectColumn

Selection.Columns.Delete

 

'Change column widths

Selection.SelectColumn

Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(2), RulerStyle:= _

wdAdjustNone

Selection.Rows.SpaceBetweenColumns = InchesToPoints(0.15)

Selection.Collapse Direction:=wdCollapseStart

Selection.Move Unit:=wdColumn, Count:=-1

Selection.SelectColumn

Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(2), RulerStyle:= _

wdAdjustNone

Selection.Rows.SpaceBetweenColumns = InchesToPoints(0.15)

Selection.Collapse Direction:=wdCollapseStart

Selection.Move Unit:=wdColumn, Count:=-1

Selection.SelectColumn

Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(1.5), RulerStyle:= _

wdAdjustNone

Selection.Rows.SpaceBetweenColumns = InchesToPoints(0.15)

Selection.Collapse Direction:=wdCollapseStart

Selection.Move Unit:=wdColumn, Count:=-1

Selection.SelectColumn

Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(1), RulerStyle:= _

wdAdjustNone

Selection.Rows.SpaceBetweenColumns = InchesToPoints(0.15)

 

'Bold top row

Selection.HomeKey Unit:=wdStory

Selection.SelectRow

Selection.Font.Bold = wdToggle

Selection.Font.Size = 12

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

 

' Sort Tool Table

Selection.MoveLeft Unit:=wdCharacter, Count:=1

Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _

:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, FieldNumber2 _

:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _

wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _

wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _

wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _

:=wdLanguageNone

Selection.MoveLeft Unit:=wdCharacter, Count:=1

 

'Remove extra zeros from CORNER RADIUS Column

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "00 in."

.Replacement.Text = " in."

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll

 

End Sub

HTH

Link to comment
Share on other sites
Bullines Newbie

Bullines

Posted
Posted

quote:

Is there a way to put a space and a half between lines instead of one space?

Try:

 

code:
Const DEF_SPACING_ONEANDAHALF = 1 ' <- 1.5 line spacing

 

With Selection.ParagraphFormat

.LineSpacingRule = DEF_SPACING_ONEANDAHALF

End With

Or maybe in your situation:

 

code:
Const DEF_SPACING_ONEANDAHALF = 1

 

With wordDoc

' some stuff

 

Selection.ParagraphFormat.LineSpacingRule = DEF_SPACING_ONEANDAHALF

 

' some more stuff

End With

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Here's my latest, it does almost everything I need it to do.

 

code:
'////////////////////////////////////////////////////////////////////////////////

'//

'// Author: John Thompson, with MUCH help from Mick George and Bullines!

'// Date: 15/03/2004 04:01 PM

'// File Name: New Mastercam Script

'//

'// Description: Headertest2.vbs

'//

'// Comments: Makes a job setup sheet. Work in progress!

'//

'////////////////////////////////////////////////////////////////////////////////

 

 

'///////////////// 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 idx

Dim toolcount

Dim strText

Dim Position

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 wdAlignTabLeft = 2

 

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

 

 

 

' -- Start Script

Call Main()

 

 

' ////////////////////

' Sub Declaration

' ////////////////////

Sub Main()

 

'WriteString("Company Name?")

companyname=AskString("company Name?")

Program=AskString("program number?")

Description=AskString("description")

Post=AskString("fadal") ' -- You can call GetPostName() mag

programmer=AskString("programmer?")

notes=AskString("Notes")

tlo=AskString("TL0")

 

'Load tool information

 

' get the number of operations

nCount = GetOperationCount("")

 

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

 

 

For idx = 1 To nCount

' get the tool number using the current operation

nToolNum = GetToolNumberFromOperationID("", idx)

 

ReDim Preserve arrToolNumber(idx)

ReDim Preserve arrToolComment(idx)

ReDim Preserve arrToolDiameter(idx)

ReDim Preserve arrToolFluteLength(idx)

ReDim Preserve arrToolLength(idx)

 

' copy tool data into our individual arrays

arrToolNumber(idx) = nToolNum

arrToolComment(idx) = GetToolComment(nToolNum)

arrToolDiameter(idx) = GetToolDiameter(nToolNum)

arrToolFluteLength(idx) = GetToolFluteLength(nToolNum)

arrToolLength(idx) = GetToolLength(nToolNum)

Next

 

 

 

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

 

'Puts "Program Info" top center

.Selection.Font.Bold=True

.Selection.Font.Size=20

.Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter

.Selection.Font.Name="staccato222 BT"

'.Selection.Font.Color =wdColorDarkRed 'Running low on red ink!

.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 ' -- Removed # not valid in VBS mag

.Selection.ShapeRange.IncrementTop -18

.Selection.Orientation = wdTextOrientationDownward

.Selection.Font.Size = 24

.Selection.TypeText Program

 

 

'double text boxes for header info

 

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20,80, 222.3, 80).Select 'first box left side

.Selection.ShapeRange.TextFrame.TextRange.Select 'First box header info goes this section

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Company: "&vbTab 'Company Name

.Selection.Font.Bold=False

.Selection.TypeText companyname&vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Description: "&vbTab 'Description

.Selection.Font.Bold=False

.Selection.TypeText Description &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "PI Num: "&vbTab 'PI number

.Selection.Font.Bold=False

.Selection.TypeText Program &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Name: "&vbTab 'Programmer Name

.Selection.Font.Bold=False

.Selection.TypeText programmer&vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Date "&vbTab&vbTab 'Date

.Selection.Font.Bold=False

.Selection.InsertDateTime "M/D/YY", False, False, wdEnglishUS, wdCalendarWestern 'get the date

 

'Second Header box

.Selection.ShapeRange.Select

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 259,80, 300, 80).Select 'second box right side

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Filename: "&vbTab&vbTab 'File Name

.Selection.Font.Bold=False

.Selection.TypeText GetCurrentFileName()&vbNewLine

.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 "Material Type "&vbTab 'Material type IF in Job setup

.Selection.Font.Bold=False

.Selection.TypeText GetJobSetupMaterial() &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Stock Size: "&vbTab&vbTab 'Stock size IF in job setup

.Selection.Font.Bold=False

.Selection.TypeText "X"&GetJobSetupStockSizeX&" Y"&GetJobSetupStockSizeY&" Z"&GetJobSetupStockSizeZ &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&vbNewLine

 

'Print out notes

 

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, _

153, 567.15, 30).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

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

198, 575.7, 50).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ShapeRange.Line.Visible=msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Revisions:"&vbNewLine

.Selection.TypeText "Name:________"&vbTab&"Name:________"&vbTab&"Name:________"&vbTab&"Name:_______"&vbTab&"Name:________"&vbNewLine

.Selection.TypeText "Date:________"&vbTab&"Date:________"&vbTab&"Date:________"&vbTab&"Date:_______"&vbTab&vbTab&"Date:________"

 

'puts out tool list

 

'creat 2 text boxes

'left side box

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, _

250, 270, 225).Select

'.ActiveDocument.Paragraphs.TabStops.ClearAll

'.Selection.ParagraphFormat.TabStops.Add Position=.InchesToPoints(0.51),.Alignment=wdAlignTabLeft, .Leader=wdTabLeaderSpaces

'.Selection.ParagraphFormat.TabStops.Add Position=.InchesToPoints(1.58),.Alignment=wdAlignTabLeft, .Leader=wdTabLeaderSpaces

'.Selection.ParagraphFormat.TabStops.Add Position=.InchesToPoints(2.14),.Alignment=wdAlignTabLeft, .Leader=wdTabLeaderSpaces

'.Selection.ParagraphFormat.TabStops(InchesToPoints(2.61)).Position =.InchesToPoints(2.69)

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF 'Change line spacing to 1 and a half

.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 'prints first tool

strText="T"&arrToolNumber(1)& vbTab & _

arrToolComment(1) & vbTab &" "& _

arrToolDiameter(1) & vbTab&" " & _

arrToolFluteLength(1) & vbTab & _

arrToolLength(1)

 

Call WriteToWord(strText)'sends first tool to word

 

For idx=1 To nCount

If toolcount<=9 Then

If toolcount<>GetToolNumberFromOperationID("",(idx)) Then

strText = "T"&arrToolNumber(idx)& vbTab & _

arrToolComment(idx) & vbTab &" " & _

arrToolDiameter(idx) & vbTab&" "& _

arrToolFluteLength(idx) &vbTab& _

arrToolLength(idx)

Call WriteToWord(strText)

toolcount=toolcount+1

End If

End If

Next

 

'Right side box

 

.Selection.ShapeRange.Select

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 310, _

250, 270, 225).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF

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

 

'toolcount=1

For idx=1 To nCount

If toolcount >= 10 Then

If toolcount=GetToolNumberFromOperationID("",(idx)) Then

strText = "T"&arrToolNumber(idx)& vbTab & _

arrToolComment(idx) & vbTab &" " & _

arrToolDiameter(idx) & vbTab&" "& _

arrToolFluteLength(idx) &vbTab& _

arrToolLength(idx)

Call WriteToWord(strText)

toolcount=toolcount+1

End If

End If

Next

 

'Put TL0 information in

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, _

485, 564.3, 35).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

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

 

End With

 

 

If Not wordDoc Is Nothing Then Set wordDoc = Nothing

 

ShowString "Script has ended"

 

 

 

 

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

You'll noticed I tried to work with tabbing. If the tool diameter was more than 3 decimal places, it bumped the flute and overall columns over for that tool. I didn't get that to work, but it wasn't a priority (yet). I now need to get the EMF file to go on the remainder of the page. I started a new topic for that.

 

The logic to split the tool list into 2 columns turned out to be devilishly simple. banghead.gif

 

Future stuff includes getting the prompt to work when asking for the information at the top (company, number, etc), check stock sizes and asking if want to change if they are 0, use the default tool dimensions or input your own, and so on.

 

I also need to test this program on files that are missing a tool, or reuse a tool later on in the program, or tools out of sequence.

 

John

Link to comment
Share on other sites
crazy^millman Veteran

crazy^millman

Posted
Posted

John that is pretty slick I like that. I want to personally thank you for sharing that. I know see a base for a good word doc. I have some Vb code at home that will make a bmp of a screen shot I got off of some Vb web site I will post it up and see if you can use it. I also have a Vb script for doing Word doc to Excel but that can be done easily in Word so not sure if it will do you any good. cheers.gifcheers.gifcheers.gifcheers.gif

 

A beer for your hard work.

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

CAM Disciple, what do you mean by two groups of tool paths? Do you mean like cutting the same part several times in one set up?

 

Something similar, if we have to cut a feature several times on one part, we use transform. You can also transform the transform for multiple parts.

 

MillMan,

Much of the thanks goes to Mick and Bullines. I could not have figured out a lot of it without them, and its still not finished!

 

John

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Here it is. My finished setup sheet. There is only one big problem. It doesn't work right from MC, only the VB editor in MC!! why is this???

code:
'////////////////////////////////////////////////////////////////////////////////

'//

'// Author: John Thompson, with MUCH help from Mick George and Bullines!

'// Date: 15/03/2004 04:01 PM

'// File Name: New Mastercam Script

'//

'// Description: setupsheet.vbs

'//

'// Comments: Makes a job setup 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 idx

Dim toolcount

Dim strText

Dim Position

Dim FileName

Dim graphic

Dim stockx

Dim stocky

Dim stockz

 

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 wdAlignTabRight = 2

Const wdAlignTabLeft=2

 

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

 

 

 

' -- Start Script

Call Main()

 

 

' ////////////////////

' Sub Declaration

' ////////////////////

Sub Main()

 

'WriteString("Company Name?")

Do 'ask until a real company name is entered

companyname=AskString("company Name?")

Loop While companyname="company Name?" Or companyname="((ESC))" Or companyname=""

 

Do 'ask until a real program number is used

Program=AskString("program number?")

Loop While Program="program 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))"

 

Post=AskString("Fadal") ' -- You can call GetPostName() mag

 

Do 'ask until a real programmer name is input

programmer=AskString("programmer?")

Loop While programmer="programmer?" Or programmer="" Or programmer="((ESC))"

 

notes=AskString("Notes") 'better a blank line than seeing Notes: notes

If notes="Notes" Or notes="" Then

notes=""

End If

 

Do

tlo=AskString("TL0")

Loop While tlo="TL0" Or tlo="" Or tlo="((ESC))"

 

'get stock setup sizes

stockx=GetJobSetupStockSizeX

stocky=GetJobSetupStockSizeY

stockz=GetJobSetupStockSizeZ

 

'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

 

 

For idx = 1 To nCount

' get the tool number using the current operation

nToolNum = GetToolNumberFromOperationID("", idx)

 

ReDim Preserve arrToolNumber(idx)

ReDim Preserve arrToolComment(idx)

ReDim Preserve arrToolDiameter(idx)

ReDim Preserve arrToolFluteLength(idx)

ReDim Preserve arrToolLength(idx)

 

' copy tool data into our individual arrays

arrToolNumber(idx) = nToolNum

arrToolComment(idx) = GetToolComment(nToolNum)

arrToolDiameter(idx) = GetToolDiameter(nToolNum)

arrToolFluteLength(idx) = GetToolFluteLength(nToolNum)

arrToolLength(idx) = GetToolLength(nToolNum)

Next

 

 

'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

 

'Puts "Program Info" top center

.Selection.Font.Bold=True

.Selection.Font.Size=20

.Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter

.Selection.Font.Name="staccato222 BT"

'.Selection.Font.Color =wdColorDarkRed 'Running low on red ink!

.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 ' -- Removed # not valid in VBS mag

.Selection.ShapeRange.IncrementTop -18

.Selection.Orientation = wdTextOrientationDownward

.Selection.Font.Size = 24

.Selection.TypeText Program

 

 

'double text boxes for header info

 

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20,80, 222.3, 60).Select 'first box left side

.Selection.ShapeRange.TextFrame.TextRange.Select 'First box header info goes this section

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Company: "&vbTab 'Company Name

.Selection.Font.Bold=False

.Selection.TypeText companyname&vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "Description: "&vbTab 'Description

.Selection.Font.Bold=False

.Selection.TypeText Description &vbNewLine

.Selection.Font.Bold=True

.Selection.TypeText "PI Num: "&vbTab 'PI number

.Selection.Font.Bold=False

.Selection.TypeText Program &vbNewLine

.Selection.Font.Bold=True

.Selection.Font.Bold=True

.Selection.TypeText "Material: "&vbTab 'Material type IF in Job setup

.Selection.Font.Bold=False

.Selection.TypeText GetJobSetupMaterial() &vbNewLine

 

'Second Header box

.Selection.ShapeRange.Select

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 245,80, 320, 60).Select 'second box right side

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ShapeRange.Line.Visible = msoFalse

.Selection.Font.Bold=True

.Selection.TypeText "Filename: "&vbTab&vbTab 'File Name

.Selection.Font.Bold=False

.Selection.TypeText GetCurrentFileName()&vbNewLine

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

 

'Print out notes

 

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, _

140, 530, 35).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

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

180, 575.7, 33).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.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(.5)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.5)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.3)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.9)

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF 'Change line spacing to 1 and a half

.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 'prints first tool

strText="T"&arrToolNumber(1)& vbTab & _

arrToolComment(1) & vbTab &" "& _

arrToolDiameter(1) & vbTab&" " & _

arrToolFluteLength(1) & vbTab & _

arrToolLength(1)

 

Call WriteToWord(strText)'sends first tool to word

 

For idx=1 To nCount

If toolcount<=9 Then

If toolcount<>GetToolNumberFromOperationID("",(idx)) Then

strText = "T"&arrToolNumber(idx)& vbTab & _

arrToolComment(idx) & vbTab &" " & _

arrToolDiameter(idx) & vbTab&" "& _

arrToolFluteLength(idx) &vbTab& _

arrToolLength(idx)

Call WriteToWord(strText)

toolcount=toolcount+1

End If

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(.5)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(1.5)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.3)

.Selection.ParagraphFormat.TabStops.Add .InchesToPoints(2.9)

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

.Selection.ParagraphFormat.LineSpacingRule=DEF_SPACING_ONEANDAHALF

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

 

'toolcount=1

For idx=1 To nCount

If toolcount >= 10 Then

If toolcount=GetToolNumberFromOperationID("",(idx)) Then

strText = "T"&arrToolNumber(idx)& vbTab & _

arrToolComment(idx) & vbTab &" " & _

arrToolDiameter(idx) & vbTab&" "& _

arrToolFluteLength(idx) &vbTab& _

arrToolLength(idx)

Call WriteToWord(strText)

toolcount=toolcount+1

End If

End If

Next

 

'Put TL0 information in

.ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, _

438, 564.3, 35).Select

.Selection.ShapeRange.TextFrame.TextRange.Select

.Selection.Collapse

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

 

'Load Graphic into textbox

graphic="J:datatetest.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

.Selection.InlineShapes.AddPicture graphic,False,True

 

End With 'end output to word

 

 

If Not wordDoc Is Nothing Then Set wordDoc = Nothing

 

ShowString "Script has ended"

 

 

 

 

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

 

 

What doesn't work is the message boxes, one that asks if you want to enter stock size if the default is zero, and it won't create the text box at the bottom and put the EMF graphic in it. I don't know if its creating the EMF file either, haven't checked.

 

I assigned the script to the F12 key, and it won't do those things, only from the script editor.

 

John

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Serious problem has cropped up. The 30mb file I was using to test the script while developing it caused no problems, but when attempted with large files with lots of 3D, 131mb and 69mb, it causes MC to crash (caused errors message box). a 68mb file worked OK though. This was on different computers with the same results.

 

any ideas?

 

John

Link to comment
Share on other sites
Bullines Newbie

Bullines

Posted
Posted

quote:

In testing, if a tool is missing (i.e. 1,2,4,5, etc) it messes up the tool list.

This is because you're using a FOR loop to sequentially move through a list of integers representing tool numbers. Back in this thread, I recommended using a DO-WHILE loop instead. This method gets the tool number from an operation ID. Note that in my code, it's not dependant on a sequence of integers.

 

HTH

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Heres what I tried:

 

toocount=1

idx=1

 

Do

Do While toolcount=GetToolNumberFromOperationID("",(idx))

strText = "T"&arrToolNumber(idx)& vbTab & _

arrToolComment(idx) & vbTab &" " & _

arrToolDiameter(idx) & vbTab&" "& _

arrToolFluteLength(idx) &vbTab& _

arrToolLength(idx)

Call WriteToWord(strText)

toolcount=toolcount+1

Loop

idx=idx+1

Loop While toolcount<=10

 

This works fine when all the tools are there, but it crashes in the case of the missing tool. Do I need to do some error trapping the way of looking for a different kind of string, such as "NULL" or something? For my testing, I deleted tool 3, it lists tools one and 2 fine, lists tool 4 as T3, then freezes up, possibly an infinite loop.

 

I have no idea what to look for to see if a tool is missing.

 

John

Link to comment
Share on other sites
Bullines Newbie

Bullines

Posted
Posted

I'll explain my loop with a little bit more detail. I'll repost my code and just highlight the important parts:

 

code:
Dim nCount     ' number of operations

Dim nToolNum ' tool number

Dim nOpNum ' operation number

 

' get the number of operations

nCount = GetOperationCount("")

 

' get the id of the first operation

nOpNum = GetFirstOperationID("")

 

' loop as long as there are operations to get

Do

' get the tool number using the current operation

nToolNum = GetToolNumberFromOperationID("", nOpNum)

 

' show the nitty gritty details

ShowString "Operation ID: " & nOpNum & vbLf & "Tool number: " & nToolNum

 

' get the next operations

nOpNum = GetNextOperationID()

Loop While(nOpNum <> -1)

First, we'll find out how many operations you have. This is purely for a "there are x number of ops in this file". It has nothing to do with how the WHILE loop will work. Each operation uses a tool, so if we know ho many operations we have, we'll also know how many tools there are. But we won't know the tool numbers...not yet, anyway:

 

code:
' get the number of operations

nCount = GetOperationCount("")

The next line does have a lot to do with how the WHILE loop works. It puts us at the start of the list of operations:

 

code:
' get the id of the first operation

nOpNum = GetFirstOperationID("")

Now we'll start the loop. We will sequentially "touch" an operation in each iteration of the loop. And we will continue to stay in the loop as long as there are operations to "touch"

 

code:
' loop as long as there are operations to get

Do

Now we'll figure out all of our tool numbers. We'll do that with GetToolNumberFromOperationID(). We'll get the tool number based on the operation that we're on and not via a sequence of integers that can't take out-of-sequence tool numbers into account. Where did we get an operation ID? Well to start, we got the op ID of the first operation before we entered the loop:

 

code:
    ' get the tool number using the current operation

nToolNum = GetToolNumberFromOperationID("", nOpNum)

Now do something with the tool info:

code:
' do some stuff

Now we'll get the next operation ID. We won't be incrementing a counter or a variable like that. We'll call GetNextOperationID() and let Mastercam be responsible for telling us what the next operation in the list of operations is. The operation we get from GetNextoperationID is what we'll use to determine the tool number of the next iteration of the loop (if there are more operations remaining):

 

code:
' get the next operations

nOpNum = GetNextOperationID()

Then we close up the loop code. This line determines whether our loop contuinues or ends here. If GetNextOperationID from the line before is unable to get the next ID because there are no more, the function returns the value -1. So if there are no more operations, that's our sign to end the loop:

 

code:
Loop While(nOpNum <> -1)

So with your code, and if you don't need arrays, you could do something like the following:

 

code:
Dim nToolNum   ' tool number

Dim nOpNum ' operation number

Dim strText ' tool info string

 

' get the id of the first operation

nOpNum = GetFirstOperationID("")

 

' loop as long as there are operations to get

Do

' get the tool number using the current operation

nToolNum = GetToolNumberFromOperationID("", nOpNum)

 

' assemble the string

strText = "T" & nToolNum & vbTab & _

GetToolComment(nToolNum) & vbTab & " " & _

GetToolDiameter(nToolNum) & vbTab & " " & _

GetToolFluteLength(nToolNum) & vbTab & _

GetToolLength(nToolNum)

 

' write out the tool info to Word

Call WriteToWord(strText)

 

' get the next operations

nOpNum = GetNextOperationID()

Loop While(nOpNum <> -1)

If you still want to store it all in arrays, that's no problem. You'd then add an index varriable for the arrays and increment it on each iteration of the loop.

 

Hope this clears it up wink.gif

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Bullines,

Your code works, but it seems the trick is to list each tool only once, then only 10 tools each in 2 columns. Straight, your code will list all operations.

 

I can't seem to do this correctly. Whatever I try either gives me an inifinite loop, or lists tool 1 once. I'm trying to puzzle out the logic to do this now.

 

John

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

Heres what I have. It works fine when tools are consecutive, but skips the remaining tools after the missing one. this is the code for one column.

 

 

I don't know if the if-next loop in ther messed things up, but I just can't figure out how to cut up the tool list into 2 columns of 10 tools each

 

code:
nCount=GetFirstOperationID("")  'Get id of first operation

toolcount=1

Do

nToolNum=GetToolNumberFromOperationID("",nCount)

 

If toolcount=nToolNum Then

strText="T"&nToolNum&vbTab& _

GetToolComment(nToolNum)&vbTab& _

GetToolDiameter(nToolNum)&vbTab& _

GetToolFluteLength(nToolNum)&vbTab& _

GetToolLength(nToolNum)

With wordDoc 'output to word

.Selection.MoveDown wdLine, .ActiveDocument.Words.Count

.Selection.TypeParagraph

.Selection.TypeText strText

End With

toolcount=toolcount+1

'nCount=GetNextOperationID()

 

'Else nToolNum=nToolNum+1

End If

nCount=GetNextOperationID()

 

Loop While (nCount<>-1) And nToolNum<=10

 

John

Link to comment
Share on other sites
Bullines Newbie

Bullines

Posted
Posted

Try this:

 

code:
nCount=GetFirstOperationID("")  'Get id of first operation

Do

nToolNum=GetToolNumberFromOperationID("",nCount)

 

strText="T"&nToolNum&vbTab& _

GetToolComment(nToolNum)&vbTab& _

GetToolDiameter(nToolNum)&vbTab& _

GetToolFluteLength(nToolNum)&vbTab& _

GetToolLength(nToolNum)

 

With wordDoc 'output to word

.Selection.MoveDown wdLine, .ActiveDocument.Words.Count

.Selection.TypeParagraph

.Selection.TypeText strText

End With

 

nCount=GetNextOperationID()

Loop While (nCount<>-1)

quote:

but I just can't figure out how to cut up the tool list into 2 columns of 10 tools each

In that case, you can use your toolcount variable to keep track of how many tools you've done so far, incrementing it on each interation of the DO-WHILE loop, and store everything in arrays or another data structure. Then loop through the arrays afterwards and start a new column when (toolcount Mod 10 = 0) or something like that. But DO NOT use your toolcount variable for exit conditions of the loop. remember, tool numbers may not be sequential so let GetNextOperationID() determine when the loop ends.

Link to comment
Share on other sites
John T. Newbie

John T.

Posted
  • Author
Posted

I still haven't figured out the logic for splitting the tool list, but I'm working on it. smile.gif

 

But anyway, we have a theory that what causes MC to crash when using this doc sheet is that it has something to do with transformed operations. The one thing in common all the programs that crash has been transformed operations.

Interesting. We'll be putting it to the test shortly.

 

John

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
Go to topic listing

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

Useful Links

Contact Info

Subscribe to eMastercam News

 

Legal

Privacy Policy

Store Terms & Conditions

Forum Guidelines

Follow us

×
×
  • Create New...