For Mick MCX VB script question

[rsbeadle]

Thanks for the reply in an earlier post. I am having a problem with a script that you wrote for me a while back now that I am using V10. The script will run, but when I am promped for an entity I cannot select one. Not to be too forward but if you could look at the code and mabey tell me what to change I would appreciate it. Here is the code:

 

 

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

'//

'// Author: Mick George [email protected]

'// Date: 05/11/2003 04:42 PM

'// File Name: Copy Entities to Level.vbs

'//

'// Description:

'//

'// Comments: Select an entity to get its level, prompt for a new level and copy all

'// entities from current level to new level.

'//

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

 

'

Const DEF_GIVE_ME_EVERYTHING = -1

 

Public Const DEF_PANEL = "MAND FACE"

Public Const DEF_PANELA = "MAND BACK"

Public Const DEF_PANELB = "CAP FACE"

Public Const DEF_PANELC = "CAP BACK"

Public Const DEF_PANELD = "BACKER FACE"

Public Const DEF_PANELE = "FEEDER BACK"

Public Const DEF_LEVEL_NUMBER = 10

Public Const DEF_LEVEL_NUMBERA = 11

Public Const DEF_LEVEL_NUMBERB = 12

Public Const DEF_LEVEL_NUMBERC = 13

Public Const DEF_LEVEL_NUMBERD = 14

Public Const DEF_LEVEL_NUMBERE = 9

 

 

' -- Start Script

Call Main()

 

 

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

' Sub Declaration

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

Sub Main()

 

Dim CArc, CLine, CPoint, CRect

Dim CArcCopy, CLineCopy, CPointCopy, CRectCopy

Dim intOriginalLevel, intNewLevel

Dim bRet

Dim intColor,intNewColor

Dim intlevel

 

Call SetLevelName(DEF_LEVEL_NUMBER, DEF_PANEL)

Call SetLevelName(DEF_LEVEL_NUMBERA, DEF_PANELA)

Call SetLevelName(DEF_LEVEL_NUMBERB, DEF_PANELB)

Call SetLevelName(DEF_LEVEL_NUMBERC, DEF_PANELC)

Call SetLevelName(DEF_LEVEL_NUMBERD, DEF_PANELD)

Call SetLevelName(DEF_LEVEL_NUMBERE, DEF_PANELE)

 

If Not IsDrawing Then ShowString "We need a drawing": Exit Sub

 

If AskForEntity("**** SELECT AN ENTITY ****", mc_arctype + mc_linetype + mc_recttype + mc_pointtype) Then

' -- Store this entities level for eval

intOriginalLevel = GetEntityLevel

intnewlevel = 10

 

 

If (intNewLevel) Then

' -- Loop through all entities on original level and

' -- make a copy of it on the new level.

bRet = StartDBSearch(mc_alive, DEF_GIVE_ME_EVERYTHING)

 

 

Do

 

 

Select Case GetEntityType

 

Case mc_arctype

 

' -- Is this arc on the same level?

If intOriginalLevel = GetEntityLevel Then

 

Set CArc = New McAr

Set CArcCopy = New McAr

 

' -- Get this arc

If GetArcData(GetEntityEptr, CARC) Then

' -- Copy properties to our new arc

With CArcCopy

.X = CArc.X

.Y = CArc.Y

.Z = CArc.Z

.R = CArc.R

.SA = CArc.SA

.SW = CArc.SW

.VIEW = mcVIEW_TOP ' -- Bug Alert!! hard code for now fix pending

End With

 

' -- Create our new arc on our new level

intColor = GetEntityColor()

If CreateArc(CArcCopy, intColor, intNewLevel) = mcENTITY_INVALID Then

' -- Call the police, we have a situation...

ShowString "Could not create copy of Arc"

Exit Sub

End If

 

Else

' -- OMG

ShowString "Could not get current Arc"

Exit Sub

End If

End If

 

 

Case mc_linetype

 

' -- Is this line on the same level?

If intOriginalLevel = GetEntityLevel Then

 

Set CLine = New McLn

Set CLineCopy = New McLn

 

' -- Get this line

If GetLineData(GetEntityEptr, CLine) Then

' -- Copy properties to our new line

With CLineCopy

.X1 = CLine.X1

.Y1 = CLine.Y1

.Z1 = CLine.Z1

.X2 = CLine.X2

.Y2 = CLine.Y2

