Author Topic: Una funzione per la stabilità dei pendii (Read 44623 times)

afazio · « **Reply #60 on:** 18 December , 2009, 10:01:31 AM »

Dopo un paio di giorni di meditazioni e prove, sono pervenuto a:
- la funzione che calcola l'area del concio generico funziona e dà risultati corretti nel caso in cui passiamo estremi del concio per cui abbaimo certezza che esso ricade all'interno del cerchio;
- i problemi si hanno quando passiamo estremi del concio che implicano la determinazione di una eventuale intersezione col cerchio;
- i problemi suddetti nascono dal fatto che ho pensato di limitare il campo di scansione dei conci all'interno del diametro e dal fatto che non vengono determinati a priori i punti di intersezione delle varie superfici.

Penso pertanto di chiudere la funzione concio e procedere con altre funzioni o macro che mi determinano tutti i punti di intersezione

si tratta quindi di determinare le coordinate dei punti A, B, C, D, E, F e di eventuali altri dovuti alla presenza di altre superfici di separazione tra gli strati.

afazio · « **Reply #61 on:** 18 December , 2009, 10:53:03 AM »

A questo punto e' utile pertanto riassumere il codice fin qui scritto.

iniziano le due funzioni trigonometriche inverse, necessarie perche in VBA mancano le funzioni apposite.

_________________________________________________

Code: [Select]

Function arCsin(num As Double) As Variant

Dim pi As Double
pi = 4 * Atn(1)

If num < -1 Or num > 1 Then
    arCsin = "NV"
Else
    If num = 1 Or num = -1 Then
        arCsin = num * pi / 2
    Else
        arCsin = Atn(num / Sqr(-num * num + 1))
    End If
End If
End Function

_______________________________________________

Code: [Select]

Function aRccos(num As Double) As Variant

Dim pi As Double
pi = 4 * Atn(1)

If num < -1 Or num > 1 Then
    aRccos = "NV"
Else
    If num = 1 Or num = -1 Then
        aRccos = (num - 1) * pi / 2
    Else
        aRccos = Atn(-num / Sqr(-num * num + 1)) + 2 * Atn(1)
    End If
End If

End Function

_________________________________________________

In queste ho inserito i controlli sul valore passato e nel caso faccio restituire la stringa NV

segue la funzione che calcola l'area del segmento di cerchio

________________________________________________

Code: [Select]

Function segmento(xc As Double, R As Double, x As Double) As Variant

Dim beta As Double

beta = 2 * aRccos((x - xc) / R)
segmento = R ^ 2 * beta / 2 - (x - xc) * R * Sin(beta / 2)

End Function

____________________________________________

ed infine la funzione concio che riscrivo

__________________________________________________

Code: [Select]

Public Function concio(xc As Double, yc As Double, R As Double, _
                        xi As Double, xf As Double, _
                        yi As Double, yf As Double, _
                        xv As duble, yv As Double, flag As Double) As Variant
                        
Dim A As Double ' variabile per il calcolo dell'area
Dim B As Double 'variabile per il calcolo dello sviluppo dell'arco di base
Dim alfa As Double 'variabile per il calcolo dell'angolo di inclinazione della tangente
Dim ym As Double


ym = (yi + yf) / 2

' controllo che il raggio non sia minore o uguale a zero
If R <= 0 Then
    concio = 0
    Exit Function
End If
' controllo che xf sia maggiore di xi
If xf - xi <= 0 Then
    concio = 0
    Exit Function
End If
' controllo che xi ed xf siano all'interno del diametro del cerchio
' questo controllo serve a non fare andare in errore le funzioni trigonometriche inverse
If xf < xc - R Or xi > xc + R Then
    concio = 0
    Exit Function
End If

' controllo che xv sia all'interno di xi xf, nel caso cada all'esterno
' lo assumo pari ad xi
If xv < xi Or xv > xf Then
    xv = xi
    yv = yi
End If

