I want to make some changes on my setup sheet, but i´m not really familiar with Visual Basic

Here is the code i want to modify:

OpSheet.Cell(firstrow + i, 1 ) = CStr(slot)
OpSheet.Cell(firstrow + i, 2 ) = oper.Tool.Name
OpSheet.Cell(firstrow + i, 3 ) = oper.FeatureName
OpSheet.Cell(firstrow + i, 4 ) = oper.SpeedText
OpSheet.Cell(firstrow + i, 5 ) = oper.FeedText
OpSheet.Cell(firstrow + i, 6 ) = oper.DepthText
OpSheet.Cell(firstrow + i, 7 ) = oper.Tool.
OldTOOL = oper.Tool.Name
i = i + 1

Instead of oper.SpeedText it should show me the exposed length of the tool.
I´m not sure about the variable for this command if any exist ,so if you have any ideas please answer!

Thanks

camwork,

I think the property you need to obtain is oper.tool.exposedlength. However, it is a numerical type so I don't think it can be plugged directly into the code - needs to be converted to string type.

I haven't done much with VB so need to leave more precise commentary to one of the gurus. I would try it myself, but can't seem to find the code you are referencing in either of the two 'Setup....bas' programs on the addin page at the FC website.

Fred

The add-in is from my locale Fcam distributor so it is not enable from Delcam
I post the hole code here!

' last tested with 9.3.0.09

Public Sub Werkzeugliste
'Public Sub main
Dim MSWord As Word.Application
Dim Doc As Word.Document
Dim OpSheet As Word.Table
Dim SQL As String
Dim LastDate As Date
Dim Result As Boolean
Dim FMDoc As MFGDocument
Dim OldTOOL As String

Set FMDoc = Application.ActiveDocument
Set MSWord = New Word.Application
MSWord.Visible = True

Set Doc = MSWord.Documents.Add

' select entire document
MSWord.Selection.WholeStory

' delete entire selection
MSWord.Selection.Delete

' turn on table gridlines
MSWord.ActiveWindow.View.TableGridlines = True

' turn landscape
MSWord.ActiveDocument.PageSetup.Orientation =wdOrientLandscape

' set font size to 22 points
'MSWord.Selection.Font.Size = 22

' set font color to red
'MSWord.Selection.Font.ColorIndex = wdRed ' use wdAuto to turn it back

'MSWord.Selection.TypeText "Your Account details:" & vbNewLine
'MSWord.Selection.TypeParagraph
'MSWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'MSWord.Selection.Font.Size = 12

