VB Script Query

[Mick]

Hi there,

 

I'm asking this on behalf of a local user. He wants to achieve the following:

 

He wants to manipulate entities in the following manner

 

Quote:

* As some of these MC9 files were imported from DXF, the layer names have

various names. I need to erase all them and rename Level 1 to HOLDER and

Level 2 to Cutter

* Change the layer of all entities to LEVEL 1 (Holder Profile)

* Change some entities to LEVEL 2 (Cutter profile)

* XFORM-ROTATE all entities about the origin by -90 degrees

* RAM SAVE, deleting duplicate entities

 

The resulting MC9 File will then be exported to DXF, which VB will support, when I work out how to do it

Unquote.

 

I would assume this isn't possible, since it isn't possible to change "some" entities to Level 2, as I am sure that VB would have trouble defining "some"

 

This is all a requirement to convert DXF files of tools into Mastercam, and them prepare them so they can be read into Vericut.

 

I'm just after some feedback on this

[Steve Biehl - Cimquest Inc]

other than defining 'some', this can be done in a script. Maybe 'some' is a specific layer or color already? Or the script could prompt to select 'some' geometry?

[Bullines]

How about this? I whipped this up pretty quick so it's untested

 

code:

---

'////////////////////////////////////////////////////////////////////////////////

'//

'// Author: Chris Bellini [email protected]

'// Date: 03/08/2005 8:29 AM

'// File Name: Mick_at_AxsysCNC.vbs

'//

'// Description: Does a bunch of things that Mick wants when he opens DWGs

'//

'// Comments: Maybe someday it can move "some" entities to Level 2

'//

'////////////////////////////////////////////////////////////////////////////////

 

'///////////////// My Constants /////////////////

Const DEF_LEVEL1_NAME = "Holder"

Const DEF_LEVEL2_NAME = "Cutter"

 

' Call the main subroutine

Call Main()

 

' Purpose: The main subroutine

Sub Main()

Dim iLevelNo ' level number

 

 

' Exit the script if there's no geometry

If Not (IsDrawing()) Then

Exit Sub

End If

 

' Toast all of the level names and make them visible

For iLevelNo = 1 To 255

' clear the level name

Call SetLevelName(iLevelNo, vbNullString)

Next

 

' Move all entities to Level 1

Call MoveAllEntsToNewLevel(1)

 

' Rename level 1 and 2

Call SetLevelName(1, DEF_LEVEL1_NAME)

Call SetLevelName(2, DEF_LEVEL2_NAME)

 

' Rotate the geo 90deg about the origin

' Note: This function requires a recent version of Mastercam VBS.

' I believe this is included with MR0105. If not, you may need to

' contact your reseller or CNC Software.

Call SelectAll()

If Not (Rotate(0, 0, 0, 90, False)) Then

ShowString "Error: Unable to rotate entities"

End If

 

' Do a ram saver

Call RunMastercamCommand("ramsaver")

 

' All done

ShowString("Done!")

End Sub

 

 

' Purpose: move all entities to the desired level

' I: the new level

' O: (none)

Sub MoveAllEntsToNewLevel(iNewLevel)

Dim bSuccf ' success flag

 

 

' try to get the first entity in the db

bSuccf = StartDBSearch(mc_alive, -1)

 

' good to go?

If bSuccf Then

Do

If iNewLevel <> GetEntityLevel Then

Call SetEntityLevel(iNewLevel)

End If

 

' get the next entity

bSuccf = NextDBSearch()

Loop While bSuccf

End If

End Sub

 

 

' Purpose: Determine if this there is geometry in this file

' I: (none)

' O: True=valid, False=not valid

Function IsDrawing()

Dim bRet

 

 

bRet = StartDBSearch(mc_alive, -1)

 

IsDrawing = bRet

End Function

---

Yup, that "some" entities might be tough. As it stands, this script will move all entities to level 1 and they could manually move those "some" entities to level 2. Need more info to attempt to automate that "some", though

 

PS: Your question is similar to this one.