[Manifold-l] flythrough script...

[jburn_gis at cogeco.ca]

I noticed someone was asking about a script for fly-throughs.  I haven't tried it lately, but it worked well with
previous versions of Manifold.  The script is courtesy of Mike Sumner - I have pasted it below to save searching.

Cheers.

>>>>>

{code - temp tag to be replaced}
'##*********************************************************************************
'## TerrainFlyThrough - illustration of scripted terrain fly through

'## Author: Michael Sumner Date: November 1 2004 Version: 1.0.0
'## mdsumner at utas.edu.au
'##
'## Platform: Windows XP 2002 SP2.
'## Manifold 6.0 SP1,
'##
'## Language: VBScript (Manifold System)
'##
'## Permission to use, modify and distribute this code is hereby granted, providing this
'## entire comment section is included. No warranty is expressed or implied.
'##

Sub Main

' name of drawing component to look for
name = "Drawing"
' name of column in drawing's table containing line heights
' THIS IS ASSUMED to exist
htColumnName = "Height"

' choose the z direction of the camera (looking down a bit)
dZ = -2

' how high above the surface?
zOffset = 0
' the number of seconds to wait between each move (use small values like 0.1)
waitThisLong = 0
Set doc = Application.ActiveDocument
Set comps = doc.ComponentSet

'obtain active terrain window
Set wset = Application.WindowSet
Set win = wset.ActiveWindow
If win.Component.Type <> ComponentTerrain Then
msgbox "Active window is not a terrain, exiting"
Exit Sub
End If

' obtain drawing containing the line segments
dwgID = comps.ItemByName(name)
If dwgID < 0 Then
msgbox "No component named " & name
End If
Set dwg = comps.Item(dwgID)
'
' obtain the recordSet for the height values
Set records = dwg.OwnedTable.RecordSet
' obtain the line segments from the drawing
Set dwgObjs = dwg.ObjectSet


'msgbox win.CameraDX & vbcrlf & win.CameraDY & vbcrlf & win.CameraDZ
'exit sub
'iterate over all objects
For n = 1 To dwgObjs.Count
Set obj = dwgObjs.Item(n-1)
' act only on line objects (using first two points of first branch)
If obj.Type = ObjectLine Then
Set ptSet = obj.Geom.BranchSet.Item(0).PointSet

' obtain the two points, and calculate camera directions
' from the bearing from pt1 to pt2
' (these range from -10 to 10 for all 3 dimensions - not totally sure this is
' right but it seems fine)
Set pt1 = ptSet(0)
Set pt2 = ptSet(1)
bearing = pt1.BearingTo(pt2)
win.CameraDY = cos(bearing)*10
win.CameraDX = sin(bearing-180)*10
win.CameraDZ = dZ


'' ##################################################################
'' ## turn this section off if you have no height data in your drawing
' obtain the height value from the surface (this is mostly so you can
' make it more than zero if desired
win.CameraHeight = records(records.ItemByID(obj.ID)).Data(htColumnName) + zOffset
'' ##
'' #######################################################################

' create a new point and move the window view to it, and refresh
Set nPt = Application.NewPoint
nPt.X = obj.Geom.Center.X
nPt.Y = obj.Geom.Center.Y
win.MoveToLocation nPt, FALSE
win.Refresh()

' waste some time?
delay waitThisLong
'exit sub
End If

Next
End Sub

' a function to waste the specified number of seconds
Function delay(wait)
'Delay redirect for two seconds'
Dim StartTime, EndTime, WaitTime
' Get Start Time'
StartTime = Timer()

'Get End Time'
EndTime = Timer()

'Determine how long it took'
WaitTime = EndTime - StartTime

'Continue checking the elapsed time until it reaches "wait" seconds'
do while WaitTime < wait
'Get End Time'
EndTime = Timer()

'Determine how long it took'
WaitTime = EndTime - StartTime
loop

End Function

--------------
James Burn AScT