' add table and format it
Dim Rows As Integer
Rows = FMDoc.Operations.Count + 7 'Added 7 extra rows to account for the headers
Set OpSheet = Doc.Tables.Add(MSWord.Selection.Range, Rows, 7)
OpSheet.PreferredWidthType = wdPreferredWidthPercent
OpSheet.PreferredWidth = 200 ' MSWord.InchesToPoints(10)
OpSheet.AutoFormat wdTableFormatNone
OpSheet.Columns(1).Width = MSWord.InchesToPoints(0.
OpSheet.Columns(2).Width = MSWord.InchesToPoints(2.5)
OpSheet.Columns(3).Width = MSWord.InchesToPoints(2)
OpSheet.Columns(4).Width = MSWord.InchesToPoints(1)
OpSheet.Columns(5).Width = MSWord.InchesToPoints(1.4)
OpSheet.Columns(6).Width = MSWord.InchesToPoints(1)
OpSheet.Columns(7).Width = MSWord.InchesToPoints(1.5)
OpSheet.Rows.AllowBreakAcrossPages = False
'OpSheet.AutoFitBehavior(wdAutoFitWindow)
'OpSheet.AllowAutoFit = True
'OpSheet.Columns(2).Width = MSWord.CentimetersToPoints(3)

Dim firstrow As Integer

firstrow = 1

' merge the first row
OpSheet.Rows(firstrow).Cells.Merge
' set some shading on the first row
OpSheet.Rows(firstrow).Shading.Texture = wdTexture10Percent
' set a title
OpSheet.Rows(firstrow).Range.text = "LTD"
OpSheet.Rows(firstrow).Range.Font.Size = 27
' center the title
OpSheet.Rows(firstrow).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
' make it bold
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

' merge the first row
OpSheet.Rows(firstrow).Cells.Merge
' set some shading on the first row
OpSheet.Rows(firstrow).Shading.Texture = wdTexture10Percent
' set a title
OpSheet.Rows(firstrow).Range.text = "Werkzeugliste"
OpSheet.Rows(firstrow).Range.Font.Size = 27
' center the title
OpSheet.Rows(firstrow).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
' make it bold
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

OpSheet.Cell(firstrow, 1).Range.text = "Datei: " & FMDoc.Name
OpSheet.Cell(firstrow, 2).Range.text = "NC Programmname: " & FMDoc.PartName
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

OpSheet.Cell(firstrow, 1).Range.text = "Einheit: " & IIf( FMDoc.Metric = True, "MM", "Inch" )
If TypeName( FMDoc ) = "IFMDocument" Then
OpSheet.Cell(firstrow, 2).Range.text = "Material: " & FMDoc.Stock.Material
End If
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

If TypeName( FMDoc ) = "IFMDocument" Then
OpSheet.Cell(firstrow, 1).Range.text = "Setup: " & FMDoc.ActiveSetup
End If
OpSheet.Cell(firstrow, 2).Range.text = "Datum: " & Date
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

Dim length As Double, wid As Double, thick As Double
Dim od As Double, id As Double, nsides As Long
Dim axisType As tagFMAxisType
Dim stockCurve As String
Dim stockType As tagFMStockType

If TypeName( FMDoc ) = "IFMDocument" Then
FMDoc.Stock.GetDimensions( stockType, length, wid, thick, od, id, axisType, nsides, stockCurve )
OpSheet.Cell(firstrow, 1).Range.text = "Rohteil: L" & length & " B" & wid & " H" & thick
End If
OpSheet.Cell(firstrow, 2).Range.text = "Programmiert:"
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

' Populate Table
OpSheet.Cell(firstrow, 1).Range.text = "T Nr."
OpSheet.Cell(firstrow, 2).Range.text = "Tool Name"
OpSheet.Cell(firstrow, 3).Range.text = "Feature"
OpSheet.Cell(firstrow, 4).Range.text = "Speed"
OpSheet.Cell(firstrow, 5).Range.text = "Feed"
OpSheet.Cell(firstrow, 6).Range.text = "Depth"
OpSheet.Cell(firstrow, 7).Range.text = "Holder"
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

'OpSheet.Cell(firstRow + 1, 1).Range.Text = "T:"
'OpSheet.Cell(firstRow + 1, 2).Range.Text = 50
'OpSheet.Cell(firstRow + 2, 1).Range.Text = "A:"
'OpSheet.Cell(firstRow + 2, 2).Range.Text = 100

' make the last cell be a total
'OpSheet.Cell(firstRow + 3, 2).Select
'MSWord.Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="#,##0.00"

' turn on borders of the table
With OpSheet.Borders
.InsideLineStyle = wdLineStyleSingle
.OutsideLineStyle = wdLineStyleDouble
End With

Dim oper As FMOperation, tool As FMToolMap, slot As Long

Dim i As Integer

i = 0
OldTOOL = ""
For Each oper In FMDoc.Operations
If oper.Tool.Name<> OldTOOL Then
For Each tool In FMDoc.ToolMaps
If Not (oper.Tool Is Nothing) Then
If (tool.Tool = oper.Tool) Then
slot=tool.ToolNumber
End If
End If
Next

OpSheet.Cell(firstrow + i, 1 ) = CStr(slot)
OpSheet.Cell(firstrow + i, 2 ) = oper.Tool.Name
OpSheet.Cell(firstrow + i, 3 ) = oper.FeatureName
OpSheet.Cell(firstrow + i, 4 ) = oper.SpeedText
OpSheet.Cell(firstrow + i, 5 ) = oper.FeedText
OpSheet.Cell(firstrow + i, 6 ) = oper.DepthText
OpSheet.Cell(firstrow + i, 7 ) = oper.Tool.Holder
OldTOOL = oper.Tool.Name
i = i + 1
End If
Next
End Sub

' Add a toolbar and buttons upon loading of this addin into FeatureCAM.
'
Private Sub AddIn_OnConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)
' Bar name Button name Button face ID

MakeButtonAndBar "Utilities", "Werkzeugliste", 42

End Sub
'
' remove button or hide toolbar if add-in deselected
'
Private Sub AddIn_OnDisConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)

HideDeleteBarButton "Utilities", "Werkzeugliste"

End Sub
Private Sub MakeButtonAndBar(ByVal bar_name As String, ByVal button_name As String, _
ByVal button_id As Integer)

Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarBtn
Set bars = Application.CommandBars
Set bar = bars(bar_name)

If bar Is Nothing Then
Set bar = bars.Add(bar_name)
Else
bar.Visible = True
End If

Set ctrl = bar.Controls(button_name)

If ctrl Is Nothing Then
Set ctrl = bar.Controls.Add( ,,button_name)
ctrl.FaceId = button_id
bar.Visible = True
End If

End Sub
Private Sub HideDeleteBarButton(ByVal bar_name As String, ByVal button_name As String)

Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarCtrl

Set bars = Application.CommandBars
Set bar = bars(bar_name)

If Not bar Is Nothing Then
Set ctrl = bar.Controls(button_name)
If Not ctrl Is Nothing Then
If bar.Controls.Count > 1 Then
ctrl.Delete
Else
bar.Visible=False
End If
End If
End If
End Sub

The Add-in is from my local Fcam distributor it´s not enable from Delcam
I post the hole code here!


' last tested with 9.3.0.09

Public Sub Werkzeugliste
'Public Sub main
Dim MSWord As Word.Application
Dim Doc As Word.Document
Dim OpSheet As Word.Table
Dim SQL As String
Dim LastDate As Date
Dim Result As Boolean
Dim FMDoc As MFGDocument
Dim OldTOOL As String

Set FMDoc = Application.ActiveDocument
Set MSWord = New Word.Application
MSWord.Visible = True

Set Doc = MSWord.Documents.Add

' select entire document
MSWord.Selection.WholeStory

' delete entire selection
MSWord.Selection.Delete

' turn on table gridlines
MSWord.ActiveWindow.View.TableGridlines = True

' turn landscape
MSWord.ActiveDocument.PageSetup.Orientation =wdOrientLandscape

' set font size to 22 points
'MSWord.Selection.Font.Size = 22

' set font color to red
'MSWord.Selection.Font.ColorIndex = wdRed ' use wdAuto to turn it back

'MSWord.Selection.TypeText "Your Account details:" & vbNewLine
'MSWord.Selection.TypeParagraph
'MSWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'MSWord.Selection.Font.Size = 12

