VBA assign button

[fikri]

Hello,
I created some VBA project. I must run it by going to macro and then RUN.
Is there way to make custom button in menu for running it?

Thanks

Similar Threads:

• How to assign multiple E-stop pins. Mach3/ESS
• Need Help!- Mazak QC 20/40 with M2 control cannot assign tools or tool changes stuck on tool zero
• how to assign tool multiple offsets 640m
• Cut 2D - How to I assign 1 toolpath to multiple vectors?
• Re-Assign Logitech mouse key

[Maroslav4]

Yes of course.

For example you can create module - Events and use something like this

Option Explicit


Function InitAlphacamAddIn(AcamVersion As Long) As Integer


Dim fr As Frame
Set fr = App.Frame
fr.AddMenuItem2 "Test_1111", "show_Form1", acamMenuNEW, "&Write something"
InitAlphacamAddIn = 1

End Function

Function show_Form1()
Load FrmMain
FrmMain.Show
End Function

Check also API documentation in Alphacam - try find Frame.AddMenuItem2

[PaoloTreponti]

Hi I'm new in this forum but I found really interesting topics.
I created a macro for making automatic (personalized) saw cut after importing the solid from inventor
to alphacam. I'd like to add a button wich recalls the macro but I can't do it. Have you some suggestions?
This is the code:
Option Explicit


Function InitAlphacamAddIn(AcamVersion As Long) As Integer
Dim frm As Frame
Set frm = App.Frame
frm.AddMenuItem2 "&Lama", "Lama", acamMenuNEW, "Lama"
frm.AddButton acamButtonBarCAD_GEOMETRY, "Saw.bmp", frm.LastMenuCommandID
InitAlphacamAddIn = 1
End Function


Public Function Lama()
Dim Drw As Drawing
Set Drw = App.ActiveDrawing
App.SelectTool App.LicomdatPath & "LICOMDAT\RTools.Alp\Frese mie\LAMA-160.art"

Dim lyr As Layer
For Each lyr In Drw.Layers

If lyr.Name = "EST" Then

Dim i As Integer
Dim Amax As LongLong

Dim P1 As Path 'Geometria su EST'
Set P1 = lyr.Geometries(1)
Amax = P1.GetArea(-1)

For i = 1 To lyr.Geometries.Count
If (lyr.Geometries(i).GetArea(-1) > Amax) Then
Set P1 = lyr.Geometries(i)
Amax = P1.GetArea(-1)
End If
Next i

Dim P2 As Path
Set P2 = P1.Copy

Dim Lam As Layer
Set Lam = Drw.CreateLayer("LAMA")
P2.SetLayer Lam

Dim Xmin As Double
Xmin = P2.MinXL

Dim Xmax As Double
Xmax = P2.MaxXL

Dim Ymin As Double
Ymin = P2.MinYL

Dim Ymax As Double
Ymax = P2.MaxYL
P2.Delete
Dim h As Integer
h = Drw.SolidParts(1).MinZ

Dim L1 As Path
Set L1 = Drw.Create2DLine(Xmin - 10, Ymax, Xmax + 60, Ymax)
L1.SetLayer Lam

Dim L2 As Path
Set L2 = Drw.Create2DLine(Xmax, Ymax + 60, Xmax, Ymin - 60)
L2.SetLayer Lam

Dim L3 As Path
Set L3 = Drw.Create2DLine(Xmin - 10, Ymin, Xmax + 60, Ymin)
L3.SetLayer Lam

Dim L4 As Path
Set L4 = Drw.Create2DLine(Xmin, Ymax + 60, Xmin, Ymin - 60)
L4.SetLayer Lam

L4.ToolInOut = acamOUTSIDE
L4.Selected = True
Dim MD As MillData
Set MD = App.CreateMillData

MD.SawOpenEnds = acamSawCUT_ON
MD.SawHeadPosition = acamSawHeadLEFT
MD.FinalDepth = h - 3
MD.NumberOfCuts = 1
Dim PS As Paths
Set PS = MD.Saw

L2.ToolInOut = acamOUTSIDE
L2.Selected = True
Set MD = App.CreateMillData
MD.SawOpenEnds = acamSawCUT_ON
MD.SawHeadPosition = acamSawHeadRIGHT
MD.FinalDepth = -21 'Z +3: dovrei leggerlo da altro layer'
MD.NumberOfCuts = 1
Set PS = MD.Saw

L1.ToolInOut = acamOUTSIDE
L1.Selected = True
Set MD = App.CreateMillData
MD.SawOpenEnds = acamSawCUT_ON
MD.SawHeadPosition = acamSawHeadRIGHT
MD.FinalDepth = -21 'Z +3: dovrei leggerlo da altro layer'
MD.NumberOfCuts = 1
Set PS = MD.Saw

L3.ToolInOut = acamOUTSIDE
L3.Selected = True
Set MD = App.CreateMillData
MD.SawOpenEnds = acamSawCUT_ON
MD.SawHeadPosition = acamSawHeadLEFT
MD.FinalDepth = -21 'Z +3: dovrei leggerlo da altro layer'
MD.NumberOfCuts = 1
Set PS = MD.Saw

End If
Next lyr

End Function

Thank you!