Pathfinder Studio, le successeur de Propagation
Pour que ça marche aussi avec les modes de propagation périphérique il faut scinder DecaleTop et Decale!Left en DecaleTopY, DecaleTopZ, et pareil pour le Left :
If Y1 = 1 Then
Shp2.ZOrder msoSendToBack
DecaleTopY = 37.5
ElseIf Y1 = -1 Then
DecaleTopY = -37.5
End If
If Z1 = -1 Then
Shp2.ZOrder msoSendToBack
DecaleTopZ = 13.5
DecaleLeftZ = -13.5
ElseIf Z1 = 1 Then
Shp2.ZOrder msoSendToBack
DecaleTopZ = -13.5
DecaleLeftZ = 13.5
End If
' positionnement par rapport au dernier cube
Shp2.Top = Shp1.Top + DecaleTopY + DecaleTopZ
Shp2.Left = Shp1.Left + DecaleLeftY + DecaleLeftZEt bien voilà ! Vous ne vous arrêtez plus !
Avez vous essayé une grande taille ? Les coordonnées de départ devrait être en fonction de sa propre position dans le volume et en fonction de la taille de ce volume sinon en bordure d'écran les shapes vont se supperposer.
Sur ma version de votre programme, le shape finale je le place aux coordonnées de B2 en ayant figé la première ligne et première colonne.
De même, j'ai mis un Apllication.ScreenUpDating = false au début de code.
J'ai également dans la procédure calcul, supprimer la mise en couleur des adresses de chemin si ce n'est pas la feuille "grille" qui est active.
j'ai "réussi" à créer mon tableau X,Y,Z reprenant les données des différentes grilles, il me reste plus qu'à gérer la "prise de vu" et les changements du code pour la vision de face, de droite et de dessus.
Que de changement et d'évolution depuis le début de votre projet ! Bravo à vous et merci pour le clin d'œil sur la feuille "explications" !
@ bientôt
LouReeD
Voici les 3 vues !
Bon c'est un peu figé, du fait que je suis parti en dur sur une grille de 10 x 10 x 10.
Il me reste à trouver où se trouve les différentes tailles, comme cela je pourrai mettre en variables les différentes boucles !
Je trouve que c'est pas mal afin d'avoir une vue différente su le parcours est compliqué. Avec le tableau représentant la zone complète, on peut "facilement" faire les 3 vues manquantes !
Et comme je prends les données de la feuilles Grille, il n'est pas nécessaire de relancer la fabrique du chemin.
Le fichier :
@ bientôt
LouReeD
Bravo pour cette possibilité de générer 3 vues différentes et pour le soin apporté à la présentation !
Il ne me reste plus qu'a m'en inspirer pour avoir une version où l'on pourrait modifier les dimensions de la grille.
Une remarque aussi : lire les données dans les grilles est bien plus long que de ré effectuer un nouveau calcul pathfinding (une fois la feuille lue une première fois).
Pour ma part je me suis rendu compte d'une boulette dans mon code
Private Sub obAlgo222_Click()
Dim Sum#
Grid.Names("Algorithm").RefersTo = 222
FrameRandom222.Visible = True
FrameRandom211.Visible = False
On Error Resume Next
Sum = Application.WorksheetFunction.Sum(Grid.Range("Z_1"))
If Sum <> Int(Sum) Then Grid.Cells.ClearContents: Exit Sub
If Application.WorksheetFunction.Max(Grid.Range("Z_1")) > 32767 Then Grid.Cells.ClearContents
End SubEn voici sa version corrigée :
Private Sub obAlgo222_Click()
Dim Sum#
Grid.Names("Algorithm").RefersTo = 222
FrameRandom222.Visible = True
FrameRandom211.Visible = False
On Error GoTo Finish
Sum = Application.WorksheetFunction.Sum(Grid.Range("Z_1"))
If Sum <> Int(Sum) Then Grid.Cells.ClearContents: Exit Sub
If Application.WorksheetFunction.Max(Grid.Range("Z_1")) > 32767 Then Grid.Cells.ClearContents
Finish:
End Sub@+
Bonjour,
Cette histoire d'effacement de grille je pensais que c'était voulu...
Je sais que la lecture de feuille est longue, pour optimiser je devrait faire une récupération de données par couche, ici il n'y aurait alors que 10 accès.
Le soucis à mon niveau vu ma programmation, je ne comment faire avec votre "chemin", je ne suis pas arrivé à comprendre la structure de ce dernier.
Mais pas de crainte, c'est juste pour moi et le fun !
A vous les téléchargements !
@ bientôt
LouReeD
Bonsoir,
je fais le "forcing" !
Modification de mon code de récupération des données sans en modifier les valeurs, cela va "beaucoup" plus vite : 0 au lieu de 0.0655.
Sub CreaTabXYZ()
Dim X, Y, Z, xl, Couche(1 To 10), Tempo As Double
Tempo = Timer
With Sheets("Grille")
xl = 0
For Z = 1 To 10
For Y = 1 To 10
For X = 1 To 10
If .Cells(Y + (10 * xl) + 1 + xl, X).Interior.Color = vbRed Then
TabXYZ(Z, Y, X) = "D"
ElseIf .Cells(Y + (10 * xl) + 1 + xl, X).Interior.Color = vbCyan Then
TabXYZ(Z, Y, X) = "F"
ElseIf .Cells(Y + (10 * xl) + 1 + xl, X).Interior.Color = vbGreen Then
TabXYZ(Z, Y, X) = "C"
Else
TabXYZ(Z, Y, X) = ""
End If
Next X
Next Y
xl = xl + 1
Next Z
End With
MsgBox Timer - Tempo
End
End Sub
Sub CreaTabXYZ_rapide()
Dim X, Y, Z, xl, Couche(1 To 10), Tempo As Double
Tempo = Timer
With Sheets("Grille")
xl = 0
For Z = 1 To 10
Couche(Z) = .Cells((10 * xl) + 2 + xl, 1).Resize(10, 10)
xl = xl + 1
Next Z
' ici on rempli le tableau 3D,
' mais ce n'est peut-être pas utile si j'utilise directement le tableau Couche par la suite
For Z = 1 To 10
For Y = 1 To 10
For X = 1 To 10
TabXYZ(Z, Y, X) = Couche(Z)(Y, X)
Next X
Next Y
Next Z
End With
MsgBox Timer - Tempo
End
End SubMais le gain de temps n'apporte pas la détermination du début, de la fin et du chemin par les couleurs des cellules...
@ voir donc si je continue dans ce sens ou pas...
@ bientôt
LouReeD
Bonsoir,
sur un cube 100 x 100 x 100, la récupération des données avec le vieux code c'est 120 secondes, contre 0.15 avec le nouveau !
Donc je cherche les lignes de codes du calcul du chemin afin de modifier à la création les cases vertes en C, la rouge en D et la dernière en F.
Par contre ma technique de tourner sur les 1000000 cellules pour récupérer celles ne comportant pas de chiffres, cela est très long alors que le chemin ne contient que 350 cases !
Ce que j'ai vu aussi, c'est que la feuille ralentie avec tous ces shapes, donc je copie colle le résultat pour n'en faire qu'une seule image :
ActiveSheet.Shapes.Range(Chemin).Group
Set Sh = Feuil1.Shapes(Feuil1.Shapes.Count)
' on copie ce groupe en image
Sh.Copy
ActiveSheet.PasteSpecial Format:="PNG"
' on attribue cette image à un nouveau shape
Set ShImage = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
' on efface le groupe
Sh.Delete
' et on travail avec l'image, on a bien réduit le nombre de shape sur la feuille
ShImage.Name = "_LeChemin"
ShImage.Left = ActiveSheet.Range("B2").Left + 4
ShImage.Top = ActiveSheet.Range("B2").Top + 4
Feuil1.Range(ShImage.TopLeftCell, ShImage.BottomRightCell).Select
ActiveWindow.Zoom = True
ActiveSheet.Range("B2").Select
Application.EnableEvents = TrueDonc grand cube de 100 de côté, départ en A2, fin aléatoire, calcul du chemin avec mise ne place des "C" et "F", je ne sais où placer le "D", puis lancement de la représentation 3D : mise en mémoire des données : 0.30 secondes, création du chemin et mise en image unique : 54 secondes pour un chemin de 198 cases.
L'image finale :
On voit qu'il manque le rouge...
Par contre sur le USF, je n'ai pas trouvé comment augmenter le nombre de "-1" afin de créer plus d'obstacle...
En fait si ! il y a un % à modifier !
@ bientôt
LouReeD
Nouveau test avec 30% d'obstacles, 0.30 mis en mémoire, 64 secondes création chemin avec 313 cubes utilisables, mais toujours pas de cellule de départ...
L'image finale :
@ bientôt
LouReeD
Je ne comprend pas...
je viens de lancé sur les "autres faces" : 0.33 secondes pour la mise en mémoire des données, ça c'est standard et conforme à l'attendu, mais la création du chemin elle descend à 1.5 secondes ! et quand je lance la création de face première cela remonte à 55 secondes !
L'ordre des données dans un tableau est à priori importante ! tout du moins leur extraction dans des boucles imbriquées !?!
Cela vous dis quelque chose ?
les trois boucles concernées :
If Right(Application.Caller, 1) = 1 Then
For Z = 100 To 1 Step -1
For Y = 100 To 1 Step -1
For X = 1 To 100
DoEvents
If Not IsNumeric(TabXYZ(Z, Y, X)) Then
Set Sh = ActiveSheet.Shapes("Cube").Duplicate
Sh.Visible = True
Sh.Name = "_" & Sh.Name & J
If TabXYZ(Z, Y, X) = "D" Then
Sh.Fill.ForeColor.RGB = vbRed
ElseIf TabXYZ(Z, Y, X) = "F" Then
Sh.Fill.ForeColor.RGB = vbGreen
ElseIf TabXYZ(Z, Y, X) = "C" Then
Sh.Fill.ForeColor.RGB = vbCyan
End If
Sh.Top = LeTop - ((100 - Y) * Taille) + ((100 - Z) * Taille / 3)
Sh.Left = LeLeft + ((X - 1) * Taille) - ((100 - Z) * Taille / 3)
J = J + 1
ReDim Preserve Chemin(J)
Chemin(J) = Sh.Name
End If
Next X
Next Y
Next Z
ElseIf Right(Application.Caller, 1) = 2 Then
For X = 100 To 1 Step -1
For Y = 100 To 1 Step -1
For Z = 100 To 1 Step -1
If Not IsNumeric(TabXYZ(Z, Y, X)) Then
Set Sh = ActiveSheet.Shapes("Cube").Duplicate
Sh.Visible = True
Sh.Name = "_" & Sh.Name & J
If TabXYZ(Z, Y, X) = "D" Then
Sh.Fill.ForeColor.RGB = vbRed
ElseIf TabXYZ(Z, Y, X) = "F" Then
Sh.Fill.ForeColor.RGB = vbGreen
ElseIf TabXYZ(Z, Y, X) = "C" Then
Sh.Fill.ForeColor.RGB = vbCyan
End If
Sh.Top = LeTop - ((100 - Y) * Taille) + ((100 - X) * Taille / 3)
Sh.Left = LeLeft + ((100 - Z) * Taille) - ((100 - X) * Taille / 3)
J = J + 1
ReDim Preserve Chemin(J)
Chemin(J) = Sh.Name
End If
Next Z
Next Y
Next X
Else
For Y = 1 To 100
For Z = 1 To 100
For X = 1 To 100
If Not IsNumeric(TabXYZ(Z, Y, X)) Then
Set Sh = ActiveSheet.Shapes("Cube").Duplicate
Sh.Visible = True
Sh.Name = "_" & Sh.Name & J
If TabXYZ(Z, Y, X) = "D" Then
Sh.Fill.ForeColor.RGB = vbRed
ElseIf TabXYZ(Z, Y, X) = "F" Then
Sh.Fill.ForeColor.RGB = vbGreen
ElseIf TabXYZ(Z, Y, X) = "C" Then
Sh.Fill.ForeColor.RGB = vbCyan
End If
Sh.Top = LeTop - ((Z - 1) * Taille) + ((Y - 1) * Taille / 3)
Sh.Left = LeLeft + ((X - 1) * Taille) - ((Y - 1) * Taille / 3)
J = J + 1
ReDim Preserve Chemin(J)
Chemin(J) = Sh.Name
End If
Next X
Next Z
Next Y
End If@ bientôt
LouReeD