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:

VBScript for setting up fixture plate


Recommended Posts

'////////////////////////////////////////////////////////////////////////////////
'//
'//        Author:   Jesse T.
'//       Credits:   Mick George [email protected] (I learned from his examples)
'//          Date:   06/2016
'//     File Name:   Fixture Plate Setup.vbs
'//
'//   Description:   This script Imports solids and moves them to fixture locations
'//
'////////////////////////////////////////////////////////////////////////////////

' ////////////////////
' Constants
' ////////////////////
Const ZZero = 0
Const Origin = 0
Const TopView = 1

' -- Start Script
Call Main()

' ////////////////////
' Sub Declaration
' ////////////////////
Sub Main()
    
' ////////////////////
' Variables
' ////////////////////

Dim intLevelNumber
Dim iX, iY, SetDistX, SetDistY, intCountX, intCountY
Dim File_or_Level
Dim Sort_or_Center
Dim SetAngle
Dim NumParts

' -- Initialize
SetAngle = 0
SetDistX = 2.0
SetDistY = 2.0
intCountX = 2
intCountY = 2
intLevelNumber = 2
NumParts = 0
' -- Ask our user for some values
   File_or_Level = askYesNoCancel("This VB Script will help you set up multiple parts on a fixture plate."_
     &VbCrLf&"""CANCEL"" if you want to exit this VBScript."_
     &VbCrLf&"""NO"" if your parts are on seperate LEVELS and the file is already open"_
     &VbCrLf&"""YES"" if your parts are in seperate FILES"_
     &VbCrLf&VbCrLf&"		FILES	          LEVELS	    CANCEL")
  If File_or_Level = 0 Then
   Sort_or_Center = askYesNoCancel("If you want to move your parts to center select ""YES"""_
     &VbCrLf&"If you want to layout a fixture plate select ""No"""_
     &VbCrLf&VbCrLf&"   Parts NOT on center     Parts on center    CANCEL")
  End If
   If File_or_Level = -1 Then Exit Sub
   If Sort_or_Center = -1 Then Exit Sub
  If Sort_or_Center = mcMSG_NO Then
   If Not askValue("Do you have to rotate the part?", -360 , 360, SetAngle) Then Exit Sub
  End If
   If Not askNumber("How many Parts along the X axis?", 1 , 50, intCountX) Then Exit Sub
   If Not askNumber("How many parts along the Y axis?", 1 , 50, intCountY) Then Exit Sub
   If Not askValue("Input X spacing of Parts", 0 , 20, SetDistX) Then Exit Sub
   If Not askValue("Input Y spacing of Parts", 0 , 20, SetDistY) Then Exit Sub

   ' -- Do some math
   Redim Preserve arrPartPosX(intCountX*intCountY)
   Redim Preserve arrPartPosY(intCountX*intCountY)
      For iY = 0 To intCountY - 1
         For iX = 0 To intCountX - 1
         arrPartPosX(NumParts) = (iX * SetDistX)-(((intCountX-1)*SetDistX)/2)
         arrPartPosY(NumParts) = (-(iY * SetDistY))+(((intCountY-1)*SetDistY)/2)
'ShowString "Part# "& NumParts + 1 &" = "& arrPartPosX(NumParts)&", "&arrPartPosY(NumParts)
         NumParts = NumParts + 1
	     Next
      Next
   Call Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)
End Sub
' ////////////////////
' The Sub that does it all
' ////////////////////
Sub Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)

Dim YLoc
Dim XLoc
Dim strLevelName
Dim Revert_Back

Redim Preserve arrLevelUsed(intCountX*intCountY)

'Loads files and translates into fixture locations
If File_or_Level = mcMSG_YES And Sort_or_Center = mcMSG_NO Then
          ShowString "Please select a starting level, parts will load in sequential levels"
          If askLevel(intLevelNumber) Then
   ' -- Rotate and Position Parts
      For NumParts = 0 To (intCountX*intCountY) - 1
      strLevelName = "Position #" & NumParts + 1
        If mc_appversion < 19 Then 'Renames levels if MCam is older than 2017 Version
         Call SetLevelName (intLevelNumber, strLevelName)
        End If
   	     YLoc = arrPartPosY(NumParts)
         XLoc = arrPartPosX(NumParts)
         arrLevelUsed(NumParts) = intLevelNumber
             SetLevelVisibleByNumber intLevelNumber, False
             SelectAll()
             SetLevelByNumber (intLevelNumber)
             Call RepaintScreen(True)
             Call RunMastercamCommand ("DoPattern")
             SetLevelVisibleByNumber intLevelNumber,True
             Call RunMastercamCommand ("GSInvertSelection")