' add table and format it
Dim Rows As Integer
Rows = FMDoc.Operations.Count + 7 'Added 7 extra rows to account for the headers
Set OpSheet = Doc.Tables.Add(MSWord.Selection.Range, Rows, 7)
OpSheet.PreferredWidthType = wdPreferredWidthPercent
OpSheet.PreferredWidth = 200 ' MSWord.InchesToPoints(10)
OpSheet.AutoFormat wdTableFormatNone
OpSheet.Columns(1).Width = MSWord.InchesToPoints(0.
OpSheet.Columns(2).Width = MSWord.InchesToPoints(2.5)
OpSheet.Columns(3).Width = MSWord.InchesToPoints(2)
OpSheet.Columns(4).Width = MSWord.InchesToPoints(1)
OpSheet.Columns(5).Width = MSWord.InchesToPoints(1.4)
OpSheet.Columns(6).Width = MSWord.InchesToPoints(1)
OpSheet.Columns(7).Width = MSWord.InchesToPoints(1.5)
OpSheet.Rows.AllowBreakAcrossPages = False
'OpSheet.AutoFitBehavior(wdAutoFitWindow)
'OpSheet.AllowAutoFit = True
'OpSheet.Columns(2).Width = MSWord.CentimetersToPoints(3)

Dim firstrow As Integer

firstrow = 1

' merge the first row
OpSheet.Rows(firstrow).Cells.Merge
' set some shading on the first row
OpSheet.Rows(firstrow).Shading.Texture = wdTexture10Percent
' set a title
OpSheet.Rows(firstrow).Range.text = "Präzisionstechnik GmbH"
OpSheet.Rows(firstrow).Range.Font.Size = 27
' center the title
OpSheet.Rows(firstrow).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
' make it bold
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

' merge the first row
OpSheet.Rows(firstrow).Cells.Merge
' set some shading on the first row
OpSheet.Rows(firstrow).Shading.Texture = wdTexture10Percent
' set a title
OpSheet.Rows(firstrow).Range.text = "Werkzeugliste"
OpSheet.Rows(firstrow).Range.Font.Size = 27
' center the title
OpSheet.Rows(firstrow).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
' make it bold
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

OpSheet.Cell(firstrow, 1).Range.text = "Datei: " & FMDoc.Name
OpSheet.Cell(firstrow, 2).Range.text = "NC Programmname: " & FMDoc.PartName
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

OpSheet.Cell(firstrow, 1).Range.text = "Einheit: " & IIf( FMDoc.Metric = True, "MM", "Inch" )
If TypeName( FMDoc ) = "IFMDocument" Then
OpSheet.Cell(firstrow, 2).Range.text = "Material: " & FMDoc.Stock.Material
End If
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

If TypeName( FMDoc ) = "IFMDocument" Then
OpSheet.Cell(firstrow, 1).Range.text = "Setup: " & FMDoc.ActiveSetup
End If
OpSheet.Cell(firstrow, 2).Range.text = "Datum: " & Date
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 7))
Call OpSheet.Cell(firstrow, 1).Merge(OpSheet.Cell(firstrow, 3))

Dim length As Double, wid As Double, thick As Double
Dim od As Double, id As Double, nsides As Long
Dim axisType As tagFMAxisType
Dim stockCurve As String
Dim stockType As tagFMStockType

If TypeName( FMDoc ) = "IFMDocument" Then
FMDoc.Stock.GetDimensions( stockType, length, wid, thick, od, id, axisType, nsides, stockCurve )
OpSheet.Cell(firstrow, 1).Range.text = "Rohteil: L" & length & " B" & wid & " H" & thick
End If
OpSheet.Cell(firstrow, 2).Range.text = "Programmiert:"
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

' Populate Table
OpSheet.Cell(firstrow, 1).Range.text = "T Nr."
OpSheet.Cell(firstrow, 2).Range.text = "Tool Name"
OpSheet.Cell(firstrow, 3).Range.text = "Feature"
OpSheet.Cell(firstrow, 4).Range.text = "Speed"
OpSheet.Cell(firstrow, 5).Range.text = "Feed"
OpSheet.Cell(firstrow, 6).Range.text = "Depth"
OpSheet.Cell(firstrow, 7).Range.text = "Holder"
OpSheet.Rows(firstrow).Range.Bold = True
firstrow = firstrow + 1

'OpSheet.Cell(firstRow + 1, 1).Range.Text = "T:"
'OpSheet.Cell(firstRow + 1, 2).Range.Text = 50
'OpSheet.Cell(firstRow + 2, 1).Range.Text = "A:"
'OpSheet.Cell(firstRow + 2, 2).Range.Text = 100

' make the last cell be a total
'OpSheet.Cell(firstRow + 3, 2).Select
'MSWord.Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="#,##0.00"

' turn on borders of the table
With OpSheet.Borders
.InsideLineStyle = wdLineStyleSingle
.OutsideLineStyle = wdLineStyleDouble
End With

Dim oper As FMOperation, tool As FMToolMap, slot As Long

Dim i As Integer

i = 0
OldTOOL = ""
For Each oper In FMDoc.Operations
If oper.Tool.Name<> OldTOOL Then
For Each tool In FMDoc.ToolMaps
If Not (oper.Tool Is Nothing) Then
If (tool.Tool = oper.Tool) Then
slot=tool.ToolNumber
End If
End If
Next

