Visual Basic - poligonos intersectados

Function Abrir_archivo();
Funcion Abrir_archivo2();
Funcion Dibujar_puntos();
Funcion Baricentro(pX(), pY(), CP1)
Funcion adsisa(pX(), pY(), CP1, M);
Funcion Convexo(pX(), pY(), CP1, M);
Funcion Eje(pX(), pY(), CP1);
Funcion Angulos(pX(), pY(), CP1);
Funcion Organizar(pX(), pY(), CP1);
Funcion dibujar(pX(), pY(), CP1);

**********************************************************
INICION PORGRAMA PRINCIPAL
{

Abrir_archivo();
Abrir_archivo2();

Leer ( Puntos_archivo(pX[ ],pY[ ],Cp1) );

Dibujar_puntos();

}

********************************************************

Inicio_ Funcion Dibujar_puntos()

Ent Var: i = 1, Cp
String Var: CONTENIDO1

Baricentro(pX(), pY(), CP1)
adsisa(pX(), pY(), CP1, M)
Convexo(pX(), pY(), CP1)
Eje(pX(), pY(), CP1)
Angulos(pX(), pY(), CP1)
Organizar(pX(), pY(), CP1)
dibujar(pX(), pY(), CP1)

Cp = CP1


FIN_ Funcion Dibujar_puntos



**********************************************
Inicio_ Funcion Dibujar2_puntos()

Ent Var: i = 1, Cp
String Var: CONTENIDO1

Baricentro(pX(), pY(), CP1)
adsisa(pX(), pY(), CP1, M)
Convexo(pX(), pY(), CP1)
Eje(pX(), pY(), CP1)
Angulos(pX(), pY(), CP1)
Organizar(pX(), pY(), CP1)
dibujar(pX(), pY(), CP1)

Cp = CP1


FIN_ Funcion Dibujar2_puntos

**************************************************************
Inicio Funcion_ Baricentro(pX2(), pY2(), Cp)

sum1, sum2
Dim aux1(33), aux2(33)

For i = 1 To Cp
aux1(i) = pX2(i)
aux2(i) = pY2(i)
Next

For i = 1 To 3
sum1 = sum1 + aux1(i)
sum2 = sum2 + aux2(i)

Next i
sum1 = sum1 / 3
sum2 = sum2 / 3
Cp = Cp + 1
pX2(Cp) = sum1
pY2(Cp) = sum2

FIN_ Funcion_ Baricentro(pX2(), pY2(), Cp)

*************************************************
Inicion Funcion_adsisa(pX2(), pY2(), Cp, M)

Ent Var: bariX[33], Pos[30]

Para ( I = 1; I <= Cp; I= I+1)
bariX[ I ] = Int(Sqr(((pX2(i)) ^ 2) + ((pY2(i)) ^ 2)))
Pos[ I ] = I;
Fin_para

Para ( I = 1; I <= Cp; I= I+1)
Para ( I = 1; I <= Cp; I= I+1)
si ( bariX[ I ]) <= bariX[ j ]) And (I <> j)
auxp = Pos[ i ]
Pos[ I ] = Pos[ j ]
Pos[ j ] = auxp
Fin_si
Fin_para
Fin_para

M = Pos[ 1 ]

Fin_ Funcion_adsisa( )

Inicio Funcion_Convexo(pX2(), pY2(), CP1)
Ent Var: menor, conta, MaxX, MaxY, MenX, MenY, aux1[33], aux2[33]
Ent Var: bariX[3], bariY[3]

Para ( I = 1; I <= CP1; I = I + 1);
aux1[ I ] = pX2[ I ]
aux2[ I ] = pY2[ I ]
Fin_para

