VBScript question R/E all levels on

[cblythe3d]

Mr Mick and Mr Bulliness

 

Many thanks guys for all the help and advice you have allready offered to this novice VBScripter. If you have any insights that could help steer me in a more productive direction they would be greatly appreaciated

 

I would like to modify this script to run automatically. Parsing through the database, gleaning each subisquent 360. or -360. deg arc automatically. And at the end of the search turn all levels back on.

 

My first big mess is that when I turn all levels on the screen blinks on and off 256 times. Is there a better way to set all levels on without a screen regen for each level/

 

Second do you see a simple way to search the database selecting the next succesive diameter?

 

Thanks for all the help you have given me despite the fact you have more profitable endeavors to persue.

 

Charlie.

 

'

' SEARCH ARCS BY DIAMETER

' CBLYTHE3D

' Modified mcMick code

'

' This little puppy makes short work of sorting holes to layers

' by diameter. I would have liked to automatically set succesive

' level numbers and use the diameter as the name.

'

' While it works fine the coding is a really sloppy mess

' but meets the imediate need Any help would be appreciated

'

'

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

Const DEF_CURRENT_ENTITY = -1

Const DEF_NEW_GROUP = " Arcs"

Public Const DEF_NOTEPAD = "C:WindowsNotepad.exe"

Public Const DEF_NOTEPAD_NT = "C:WINNTNotepad.exe"

Public Const DEF_LIST = "mcLevelList.txt"

Public Const DEF_ALL_LEVELS = 24

 

' -- Start Script

'Call Main

Call SearchArcsByDiameter

Call LevList()

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

' Sub Declaration

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

 

Sub SearchArcsByDiameter()

 

Dim CArc, CNewArc

Dim bRet, intCounter

Dim cRet

Dim dblExistingArcs

Dim newLevel

Dim intPoints

Dim CPoint

Dim objSelectedArc

 

Call askLevel(newLevel)

cRet=1

 

Do While cRet=1

Select Case askYesNoCancel("Shall We Procede?")

Case mcMSG_CANCEL

' -- Bail...

Exit Sub

Case mcMSG_NO

Exit Sub

Case mcMSG_YES

' -- Procede

End Select

newLevel = (newLevel + 1)

 

If AskForEntity ("Select arc diameter", 7) Then

Set objSelectedArc = New McAr

' -- Get the properties of the selected arc

bRet = GetArcData(DEF_CURRENT_ENTITY, objSelectedArc)

dblExistingArcs = (objSelectedArc.r *2)

' -- Prompt for new dia

If dblExistingArcs = 0 Then

Exit Sub

End If

 

If SetLevelVisibleByNumber(newLevel, False) Then

End If

 

 

' -- Initialize counter

intCounter = 0

 

bRet = StartDBSearch(mc_alive, mc_arctype)

 

' -- Begin loop through database

Do While bRet

Set CArc = New McAr

' -- Get this entity

If GetArcData(DEF_CURRENT_ENTITY,CArc) Then

' -- Test

If Round((CArc.R * 2),3 ) = Round( dblExistingArcs, 3 ) Then

If CArc.SW = 360 Or cArc.sw = -360 Then

SetEntityLevel(newLevel)

SetEntityColor(newLevel)

If SetLevelName(newlevel,Round(dblExistingArcs, 3))Then

Else

 

' -- Keep a running total

intCounter = intCounter + 1

 

' -- Get this arc properties

If GetArcData(GetEntityEptr, CArc) Then

Set CPoint = New McPt

' -- Assign this arcs location for the new point

With CPoint

.X = CArc.X

.Y = CArc.Y

.Z = CArc.Z

End With

' -- Create the point

If CreatePoint(CPoint,7, newLevel) = mcENTITY_INVALID Then

' -- Failed to create point....

Else

' -- Keeping score

AddCurrentEntToGroup(Round(dblExistingArcs, 3))

 