If StartDBSearch(mc_selected, -1)= 0  Then NumParts = (intCountX*intCountY) - 1
             Rotate Origin, Origin, Origin, SetAngle, False
             SetLevelVisibleByNumber intLevelNumber, False
             SelectAll()
             SetLevelByNumber (intLevelNumber)
             SetLevelVisibleByNumber intLevelNumber,True
             Call RunMastercamCommand ("GSInvertSelection")
             Call Move_to_location(XLoc, YLoc, NumParts)
         intLevelNumber = intLevelNumber + 1
      Next
          End If
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts

'Translates individual levels into fixture locations
If File_or_Level = mcMSG_NO And Sort_or_Center = mcMSG_NO Then
   ' -- Rotate and Position Parts
   For NumParts = 0 To (intCountX*intCountY) - 1
      intLevelNumber = intLevelNumber + 1
   	  YLoc = arrPartPosY(NumParts)
      XLoc = arrPartPosX(NumParts)
        If askLevel(intLevelNumber) Then
          arrLevelUsed(NumParts) = intLevelNumber
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Rotate Origin, Origin, Origin, SetAngle, False
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Call Move_to_location(XLoc, YLoc, NumParts)
        End If
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts
'---- Unsorts individual parts to center
If Sort_or_Center = mcMSG_YES Then
   For NumParts = 0 To (intCountX*intCountY) - 1
   	  YLoc = -arrPartPosY(NumParts)
      XLoc = -arrPartPosX(NumParts)
        If AskForEntity("SELECT PART #"&numparts+1,-1) Then
          arrLevelUsed(NumParts) = GetEntityLevel()
          Call Move_to_location(XLoc, YLoc, NumParts)
          Rotate Origin, Origin, Origin, - SetAngle, False
        End If
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts

Revert_Back = askYesNo("Do you want to keep these new locations?")
'---- Reverses Translated individual levels back to original locations
If Revert_Back = mcMSG_NO Then
   For NumParts = 0 To (intCountX*intCountY) - 1
      intLevelNumber = arrLevelUsed(NumParts)
If Sort_or_Center = mcMSG_YES Then
   	  YLoc = arrPartPosY(NumParts)
      XLoc = arrPartPosX(NumParts)
Else
   	  YLoc = -arrPartPosY(NumParts)
      XLoc = -arrPartPosX(NumParts)
End If
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Call Move_to_location(XLoc, YLoc, NumParts)
          SetLevelVisibleByNumber intLevelNumber, False
          SelectAll()
          SetLevelByNumber (intLevelNumber)
          SetLevelVisibleByNumber intLevelNumber,True
          Call RunMastercamCommand ("GSInvertSelection")
          Rotate Origin, Origin, Origin, - SetAngle, False
   Next
End If
 ' -- Clear and Zoom All
  UnselectAll()
  Call RepaintScreen(True)
  Call ClearMenuAndPrompts 
If askYesNo("Repeat the same setup?") = mcMSG_YES Then
   Call Run_Script (NumParts, arrPartPosX, arrPartPosY, intCountX, intCountY, intLevelNumber, File_or_Level, Sort_or_Center, SetAngle)
End If
End Sub

' ////////////////////
' Sub Declaration
' ////////////////////

Sub Move_to_location(XLoc, YLoc, NumParts)   

Const DEF_GIVE_ME_EVERYTHING = -1

Dim bRet

bRet = StartDBSearch(mc_selected, DEF_GIVE_ME_EVERYTHING)

   If bRet Then
     Do 
       ' Change the location of each "selected" entity that we find. 
       Call Translate (Origin, Origin, Origin, XLoc, YLoc, ZZero, TopView, TopView, False)
       bRet = NextDBSearch    
     Loop While bRet  
   End If
' Like it says...
UnselectAll()

End Sub


I accidental deleted my original post.  Here is an updated version that has more options. (This one works MUCH better).

This script will sort or un-sort parts into a grid so they can be cut on a fixture plate.  The reason I made this is because we typically get .X_T files of several parts that are pretty much the same except for cavity numbers or stacking lugs.  Sometimes we'll get a single file with each part on it's own level, other times we'll get each individual part in it's own .X_t file.  I feel I don't contribute enough to this forum to make up for how much help I've received. Hopefully this script will help someone else out.

 

Just copy and paste the code into a text file and save that file as "Fixture Plate Setup.vbs" then run within MasterCam.

  • Like 5
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

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

Follow us

×
×
  • Create New...