' calcolo l'area sottesa dalla congiungente yi-yf
A = (segmento(xc, R, xi) - segmento(xc, R, xi)) / 2 - (xf - xi) * (yc - ym)
' adesso considero la presenza del vertice intermedio
A = A + (xf - xi) * (yf - yi) / 2 - (xv - xi) * (yv - yi) / 2 - (xf - xi) * (yf - yv) / 2 - (xv - xi) * (yf - yv)

' controllo area negativa
If A < 0 Then
    concio = 0
End If

' calcolo dell'angolo alfa
alfa = arCsin((xi - xc) / R) + (arCsin((xi - xc) / R) - arCsinn((xf - xc) / R)) / 2

' calcolo dello sviluppo dell'arco di base
B = R * arCsin((xi - xc) / R) - arCsin((xf - xc) / R)

Select Case flag
    Case 1
        concio = A
    Case 2
        concio = alfa
     Case 3
        concio = B
    Case Else
        concio = 0
End Select

End Function

______________________________________________

Per adesso considero conclusa questa funzione salvo a modificarla in seguito includendo anche la determinazione dell'ordinata del baricentro del concio

saluti

Edit by Gilean: afazio puoi usare il pulsante codice

per racchiudere le tue funzioni tra codice, per non perdere la formattazione delle funzioni e selezionarle con un click

IngTinda · « **Reply #62 on:** 18 December , 2009, 16:12:24 PM »

Sono ansioso di vedere come finisce la discussione, nel frattempo rinnovo i miei complimenti ad afazio...questo forum vedo ha al suo attivo gente estremamente competente in molti campi, non può farmi che piacere

afazio · « **Reply #63 on:** 18 December , 2009, 18:22:00 PM »

Quote from: IngTinda on 18 December , 2009, 16:12:24 PM

Sono ansioso di vedere come finisce la discussione, nel frattempo rinnovo i miei complimenti ad afazio...questo forum vedo ha al suo attivo gente estremamente competente in molti campi, non può farmi che piacere

Ho gai scritto la funzione che determina u due punti di intersezione tra polilinea del profilo di campagna e cerchio. Occorre solo inserire i controlli
Stasera posto il codice ed una breve descrizione.

afazio · « **Reply #64 on:** 18 December , 2009, 20:19:40 PM »

ecco la prima videata del foglio per verifica di stabilità del pendio.

Edit By Gilean: afazio è bene usare le thumbnail per evitare di sformare il post. Puoi usare il pulsante add image to post per inserire immagini.

afazio · « **Reply #65 on:** 18 December , 2009, 20:29:03 PM »

se mi si indica come fare l'upload del file condivido il file di inizio.
Fino ad adesso sono solo rimaste formule e righe di codice. Adesso sto iniziando a compilare il foglio che nel corso di questo processo subirà certamente una serie di modifiche sostanziali.

Intanto descrivo cosa ho fatto.
Ho prima di tutto scritto la funzione che, dato come input il range di celle contenenti i vertici della polilinea e i dati del cerchio mi restituisce i due punti di intersezione tra polilinea a cerchio (se esistono).
La forma della funcione e':

Public Function interseca_poly1(tabella As Range, xc As Double, yc As Double, R As Double, flag As Integer) As Variant

in cui i nomi delle variabili sono autoesplicativi
Il parametro flag serve per stabilire cosa deve restituire la funzione secondo la seguente convenzione:
flag=0, la funzione restituisce un valore logico Vero se esistono le intersezioni, Falso se non esistono
flag=1, la funzione restituisce l'ascissa del primo punto di intersezione
flag=2, la funzione restituisce l'ordinata del primo punto di intersezione
flag=3, la funzione restituisce l'ascissa del secondo punto di intersezione
flag=4, la funzione restituisce l'ordinata del secondo punto di intersezione
di seguito il codice che deve ancora essere sottoposto a tutti i controlli necessari per non incorrere in errori

Code: [Select]

Public Function interseca_poly1(tabella As Range, xc As Double, yc As Double, R As Double, flag As Integer) As Variant

Dim nPunti As Integer
Dim xx(1 To 2) As Double
Dim yy(1 To 2) As Double
Dim count As Integer
Dim esiste_intersez As Boolean
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
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
    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

    d = b1 ^ 2 - 4 * a1 * c1
    If d > 0 Then
        x1 = (-b1 - d ^ 0.5) / (2 * a1)
        x2 = (-b1 + d ^ 0.5) / (2 * a1)
        y1 = m * x1 + n
        y2 = m * x2 + n
        
        If Not (xf < x1 Or xi > x2) Then
            ' vi sono intersezioni
            
            If xi <= x1 And xf < x2 Then
                'una intersezione data dal primo punto
                xx(1) = x1
                yy(1) = y1
                esiste_intersez = True
            End If
            
            If xi <= x1 And xf >= x2 Then
                ' due intersezioni
                xx(1) = x1
                yy(1) = y1
                xx(2) = x2
                yy(2) = y2
                esiste_intersez = True
            End If
            
            If xi > x1 And xf < x2 Then
                ' nessuna intersezione
            End If
            
            If xi > x1 And xf >= x2 Then
                ' una intersezione
                xx(2) = x2
                yy(2) = y2
                esiste_intersez = True
            End If
        End If
    End If
Next

Select Case flag
    Case 0
        interseca_poly1 = esiste_intersez
    Case 1
        interseca_poly1 = xx(1)
    Case 2
        interseca_poly1 = yy(1)
    Case 3
        interseca_poly1 = xx(2)
    Case 4
        interseca_poly1 = yy(2)
    Case Else
        interseca_poly1 = "ERRORE NEL FLAG"
End Select


End Function

123599 · « **Reply #66 on:** 18 December , 2009, 20:43:06 PM »

menù in alto, clicca---> Downloads poi il alto alto a destra ---> MYFILES

afazio · « **Reply #67 on:** 18 December , 2009, 20:43:20 PM »

Quote from: afazio on 18 December , 2009, 20:29:03 PM

se mi si indica come fare l'upload del file condivido il file di inizio.
Fino ad adesso sono solo rimaste formule e righe di codice. Adesso sto iniziando a compilare il foglio che nel corso di questo processo subirà certamente una serie di modifiche sostanziali.

Intanto descrivo cosa ho fatto.
Ho prima di tutto scritto la funzione che, dato come input il range di celle contenenti i vertici della polilinea e i dati del cerchio mi restituisce i due punti di intersezione tra polilinea a cerchio (se esistono).
La forma della funcione e':

Public Function interseca_poly1(tabella As Range, xc As Double, yc As Double, R As Double, flag As Integer) As Variant

in cui i nomi delle variabili sono autoesplicativi
Il parametro flag serve per stabilire cosa deve restituire la funzione secondo la seguente convenzione:
flag=0, la funzione restituisce un valore logico Vero se esistono le intersezioni, Falso se non esistono
flag=1, la funzione restituisce l'ascissa del primo punto di intersezione
flag=2, la funzione restituisce l'ordinata del primo punto di intersezione
flag=3, la funzione restituisce l'ascissa del secondo punto di intersezione
flag=4, la funzione restituisce l'ordinata del secondo punto di intersezione
di seguito il codice che deve ancora essere sottoposto a tutti i controlli necessari per non incorrere in errori

