'Triangles to Quadrangles
'J324.vbs (c) javier@internarte.com
'Select an object and run. This cleans your triangles into Quads.
'Caveats. Only triangle polygons are considered.
'It works best if all triangles are subdivided evenly.
'In some cases polygons of more than 4 sides are created: check edge selection before dissolving.

DO
set oRoot = Application.ActiveProject.ActiveScene.Root
'//UI 
	Set oInput =oRoot.AddProperty("custom_parameter_list",,"Quadrangulate")
		Set oNote1 =oInput.AddParameter2( "THIS FINDS", siString,,,,,,,2) 	
		set oFIND = oInput.AddParameter2( "Select Triangle Edge", siBool,,,,,,,4)	
		set oDis = oInput.AddParameter2( "Disolve Selected Edges", siBool,,,,,,,4)			
	
	'********************* UI DEFAULT VALUES >
			oNote1.value = "TRIANGLE Polygons, selects longest edge and Disolves it"
			oFIND.value = 1
			oDis.value = 0			
	'<********************
										
	on Error Resume Next	'//Open UI up
		InspectObj oInput,,,siModal
		if err.Number <> 0 then
			Deleteobj oInput
			EXIT DO
		end if
	Err.Clear
	on Error Goto 0
IF oFIND.value = "True" then
	Call FINDTRI
END IF
IF oDis.value = "True" then
	Dis
END IF

Deleteobj oInput
EXIT DO
LOOP


SUB FINDTRI
	Set oEdgecoll = CreateObject( "XSI.Collection" )
	Set oPolycoll = CreateObject( "XSI.Collection" )

	set v1 = createobject("Sumatra\Scripting\Math\SIVector3")
	set v2 = createobject("Sumatra\Scripting\Math\SIVector3")
	set vlength = createobject("Sumatra\Scripting\Math\SIVector3")
	
	SetSelFilter "Object"
set oObject = selection(0)
	SetSelFilter "Edge"
	DeselectAll
set oPolygonMesh = oObject.ActivePrimitive.Geometry
aPositions = oPolygonMesh.Points.PositionArray
set oPolygonFaces = oPolygonMesh.Polygons

FOR EACH oPolygonFace in oPolygonFaces
	
	on Error Resume Next
	oPolycoll.remove oPolygonFace
	if Err.Number <> 0 then
		Err.Clear
		set oNeighbors = oPolygonFace.NeighborEdges( 1 )
		IF oNeighbors.count = 3 then
		logmessage "Inspecting polygon number "&oPolygonFace.index
			length = 0
			FOR EACH oEdge in oNeighbors			
				set oVertices = oEdge.NeighborVertices( 1 )		
				cuenta = 0
				FOR EACH n in oVertices
					if cuenta = 0 then
						v1.set aPositions(0, n.index),aPositions(1, n.index),aPositions(2, n.index)
					else
						v2.set aPositions(0, n.index),aPositions(1, n.index),aPositions(2, n.index)
					end if
					cuenta = 1
				NEXT
				vlength.sub v1,v2
				IF vlength.length > length then
					longestedge = oEdge.index
					length = vlength.length
					set oNeighborPolys = oEdge.NeighborPolygons( 1 )
				END IF	
			NEXT
			oPolycoll.additems oNeighborPolys			
			oEdgecoll.add oObject&".edge["&longestedge&"]"	
			AddToSelection oObject&".edge["&longestedge&"]", , True

		END IF	
	else	
		oPolycoll.add oPolygonFace
		on Error Goto 0
	end if
	
NEXT 
END SUB

SUB Dis
ApplyTopoOp "DissolveComponent"
END SUB



