584,842 active members*
4,259 visitors online*
Register for free
Login
IndustryArena Forum > CAM Software > Alphacam > VBA assign button
Results 1 to 3 of 3
  1. #1
    Join Date
    Aug 2009
    Posts
    18

    VBA assign button

    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

  2. #2
    Join Date
    Apr 2015
    Posts
    327

    Re: VBA assign button

    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

  3. #3
    Join Date
    Mar 2020
    Posts
    1

    Re: VBA assign button

    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!

Similar Threads

  1. How to assign multiple E-stop pins. Mach3/ESS
    By SWATH in forum Mach Software (ArtSoft software)
    Replies: 1
    Last Post: 06-07-2019, 08:23 PM
  2. Replies: 0
    Last Post: 05-08-2018, 03:25 PM
  3. how to assign tool multiple offsets 640m
    By kentucky jeremy in forum Mazak, Mitsubishi, Mazatrol
    Replies: 0
    Last Post: 04-18-2015, 01:22 AM
  4. Replies: 4
    Last Post: 01-16-2012, 03:14 AM
  5. Re-Assign Logitech mouse key
    By Al_The_Man in forum Autodesk
    Replies: 0
    Last Post: 05-08-2011, 08:49 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •