Per riuscire a determinare tutte le intersezioni con tutte le polilinee ho dovuto apportare delle modifiche alla funzione interseca_poly1, che adesso vi descrivo.
La prima modifica apportata e' stata quella della determinazione delle intersezioni anche nel caso di segmento verticale della polilinea.
Questa e' consistita nell'inserimento di una serei di if aventi come argomento l'uguaglianza delle ascisse xi ed xf
IF xi=xf
In questo caso abbiamo:
equazione del cerchio, al solito.
equazione della retta: x=xi
sostituendo questìultima nella equazione del cerchio otteniamo una equazione di secondo grado, stavolta in y
y² + B*y + (C + A*xi + xi²)
in cui A B e C sono quelli gia definiti nel caso precedente
Anche qui si ricava il discriminante e se positivo si procede con la verifica se il segmento yi, yf e' interno o no al segmento y1 y2, in cui y1 e y2 sono le soluzioni della equazone di secondo grado.
La seconda modifica e' quella di avere inserito un contatore delle intersezioni ( Dim n_intersezioni As Integer ) che si incrementerà ad ogni intersezione trovata.
Per salvare le coordinate dei punti di intersezioni, che a questo punto pososno essere piu' di due, servivano dei vettori che si ridimensionassero al variare del numero di intersezioni:
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
la parola chiave Preserve e' necessaria per non perdere nel ridimensionamento, i punti gia registrati.
Infine, affinche la funzione potesse restituirmi uno qualsiasi degli n punti trovati, ho dovuto aggiungere un ulteriore flag, che ho chiamato con flag_punto che rappresenta l'indice delpunto che voglio restituito
I valori che puo' assumere il falg principale sono:
-1: se voglio sapere se vi sono o meno delle intersezioni
0: se voglio sapere il numero delle intersezioni trovate
1: se voglio l'ascissa del punto il cui indice e' flag_punto
2: se voglio l'ordinata del punto il cui indice e' flag_punto
mentre il flag_punto e' un numero intero che mi indica l'indice del punto di cui voglio le coordinate
Ovviamente nel caso in cui viene passato un flag principale pari a -1 o 0, il valore di flag_punto e' ininfluente.
Public Function interseca_poly1(tabella As Range, xc As Double, yc As Double, R As Double, flag As Integer, flag_punto As Integer) As Variant
' la funzione calcola le intersezioni tra una polilinea ed un cerchio
' in input:
' tabella: il range di celle contenente le coordinate dei punti. Nella prima colonna le ascisse
' nella seconda colonna le ordinate
' xc, yc, R: rispettivamente le coordinate del centro del cerchio ed il suo raggio
' flag: parametro che determina il valore che la funzione deve ritornare secondo la tabella che segue
' -1 : ritorna il valore logico vero se vi sono intersezioni, falso se non ve ne sono
' 0 : ritorna il numero delle intersezioni trovate
' 1 : ritorna l'ascissa del punto di intersezione indicato con flag_punto
' 2 : ritorna l'ordinata
' flag_punto: parametro che indica il punto di intersezione per il quale si vogliono le coordinate
Dim nPunti As Integer
Dim xx() As Double
Dim yy() As Double
Dim count As Integer
Dim esiste_intersez As Boolean
Dim n_intersezioni As Integer
Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double
nPunti = tabella.Rows.count ' leggo il numero di punti della polilinea
ReDim coord(1 To nPunti, 1 To 2) As Double
' trasferisco la tabella delle coordinate nella matrice coord
For count = 1 To nPunti
coord(count, 1) = tabella.Cells(count, 1)
coord(count, 2) = tabella.Cells(count, 2)
Next
' eseguo adesso la ricerca delle intersezioni per ciascun segmento della polilinea
n_intersezioni = 0
esiste_intersez = False
For count = 2 To nPunti
xi = coord(count - 1, 1)
yi = coord(count - 1, 2)
xf = coord(count, 1)
yf = coord(count, 2)
A = -2 * xc
B = -2 * yc
c = xc ^ 2 + yc ^ 2 - R ^ 2
If xi = xf Then
a1 = 1
b1 = B
c1 = c + A * xi + xi ^ 2
Else
m = (yf - yi) / (xf - xi)
n = yi - m * xi
a1 = m ^ 2 + 1
b1 = 2 * m * n + A + B * m
c1 = n ^ 2 + B * n + c
End If
d = b1 ^ 2 - 4 * a1 * c1
If d > 0 Then
If xi = xf Then
x1 = xi
x2 = xi
y1 = (-b1 - d ^ 0.5) / (2 * a1)
y2 = (-b1 + d ^ 0.5) / (2 * a1)
Else
x1 = (-b1 - d ^ 0.5) / (2 * a1)
x2 = (-b1 + d ^ 0.5) / (2 * a1)
y1 = m * x1 + n
y2 = m * x2 + n
End If
If xi = xf Then
If Not (yf < y1 Or yi > y2) Then
' vi sono intersezioni
If yi <= y1 And yf < y2 Then
'una intersezione data dal primo punto
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x1
yy(n_intersezioni) = y1
End If
If yi <= y1 And yf >= y2 Then
' due intersezioni
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x1
yy(n_intersezioni) = y1
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x2
yy(n_intersezioni) = y2
End If
If yi > y1 And yf < y2 Then
' nessuna intersezione
End If
If yi > y1 And yf >= x2 Then
' una intersezione
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x2
yy(n_intersezioni) = y2
End If
End If
Else
'-----
If Not (xf < x1 Or xi > x2) Then
' vi sono intersezioni
If xi <= x1 And xf < x2 Then
'una intersezione data dal primo punto
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x1
yy(n_intersezioni) = y1
End If
If xi <= x1 And xf >= x2 Then
' due intersezioni
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x1
yy(n_intersezioni) = y1
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x2
yy(n_intersezioni) = y2
End If
If xi > x1 And xf < x2 Then
' nessuna intersezione
End If
If xi > x1 And xf >= x2 Then
' una intersezione
esiste_intersez = True
n_intersezioni = n_intersezioni + 1
ReDim Preserve xx(1 To n_intersezioni)
ReDim Preserve yy(1 To n_intersezioni)
xx(n_intersezioni) = x2
yy(n_intersezioni) = y2
End If
End If
End If
'-----
End If
Next
Select Case flag
Case -1
interseca_poly1 = esiste_intersez
Case 0
interseca_poly1 = n_intersezioni
Case 1
If flag_punto <= n_intersezioni And esiste_intersez Then
interseca_poly1 = xx(flag_punto)
Else
interseca_poly1 = "ND"
End If
Case 2
If flag_punto <= n_intersezioni And esiste_intersez Then
interseca_poly1 = yy(flag_punto)
Else
interseca_poly1 = "ND"
End If
Case Else
interseca_poly1 = "ERRORE NEL FLAG"
End Select
End Function
Adesso, notando che buona parte del codice e' duplicato, conviene scrivere una funzione che sostituisca una volta per tutte il codice duplicato. ma questa e' cosa che puo farsi in seguito.
