クエリ対応の関数の記述

Function Current_Selection ()
	Dim R(), SelList

	Set SelList = GetValue( "SelectionList" )
	if SelList.Count = 0 then
		Current_Selection = R
		Exit Function
	end if

	Set SelList = SelectChildNodes( SelList, False )
	Dim i
	ReDim R(SelList.Count - 1)
	for i = 0 to SelList.Count - 1
		R(i) = SelList(i)
	next
	Current_Selection = R
End Function

Function Object_Xfo ()
	Dim R(9)
	R(0) = "Name"
	R(1) = "kine.local.posx:Default:Local posx"
	R(2) = "kine.local.posy:Default:Local posy"
	R(3) = "kine.local.posz:Default:Local posz"
	R(4) = "kine.local.rotx:Default:Local rotx"
	R(5) = "kine.local.roty:Default:Local roty"
	R(6) = "kine.local.rotz:Default:Local rotz"
	R(7) = "kine.local.sclx:Default:Local sclx"
	R(8) = "kine.local.scly:Default:Local scly"
	R(9) = "kine.local.sclz:Default:Local sclz"
	Object_Transformations = R
End Function

Ex: Object_Xfo_Selected.query
<version>{1}
<line_def>
{
	vbscript
	spreadsheet.vbs
	Current_Selection
}
<col_def>
{
	vbscript
	spreadsheet.vbs
	Object_Xfo
}

Function All_SceneObject ()
	Dim R(), sceneObjectList
	set sceneObjectList =  SIFilter( "*", "sceneobject",,siQuickSearch)

	if sceneObjectList.Count = 0 then
		All_SceneObject = R
		Exit Function
	end if
End Function

Function Object_Geometry ()
	Dim R(7)
	R(0) = "Name"
	R(1) = "Type:Script:vbscript~spreadsheet.vbs~GetObjType"
	R(2) = "Triangles:Script:vbscript~spreadsheet.vbs~GetNbrTriangles"
	R(3) = "Points:Script:vbscript~spreadsheet.vbs~GetNbPoints"
	R(4) = "Segments:Script:vbscript~spreadsheet.vbs~GetNbSegments"
	R(5) = "Facets:Script:vbscript~spreadsheet.vbs~GetNbFacets"
	R(6) = "Particles:Script:vbscript~spreadsheet.vbs~GetNbParticles"
	R(7) = "geomapprox.gapproxmosl:Default:Subdiv"
	Object_Geometry = R
End Function

'----------------------------------------------------------------------
' GetObject
' Function that converts an object string into a scripting object 
' (for the object model)
'----------------------------------------------------------------------
Function GetObject (in_obj)
	GetObject = "Nothing"
	if IsEmpty(in_obj) Then
		exit function
	end if

	dim l_coll

	set l_coll = CreateObject("XSI.Collection")
	l_coll.Add in_obj
	set GetObject = l_coll(0)  ' returns a X3DObject
End Function

Function GetNbrTriangles( in_obj )
	GetNbrTriangles = 0
	Dim l_obj 
	set l_obj = GetObject( in_obj )
	if l_obj.type = "polymsh" Or l_obj.type = "surfmsh" Or l_obj.type = "crvlist" then
		GetNbrTriangles = GetNbTriangles( in_obj )
	end if
End Function

Function GetNbPoints( in_obj )
	GetNbPoints = 0
	Dim l_obj, l_geom
	set l_obj = GetObject( in_obj )
	if l_obj.type = "polymsh" Or l_obj.type = "surfmsh" Or l_obj.type = "crvlist" then
		set l_geom = l_obj.obj
		GetNbPoints = l_geom.nb0D
	end if
End Function

Function GetNbSegments( in_obj )
	GetNbSegments = 0
	Dim l_obj, l_geom
	set l_obj = GetObject( in_obj )
	if l_obj.type = "polymsh" then
		set l_geom = l_obj.obj
		GetNbSegments = l_geom.nb1D
	end if
End Function

Function GetNbFacets( in_obj )
	GetNbFacets = 0
	Dim l_obj, l_geom
	set l_obj = GetObject( in_obj )
	if l_obj.type = "polymsh" Or l_obj.type = "surfmsh" then
		set l_geom = l_obj.obj
		GetNbFacets = l_geom.nb2D
	end if
End Function

Function GetNbParticles( in_obj )
	Dim myType, l_obj, l_part

	GetNbParticles = 0
	myType = GetObjType( in_obj )
	if myType = "cloud" then
		set l_obj = GetObject( in_obj )
		set l_part = l_obj.particles
		GetNbParticles = l_part.count
	end if
End Function

Object_Geometry_All.query
<version>{1}
<line_def>
{
	vbscript
	spreadsheet.vbs
	All_SceneObject
}
<col_def>
{
	vbscript
	spreadsheet.vbs
	Object_Geometry
}
<sort_order>
{
	asc:-1
}

<version>{1}
<line_def>
{
	vbscript
	spreadsheet.vbs
	Current_Selection
}
<col_def>
{
	vbscript
	spreadsheet.vbs
	Object_Visibility
}
<relation>
{
	Clusters
}
<relation_object_def>
{
	vbscript
	spreadsheet.vbs
	ObjectClusters
}
<relation_param_def>
{
	vbscript
	spreadsheet.vbs
	Cluster_Info
}
<sort_order>
{
	asc:-1
}

Function ObjectClusters( in_obj )
	Dim l_obj, i, l_geom, l_clusters, l_cluster

	set l_obj = GetObject( in_obj )

	Dim l_cArray()
	if typename(l_obj) = "X3DObject" and not (l_obj.type = "Texture Support") then

		set l_geom = l_obj.activeprimitive.geometry
		set l_clusters = l_geom.clusters

		if ( l_clusters.count > 0 ) then
			ReDim l_cArray( l_clusters.count - 1 )
			for i = 0 to l_clusters.count - 1
				l_cArray(i) = l_clusters.Item(i)
			next
		else
			ReDim l_cArray(0)
		end if
	else
		ReDim l_cArray(0)
	end if
	 
	ObjectClusters = l_cArray
end function

Function Cluster_Info ()
	Dim R(2)
	R(0) = "Name"
	R(1) = "Type:Script:vbscript~spreadsheet.vbs~GetObjType"
	R(2) = "Components:Script:vbscript~spreadsheet.vbs~GetNbClsComponents"

	Cluster_Info = R
End Function

Function GetObjType (in_obj)
	Dim l_obj

	GetObjType = " "
	if IsEmpty(in_obj) Then
		exit function
	end if

	set l_obj = GetObject( in_obj )
	GetObjType = l_obj.Type
End Function

Function GetNbClsComponents( in_cls )
	Dim l_cls, l_elems

	GetNbClsComponents = 0
	set l_cls = GetObject( in_cls )
	if typename(l_cls) = "Cluster" then
		set l_elems = l_cls.elements
		GetNbClsComponents = l_elems.count
	end if
End Function

Function Object_Visibility ()
	Dim R(4)
	R(0) = "Name"
	R(1) = "Type:Script:vbscript~spreadsheet.vbs~GetObjType"
	R(2) = "visibility.viewvis:Default:{D636F4D0-D94B-11D1-B0ED-00A024C79287}"
	R(3) = "visibility.rendvis:Default:{A9D242E0-D948-11D1-B0ED-00A024C79287}"
	R(4) = "visibility.selectability:Default:{4256027B-C691-11d2-B740-0008C7A011A6}"
	Object_Visibility = R
End Function