intPoints = intPoints + 1

End If

End If

 

End If

End If

Else

End If

End If

 

bRet = NextDBSearch

Loop

If intCounter = 0 Then

ShowString "No matching arcs found"

Else

ShowString intCounter & " " & dblExistingArcs & " arcs processed"

End If

 

End If

 

Loop

End Sub

 

 

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

 

' -- Start Script

 

 

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

' Sub Declaration

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

Sub LevList()

 

Dim intCurrentLevel, strCurrentLevelName()

Dim FSO, fsoLevelsList, intCount, strTemp, strShell

 

 

intCount = -1

 

' -- Iterate all levels

For intCurrentLevel = 1 To DEF_ALL_LEVELS

 

strTemp = Trim(GetLevelName(intCurrentLevel))

 

' -- Is this level named?

If Len(strTemp) <> 0 Then

' -- Resize our array

intCount = intCount + 1

ReDim Preserve strCurrentLevelName(intCount)

' -- Assign level name and nunber

strCurrentLevelName(intCount) = "Level #" & intCurrentLevel & " = " & strTemp

End If

Next

 

' -- Test

If intCount = -1 Then

' -- No named levels found

ShowString "No named levels found in current drawing"

Else

 

Set FSO = CreateObject("Scripting.FileSystemObject")

 

Set fsoLevelsList = FSO.CreateTextFile(GetPathOfThisScript & DEF_LIST)

 

For intCurrentLevel = 0 To intCount

fsoLevelsList.WriteLine strCurrentLevelName(intCurrentLevel)

Next

 

fsoLevelsList.Close

 

 

' -- Where is Notepad?

If FSO.FileExists(DEF_NOTEPAD) Then

strShell = DEF_NOTEPAD

ElseIf FSO.FileExists(DEF_NOTEPAD_NT) > 0 Then

strShell = DEF_NOTEPAD_NT

Else

strShell = vbNullString

End If

 

' -- Are we ok?

If Len(strShell) = 0 Then

'EditFile GetPathOfThisScript & "mcLevelList.txt"

' -- Stays modal to mc

Else

' -- Ok, show the file

strShell = strShell & " " & GetPathOfThisScript & DEF_LIST

Call ShellAndWait (strShell, False)

End If

 

' -- Clean up

Erase strCurrentLevelName

 

 

End If

 

 

' -- Clean up

Set FSO = Nothing

Set fsoLevelsList = Nothing

 

End Sub

[cblythe3d]

oops Forgot to include this problamatic script

 

 

Public Const DEF_ALL_LEVELS = 255

 

' -- Start Script

Call LvAllOn()

 

 

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

' Sub Declaration

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

Sub LvAllOn()

 

Dim intCurrentLevel, strCurrentLevelName()

 

' -- Iterate all levels

For intCurrentLevel = 1 To 255

Call SetLevelVisibleByNumber(intCurrentLevel, 1)

Next

 

 

 

End Sub

 

Thanks again guys

[Bullines]

quote:

---

My first big mess is that when I turn all levels on the screen blinks on and off 256 times. Is there a better way to set all levels on without a screen regen for each level/

---

I don't notice this problem in X. I wonder if it was a bug in 9.x.

 

quote:

---

Second do you see a simple way to search the database selecting the next succesive diameter?

---

I don't have much time at the moment to code up a sample, but I did write something a while back that I think is along the same lines as what you're looking for. A good idea would be to discover all differing diameters and store them in a Dictionary object (which is basically just a hash table/associative array). Then you could iterate through your Dictionary and assign levels to each diameter. Take a look at my Z_Colours.vbs script in the VB_Script directory on the FTP site. I'm setting the colour of entities at each unique depth. So, for example, all entities at -4Z are blue, all entities at 3.25Z are green, etc. This is probably somewhat similar to what you're looking for and could easily be modifed to set level based on arc diameter instead of colour based on Z value.

 

HTH