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
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
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
Alphacam post and VBA macros, Autodesk HSM post.
www.cadcam-softcz.cz
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!