.Z2 = CLine.Z2

End With

 

' -- Create our new arc on our new level

intColor = GetEntityColor()

 

If CreateLine(CLineCopy, intColor, intNewLevel) = mcENTITY_INVALID Then

' -- Call the police, we have a situation...

ShowString "Could not create copy of Line"

Exit Sub

End If

 

Else

' -- OMG

ShowString "Could not get current Line"

Exit Sub

End If

End If

 

 

Case mc_pointtype

 

' -- Is this point on the same level?

If intOriginalLevel = GetEntityLevel Then

 

Set CPoint = New McLn

Set CPointCopy = New McLn

 

' -- Get this point

If GetPointData(GetEntityEptr, CPoint) Then

' -- Copy properties to our new point

With CPointCopy

.X = CPoint.X

.Y = CPoint.Y

.Z = CPoint.Z

End With

 

' -- Create our new arc on our new level

intColor = GetEntityColor()

 

If CreatePoint(CPointCopy, intColor, intNewLevel) = mcENTITY_INVALID Then

' -- Call the police, we have a situation...

ShowString "Could not create copy of Point"

Exit Sub

End If

 

Else

' -- OMG

ShowString "Could not get current Point"

Exit Sub

End If

End If

 

Case mc_recttype

 

' -- Is this rectangle on the same level?

If intOriginalLevel = GetEntityLevel Then

 

Set CRect = New McLn

Set CRectCopy = New McLn

 

' -- Get this rect

If GetRectangleData(GetEntityEptr, CRect) Then

' -- Copy properties to our new rect

With CRectCopy

.X1 = CRect.X1

.Y1 = CRect.Y1

.X2 = CRect.X2

.Y2 = CRect.Y2

.Z = CRect.Z

End With

 

' -- Create our new arc on our new level

intColor = GetEntityColor()

 

If CreateRectangle(CRectCopy, intColor, intNewLevel) = mcENTITY_INVALID Then

' -- Call the police, we have a situation...

ShowString "Could not create copy of Rectangle"

Exit Sub

End If

 

Else

' -- OMG

ShowString "Could not get current Rectangle"

Exit Sub

End If

End If

 

 

End Select

 

bRet = NextDBSearch

Loop While bRet

 

 

Call UnselectAll

Call RepaintScreen(True)

 

 

Else

 

' -- Bail...

Exit Sub

End If

 

Else

 

 

End If

 

 

 

 

End Sub

 

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

' Function Declaration

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

 

Function IsDrawing()

 

Dim Ret

 

Ret = StartDBSearch(mc_alive, -1)

 

UnselectAll

 

IsDrawing = Ret

 

End Function

 

 

I did revise it a little to get my colors to stay the same. I am not sure if I got all of it as I copied it several times to copy to several levels. Any help would be great! Thanks

[Bullines]

I'm not Mick but I sometimes play him on TV

 

It appears that there is something wrong with the AskForEntity() function. I tested it with a simple script:

 

code:

---

Call Main()

 

Sub Main()

ShowString "Start"

 

If AskForEntity("Select an entity", mc_arctype + mc_linetype + _

mc_recttype + mc_pointtype) Then

ShowString "Yay, we picked something"

Else

ShowString "Something bad happened."

End If

 

ShowString "End"

End Sub

---

It never allows you to acually select an entity like you mentioned. Strangely enough, I looked in nethook.dll and there aren't any entity types or methods to allow the user to select an entity other than AskForPoint()

 

This is where X's Update feature will shine, just you watch

[Mick from CNC Software Inc.]

I'm afraid you are correct, the AskForEntity() function is not working correctly, we shall address this ASAP, stay tuned.

[benito]

Hello guys,

I wanted to ask you if you a method that I could use to hide the work coordinates from displaying on the screen of any given job?

I use Fanuc 16I and I know how to hide program 8000-9000 series, but I was thinking if is there any way to also "block" the option of the operators having the chance of macking the wrong adjustment that could cause many bad parts.

Maybe ther is a parameter that will allow you to do something like that. I've tried taking the keys out of the control but then is always missing when you need them.

your advices will be greatly appreciated.

Benito

www.Matech.net

[rsbeadle]

Thanks for the help Mick and Bullines. I will watch this post for updates.

[Pete Rimkus from CNC Software Inc.]

Bullines pointed me back to this thread, and I verified that AskForEntity() works in SP1.