Code: [Select]
Public Function interseca_poly1(tabella As Range, xc As Double, yc As Double, R As Double, flag As Integer) As Variant Dim nPunti As Integer Dim xx(1 To 2) As Double Dim yy(1 To 2) As Double Dim count As Integer Dim esiste_intersez As Boolean 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 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 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 d = b1 ^ 2 - 4 * a1 * c1 If d > 0 Then x1 = (-b1 - d ^ 0.5) / (2 * a1) x2 = (-b1 + d ^ 0.5) / (2 * a1) y1 = m * x1 + n y2 = m * x2 + n If Not (xf < x1 Or xi > x2) Then ' vi sono intersezioni If xi <= x1 And xf < x2 Then 'una intersezione data dal primo punto xx(1) = x1 yy(1) = y1 esiste_intersez = True End If If xi <= x1 And xf >= x2 Then ' due intersezioni xx(1) = x1 yy(1) = y1 xx(2) = x2 yy(2) = y2 esiste_intersez = True End If If xi > x1 And xf < x2 Then ' nessuna intersezione End If If xi > x1 And xf >= x2 Then ' una intersezione xx(2) = x2 yy(2) = y2 esiste_intersez = True End If End If End If Next Select Case flag Case 0 interseca_poly1 = esiste_intersez Case 1 interseca_poly1 = xx(1) Case 2 interseca_poly1 = yy(1) Case 3 interseca_poly1 = xx(2) Case 4 interseca_poly1 = yy(2) Case Else interseca_poly1 = "ERRORE NEL FLAG" End Select End Function

per determinare i punti di intersezione ho seguito il metodo che mi ha suggerito Alberto

afazio · « **Reply #68 on:** 18 December , 2009, 20:47:08 PM »

Quote from: 123599 on 18 December , 2009, 20:43:06 PM

menù in alto, clicca---> Downloads poi il alto alto a destra ---> MYFILES

Download Not Approved

Lo approvo subito afazio, ho messo la moderazione in download per evitare di essere sommerso da files (o virus) di possibili bot di spam.

123599 · « **Reply #69 on:** 18 December , 2009, 20:48:54 PM »

Download Not Approved

Credo li debba approvare l'Amministratore, così mi è parso di capire in questi giorni di letture.

ferrarialberto · « **Reply #70 on:** 18 December , 2009, 21:28:20 PM »

Quote from: afazio on 18 December , 2009, 20:29:03 PM

per determinare i punti di intersezione ho seguito il metodo che mi ha suggerito Alberto

Ciao Afazio, ho letto rapidamente il codice. Occhio che se xi=xf si genera un errore di runtime.

Ciao.

afazio · « **Reply #71 on:** 18 December , 2009, 21:36:20 PM »

Quote from: afazio on 18 December , 2009, 20:43:20 PM

per determinare i punti di intersezione ho seguito il metodo che mi ha suggerito Alberto

L'equazione del cerchio si puo scrivere come

x² + y² + A*x + B*y + C = 0

con:
A=-2*xc
B=-2*yc
C=xc²+yc² - R²

L'equazione passante per (xi;yi) e per (xf,yf) si scrive;

y = m*x + n

con
m=(yf-yi)/(xf-xi)
n= yi - m*xi

e qui c'e' la prima fonte di errore, nel caso di segmento verticale abbiamo divisione per zero. Occorrerà apportare questo controllo e procedere con l'intersezione di un cerchio con la retta x=xi

Sostituendo nell'equazione del cerchio il valore (mx+n) otteniamo l'equazione dis econdo grado dei memorabili tempi del liceo:

a1*x² + b1*x +c1 = 0
con
a1 = m²+1
b1= 2*m*n + A +m*B
c1= n ² + B * n + C

Si determina il discriminante e se e' maggiore di zero vi sono le due intersezioni con la retta su cui giace il generico segmento della polilinea.
Il caso di discriminante nullo non mi interessa, poichè un segmento tangente al cerchio non partecipa nell'equilibrio del pendio dato che sarebbe nullo l'apporto di area di concio

Ma il fatto che vi siano due intersezione della retta su cui giace il segmento col cerchio, non significa affatto che necessariamente il segmento interseca il cerchio.
Occorre capire la posizione reciproca tra gli estremi del segemento e i due punti di intersezione

pertanto, indicand o con x1 ed x2 rispettivamente le ascisse del primo e del secondo punto di intersezione, abbiamo i seguenti casi:

