vbs in mcamX

[pkrzic]

I have several problems with VB scripts in MastercamX:

- I use function RunMastercamCommand(). It looks like this function is not working in X

- I can not find a way to delete elements on a certain level (like delete, all level function in MCAM), I also can not find a way to delete elements with certain color (like delete, all, color, red).

 

Thanks for answers.

[Mick from CNC Software Inc.]

You may need to update your function calls to RunMastercamCommand.

 

From the Documentation

 

// Run almost any Mastercam command - this gives access to every function

// that is in the mastercam.ftt file. The input character ‘codes’ are listed in the Mastercam .ftt file following the function cpp command.

Void RunMastercamCommand(

String) (Input: character ‘code’ for each function)

[Bullines]

quote:

---

- I can not find a way to delete elements on a certain level (like delete, all level function in MCAM)

---

You would have to iterate through the database, retrieve the level of the current entity and delete it if it's on the level you want. For example, if you want to delete all entities on level 5:

 

code:

---

Const DEF_DELETE_LEVEL = 5

 

Dim iCurrEnt ' entity id of the current entity

Dim bSuccf ' success flag

 

 

' Start searching the database

bSuccf = StartDBSearch(mc_alive, mc_arctype Or mc_pointtype Or mc_linetype Or mc_recttype)

 

Do While bSuccf

' Get the current entity pointer

iCurrEnt = GetEntityEptr()

 

' Delete the entity if it's on the level we're looing for

If (DEF_DELETE_LEVEL = GetEntityLevel()) Then

If Not (DeleteEntity(iCurrEnt) Then _

ShowMessage "Unable to delete entity: " & iCurrEnt

End If

 

' Get the next entity

bSuccf = NextDBSearch()

Loop

---

quote:

---

I also can not find a way to delete elements with certain color (like delete, all, color, red).

---

Similarily, to delete all red entities:

 

code:

---

Dim iCurrEnt   ' entity id of the current entity

Dim bSuccf ' success flag

 

 

' Start searching the database

bSuccf = StartDBSearch(mc_alive, mc_arctype Or mc_pointtype Or mc_linetype Or mc_recttype)

 

Do While bSuccf

' Get the current entity pointer

iCurrEnt = GetEntityEptr()

 

' Delete the entity if it's the colour we're looking for

If (mcCOLOR_RED = GetEntityColor()) Then

If Not (DeleteEntity(iCurrEnt) Then _

ShowMessage "Unable to delete entity: " & iCurrEnt

End If

 

' Get the next entity

bSuccf = NextDBSearch()

Loop

---

HTH

[pkrzic]

Thanks for help!

 

the solutions were most helpful.

 

Now I have a bit more tricky question.

 

I can not find a way to create a picture (it must be colored and shaded - doMetafile can not produce something like this, the DoBitmapfile makes a picture with bad quality)

 

I am trying with first changing background color,

than calling the RunMastercamCommand("ToClipboard") at the and I paste the picture from the clipboard to IrfanView executable and save it from there.

 

The results are not good.

 

Is there any better solution to produce quality screen captions (white background and shaded).

 

Here is my current code:

 

Call Main()

 

Sub Main()

Dim strPathToConv

Dim strCnvtImage

Dim objWSHShell ' WSH Shell object

Dim objShell

 

strPathToConv = "C:mcamxmillPostsi_view32.exe" ' path to IrfanView executable

 

Set objShell = CreateObject("WScript.Shell")

 

SetGViewNumber(mcVIEW_TOP)

Call RepaintScreen(True)

Call SetBackGroundColor(mcCOLOR_WHITE)

Call RepaintScreen(True)

 

Call RunMastercamCommand("ToClipboard")

objShell.SendKeys "{ESC}"

 

strCnvtImage = strPathToConv + " /clippaste /resample=(500,375) /convert=c:picture1.png" ' set command line for pasting into Irfan, resampling and saving as picture1.png

Set objWSHShell = CreateObject("WScript.Shell")

 

Call ShellAndWait (strCnvtImage, False)' runing Irfan executable

 

Call SetBackGroundColor(mcCOLOR_BLACK)

 

Call RepaintScreen(True)

 

Set objWSHShell = Nothing

 

End sub

[Bullines]

Maybe try a third-party library like JSDraw.dll over here to capture the screen.

[pkrzic]

I found out what is the problem:

 

the script is running too fast, so the functions like screen capture do not have time to execute.

 

If I put some ShowMessaqe functions it works OK.

 

My code is like this:

 

 

Call Main()

 

Sub Main()

Dim strPathToConv

Dim strCnvtImage

Dim objWSHShell ' WSH Shell object

Dim objShell

 

strPathToConv = "C:mcamxmillPostsi_view32.exe" ' path to IrfanView executable

 

Set objShell = CreateObject("WScript.Shell")

 

SetGViewNumber(mcVIEW_TOP)

Call RepaintScreen(True)

Call SetBackGroundColor(mcCOLOR_WHITE)

Call RepaintScreen(True)

 

 

Call RunMastercamCommand("ToClipboard")

objShell.SendKeys "{ESC}"

 

Showstring ("waiting") ' !!!! added to wait some time

 

 

strCnvtImage = strPathToConv + " /clippaste /resample=(500,375) /convert=c:picture1.png" ' set command line for pasting into Irfan, resampling and saving as picture1.png

Set objWSHShell = CreateObject("WScript.Shell")

 

Call ShellAndWait (strCnvtImage, False)' runing Irfan executable

 

Call SetBackGroundColor(mcCOLOR_BLACK)

 

Call RepaintScreen(True)

 

Set objWSHShell = Nothing

 

End sub

 

 

So, is there any way to pause the runtime of the script for some time (Instead of the current Showstring ("waiting") solution). I tried the Shell.Sleep method, but It does not work.

 

Anyhow I will look at the JSDraw also.

 

Thanks.

[Bullines]

quote:

---

So, is there any way to pause the runtime of the script for some time (Instead of the current Showstring ("waiting") solution). I tried the Shell.Sleep method, but It does not work.

---

Yup. I noticed that Sleep() doesn't work, too. So I wrote my own cheesy version to use in Mastercam scripts which I call Nap

 

code:

---

' Purpose: An alternative to Wscript.Shell.Sleep().  It uses

' ping commands sent (via -n) as seconds.

' I: number of "seconds" to wait

' O: (none)

Sub Nap(iSeconds)

Const DEF_LOCALHOST_IP = "127.0.0.1"

Dim objShell

 

 

' Create a Shell object

Set objShell = CreateObject("Wscript.Shell")

 

' Run the ping command the number of times specified in

' the iSeconds variable.

objShell.Run "ping -n " & iSeconds & " " & DEF_LOCALHOST_IP, 0, True

 

' Cleanup

Set objShell = Nothing

End Sub

---

It's not very acurate as it uses ping intervals instead of a proper measure of time, but it's pretty close and gets the job done.

 

HTH.