Para ( I = 1; I <= CP1; I = I + 1)
Para ( j = 1; j <= CP1; j = j + 1)
Si ( aux1[ I ] < aux1 [ j ] ^ ( I <> j)
menor = aux1[ I ]
aux1[ I ] = aux1[ j ]
aux1[ j ] = menor
Fin_si

Si ( aux2[ I ] < aux2 [ j ] ^ ( I <> j)
menor = aux2[ I ]
aux2[ I ] = aux2 [ j ]
aux2[ j ] = menor
Fin_si
Fin_para
Fin_para

MenX = aux1[ 1 ]
MaxX = aux1[ CP1 ]
MenY = aux2[ 1 ]
MaxY = aux2[ CP1]


Para ( I = 1; I <= CP1; I = I + 1)
Si (pX2 [i] > MenX ^ pX2[i] < MaxX) ^ (pY2[i] > MenY ^ pY2[i] < MaxY)

Bandera1 = 1

Para ( j = I; j <= CP1; j = j + 1)
pX2 [ j ] = pX2[ j + 1]
pY2 [ j ] = pY2[j + 1]
Fin_para

I = I - 1
conta = conta + 1
Fin_si

CP1 = CP1 - conta

Fin_ Funcion_Convexo( )


Inicio Funcion_Eje(pX2(), pY2(), Cp)
Bx = (pX2(1) + pX2(2) + pX2(3) / 3
By = (pY2(1) + pY2(2) + pY2(2))/ 3)
Fin_funcion_Eje()

*************************************************************
Inicio Funcion_Angulos(pX2(), pY2(), Cp)
Ent Var: Cx, Cy, indx

Para( index = 1; index <= Cp; index = index + 1)
Cx = pX2[index]
Cy = pY2[index]

Si( Cx < Bx )

Si ( Cy <= By )
Angles[index] = 180 + (((Atn(Abs((Cy - By) / (Cx - Bx)))) * 180) / 3.1416)
Fin_si

Si ( Cy >= By )
Angles(index) = 180 - Int(((Atn(Abs((Cy - By) / (Cx - Bx)))) * 180) / 3.1416)
Fin_si
Fin_si


Si ( Cx > Bx)
Si ( Cy <= By )
Angles(index) = (2 * 180) - Int(((Atn(Abs((Cy - By) / (Cx - Bx)))) * 180) / 3.1416)
Fin_si

Si (Cy >= By )
Angles(index) = Int(((Atn(Abs(Cy - By / Cx - Bx))) * 180) / 3.1416)
Fin_si
Fin_si

Si ( Cx = Bx )
Si ( Cy <= By )
Angles(index) = 180
Fin_si

Si ( Cy >= By)
Angles(index) = 180
Fin_si
Fin_si

Si ( Cy = 0 )
Si ( Cx > Bx )
Angles(index) = 0
Fin_si

Si ( Cx <= Bx )
Angles(index) = 180
Fin_si
Fin_si

Si ( Cx = 0 )
Si ( Cy <= By )
Angles(index) = Int((3 * 180) / 2)
Fin_si

Si ( Cy >= By )
Angles(index) = Int(180 / 2)
Fin_si
Fin_si

Punto_Angle(index, 1) = index
Punto_Angle(index, 2) = Angles(index)

Fin _funcion_ Angulos()

*********************************************************************

Inicio Funcion_Organizar(pX(), pY(), CP1)
Ent Var: indexi, indexj, Aux, aux1

Si ( Bandera1 = 1 )
Para ( indexi = CP1; index <= 1; index = index -1)
para (indexj = 2; indexi <= index; index = index + 1)
Si (Punto_Angle(indexj - 1, 2) > Punto_Angle(indexj, 2))
Aux = Punto_Angle(indexj - 1, 2)
aux1 = Punto_Angle(indexj - 1, 1)
Punto_Angle(indexj - 1, 2) = Punto_Angle(indexj, 2)
Punto_Angle(indexj - 1, 1) = Punto_Angle(indexj, 1)
Punto_Angle(indexj, 2) = Aux
Punto_Angle(indexj, 1) = aux1


Aux = pX(indexj - 1)
aux1 = pY(indexj - 1)
pX(indexj - 1) = pX(indexj)
pY(indexj - 1) = pY(indexj)
pX(indexj) = Aux
pY(indexj) = aux1

Fin_si
Fin_Para
Fin_Pra
Fin_Si

Fin_ Funcion_Organizar( )
*******************************************************************

Sub dibujar(pX2(), pY2(), Cp)
Dim X1, Y1, X, Y

Grafica.DrawWidth = 10
If Cp >= 2 Then
For i = 1 To Cp
X = pX2(i)
Y = pY2(i)
Grafica.DrawWidth = 10
Grafica.PSet (X, Y), vbYellow
If i >= 2 Then
X1 = pX2(i - 1)
Y1 = pY2(i - 1)
Grafica.DrawWidth = 2
Grafica.Line (X1, Y1)-(X, Y), vbBlue
End If
Next i
Grafica.DrawWidth = 10
Grafica.PSet (X, Y), vbYellow
End If
Call cerrar(pX2(), pY2(), Cp)
End Sub

Sub abrir_archi(contenido)
Dim nFic As Integer
Dim sFic As String
Dim tamFic As Long
Dim Scontenido As String

CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.Filter = "Archivo Txt (*.txt)|*.txt"
CommonDialog1.ShowOpen
sFic = CommonDialog1.FileName

If sFic = "" Then
Exit Sub
Else
If Len(Dir$(sFic)) Then 'DEVUELVE VERDADERO O FALSO
nFic = FreeFile
Open sFic For Input As nFic
tamFic = LOF(nFic)
Scontenido = Input$(tamFic, nFic)
Close nFic
If Bandera = 1 Then
Text3.Text = Scontenido
End If
If Bandera = 2 Then
Text4.Text = Scontenido
End If
End If
End If

End Sub