- se (xf < x1 Or xi > x2) - non vi sono intersezioni poiche il segmento e' o tutto a sinistra del cerchio o tutto a destra

- se xi <= x1 And xf < x2 - vi e' una sola intersezione. Il segmento ha il primo estremo a sinistra del cerchio (o sul cerchio stesso) mentre il secondo si trova dentro il cerchio. il punto i intersezione è proprio x1

- se xi <= x1 And xf >= x2 vi sono due intersezioni in quanto il primo estremo del segemento si trova a sinistra del cerchio (oppure sul cerchio stesso) ed il secondo estremo si trova a destra del cerchio (oppure sul cerchio). Entrambi i punti, x1 ed x2 sono punti di intersezione

- se xi > x1 And xf < x2, non vi sono intersezioni poiche il segmento e' tutto interno al cerchio

- se xi > x1 And xf >= x2, vi e' una sola intersezione in quanto ilprimo estremo del segmento e' dentro il cerchio mentre il secondo è o sul cerchio oppure fuori dal cerchio a destra. Il punto i intersezione è proprio x2

afazio · « **Reply #72 on:** 18 December , 2009, 21:48:47 PM »

Quote from: ferrarialberto on 18 December , 2009, 21:28:20 PM

Ciao Afazio, ho letto rapidamente il codice. Occhio che se xi=xf si genera un errore di runtime.

Ciao.

Si. Devo ancora inserire i controlli.
Nel caso di xi=xf (quindi tratto verticale delle polilinea), devo intersecare il cerchio con la retta x=xi e la cosa e' facile, ma oltre a questo devo anche modificare le condizioni che discriminano la posizione del segmento rispetto ai punti di intersezione. E' ovvio che gli IF non possono avere come condizione i valori delle ascisse (essendo tutte uguali ad xi) ma si devono basare invece sulle ordinate.

ferrarialberto · « **Reply #73 on:** 18 December , 2009, 22:20:21 PM »

Occhio anche all'orientamento con il quale viene definita la polilinea: da sx verso dx o viceversa: in quest'ultimo caso mi pare che le condizioni finali sul controllo delle intersezioni interne al segmento non siano correttamente funzionanti.

Ciao.

afazio · « **Reply #74 on:** 18 December , 2009, 22:30:26 PM »

Quote from: ferrarialberto on 18 December , 2009, 22:20:21 PM

Occhio anche all'orientamento con il quale viene definita la polilinea: da sx verso dx o viceversa: in quest'ultimo caso mi pare che le condizioni finali sul controllo delle intersezioni interne al segmento non siano correttamente funzionanti.

Ciao.

Non ho specificato, ma in ogni figura ho sempre disegnato il profilo da sx verso destra a salire.
Questa e' una regola che occorre rispettare per evitare di complicare le funzioni ed i controlli
Altra regola e' quella che non si pososno inserire tratti di pendio o di separazione strati in contropendenza, cioe con xf<xi.
Potrei anche aggiungere la limitazione che non si pososno mettere tratti verticali, ma per adesso la cosa non mi ha dato alcun problema. Forse me li darà quando dovro procedere alla suddivisione in conci.
Vedremo.

Per le condizioni finali a cui ti riferisci, non saprei, posso solo dirti che col foglio che ho predisposto ho provato numerosi casi e le intersezioni sono sempre calcolate correttamente, tuttavia sappiamo benissimo che il bug si puo celare financo sotto il tuo naso.

Mi spieghi meglio dove sta il tuo dubbio?

Ingegneria Forum

Author Topic: Una funzione per la stabilità dei pendii (Read 44623 times)

afazio

Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

IngTinda

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

123599

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

123599

Re: Una funzione per la stabilità dei pendii

ferrarialberto

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii

ferrarialberto

Re: Una funzione per la stabilità dei pendii

afazio

Re: Una funzione per la stabilità dei pendii