OpSheet.Cell(firstrow + i, 1 ) = CStr(slot)
OpSheet.Cell(firstrow + i, 2 ) = oper.Tool.Name
OpSheet.Cell(firstrow + i, 3 ) = oper.FeatureName
OpSheet.Cell(firstrow + i, 4 ) = oper.SpeedText
OpSheet.Cell(firstrow + i, 5 ) = oper.FeedText
OpSheet.Cell(firstrow + i, 6 ) = oper.DepthText
OpSheet.Cell(firstrow + i, 7 ) = oper.Tool.Holder
OldTOOL = oper.Tool.Name
i = i + 1
End If
Next
End Sub

' Add a toolbar and buttons upon loading of this addin into FeatureCAM.
'
Private Sub AddIn_OnConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)
' Bar name Button name Button face ID

MakeButtonAndBar "Utilities", "Werkzeugliste", 42

End Sub
'
' remove button or hide toolbar if add-in deselected
'
Private Sub AddIn_OnDisConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)

HideDeleteBarButton "Utilities", "Werkzeugliste"

End Sub
Private Sub MakeButtonAndBar(ByVal bar_name As String, ByVal button_name As String, _
ByVal button_id As Integer)

Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarBtn
Set bars = Application.CommandBars
Set bar = bars(bar_name)

If bar Is Nothing Then
Set bar = bars.Add(bar_name)
Else
bar.Visible = True
End If

Set ctrl = bar.Controls(button_name)

If ctrl Is Nothing Then
Set ctrl = bar.Controls.Add( ,,button_name)
ctrl.FaceId = button_id
bar.Visible = True
End If

End Sub
Private Sub HideDeleteBarButton(ByVal bar_name As String, ByVal button_name As String)

Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarCtrl

Set bars = Application.CommandBars
Set bar = bars(bar_name)

If Not bar Is Nothing Then
Set ctrl = bar.Controls(button_name)
If Not ctrl Is Nothing Then
If bar.Controls.Count > 1 Then
ctrl.Delete
Else
bar.Visible=False
End If
End If
End If
End Sub

camwork,

Took a little bit to get it working here....

Made the following changes to the program:

On line 143 (in my editor - yours may be different) change "Speed" to "Exp. Len.". This makes the heading in the sheet come out correct.

On line 184 change oper.SpeedText to Cstr(oper.Tool.ExposedLength)

That should do it.

Fred

Thank you very much Fred it working fine now

I did not know that the input have to be converted to a string value VB is not my passion!

Fred:

Can you please post a working copy of that? Thanks.

Here is the file you asked for, i tested it with v15.2.0.64.

Hi allez,

Was at the tool show yesterday, so missed your request. Looks like Konstantin took care of it....

Got it working ok?

Fred

Fred:

Yes I did get it working, Thanks. It looks like we missed each other by a day at the show, we should have tried to hook up, maybe next time.

This works like a champ in V15... for some reason V16.1 it crashes half way thru the routine.

Anyone have any ideas. I'm very new to Sax Basic.

thanks, Matt

Matt,

When it crashes with 16.1, what do you see? Does the whole program go down, or do you get the Sax Basic screen with some text hi-lighted? Also, was your test done on the same computer? (to guarantee it is not an issue with Windows or Word API)

I haven't implemented 16 yet due to some video issues and am awaiting the discs and documentation before doing so. However, I did download 16.0.1.46 and install it several weeks ago (to get some info for posts in another part of the forum). I fired it up this morning and ran the addin - it seems to work with 16.0.

I'm no wizard when it comes to Visual Basic, but once the logic of an addin program is working, the usual culprit is a change to the API, like altering a variable name or changing its type to accommodate some new or future feature in FC.

Fred

Strangely enough after a fresh reboot its all working fine

Go figure... we will call this one due to sun spots.

Lesson learned if something goes wrong reboot and try again before posting

Matt

Thank you very much Fred it working fine now .I did not know that the input have to be converted to a string value , VB is not my passion!
_____________________________