Embedded Files
Por último un Bresenham de 6 dimensiones. Verás que tiene un código un poco largo porque contiene seis "If..Then" y dentro de cada "If..Then" un "For..Next". Depende de los valores de entrada para que se determine por uno de los seis "If..Then"; esto significa que sólo se ejecuta una parte del programa. Teniendo en cuenta esto y que Bresenham sólo usa sumas y restas, el tiempo de ejecución es mínimo.
Este algoritmo puede servirte para 2D, 3D, 4D, 5D y 6D. Las dimensiones que no uses has de dejarlas a cero o sin introducir cambios.
La imagen de arriba es el programa en ejecución, donde puedes observar la sucesión de posiciones, uno por uno, hasta completar la trayectoria.
Para bajarte directamente el algoritmo de Bresenham 6D, cliquea aquí. Si quieres un Bresenham 4D y nada más, cliquea aquí. En el interior del ZIP viene el código fuente y el programa ejecutable.
Dim As Integer d1, d2, d3, d4, d5, d6,_ Ad1, Ad2, Ad3, Ad4, Ad5, Ad6,_ inc1, inc2, inc3, inc4, inc5, inc6,_ d1x2, d2x2, d3x2, d4x2, d5x2, d6x2,_ dim1, dim2, dim3, dim4, dim5, dim6,_ old1, old2, old3, old4, old5, old6,_ new1, new2, new3, new4, new5, new6,_ err1, err2, err3, err4, err5, Cont3 While (1) Input "Dim1: ", New1 Input "Dim2: ", New2 Input "Dim3: ", New3 Input "Dim4: ", New4 Input "Dim5: ", New5 Input "Dim6: ", New6 d1 = New1 - Old1 d2 = New2 - Old2 d3 = New3 - Old3 d4 = New4 - Old4 d5 = New5 - Old5 d6 = New6 - Old6 If (d1 < 0) Then inc1 = -1 Else inc1 = 1 EndIf If (d2 < 0) Then inc2 = -1 Else inc2 = 1 EndIf If (d3 < 0) Then inc3 = -1 Else inc3 = 1 EndIf If (d4 < 0) Then inc4 = -1 Else inc4 = 1 EndIf If (d5 < 0) Then inc5 = -1 Else inc5 = 1 EndIf If (d6 < 0) Then inc6 = -1 Else inc6 = 1 EndIf Ad1 = Abs(d1) Ad2 = Abs(d2) Ad3 = Abs(d3) Ad4 = Abs(d4) Ad5 = Abs(d5) Ad6 = Abs(d6) d1x2 = Ad1*2 d2x2 = Ad2*2 d3x2 = Ad3*2 d4x2 = Ad4*2 d5x2 = Ad5*2 d6x2 = Ad6*2 If(Ad1>=Ad2)And(Ad1>=Ad3)And(Ad1>=Ad4)And(Ad1>=Ad5)And(Ad1>=Ad6) Then err1 = d2x2 - Ad1 err2 = d3x2 - Ad1 err3 = d4x2 - Ad1 err4 = d5x2 - Ad1 err5 = d6x2 - Ad1 For Cont3 = 1 To Ad1 If (err1 > 0) Then dim2+= inc2 err1 -= d1x2 EndIf If (err2 > 0) Then dim3+= inc3 err2 -= d1x2 EndIf If (err3 > 0) Then dim4+= inc4 err3 -= d1x2 EndIf If (err4 > 0) Then dim5+= inc5 err4 -= d1x2 EndIf If (err5 > 0) Then dim6+= inc6 err5 -= d1x2 EndIf err1 += d2x2 err2 += d3x2 err3 += d4x2 err4 += d5x2 err5 += d6x2 dim1+= inc1 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf If(Ad2>Ad1)And(Ad2>=Ad3)And(Ad2>=Ad4)And(Ad2>=Ad5)And(Ad2>=Ad6) Then err1 = d1x2 - Ad2 err2 = d3x2 - Ad2 err3 = d4x2 - Ad2 err4 = d5x2 - Ad2 err5 = d6x2 - Ad2 For Cont3 = 1 To Ad2 If (err1 > 0) Then dim1+= inc1 err1 -= d2x2 EndIf If (err2 > 0) Then dim3+= inc3 err2 -= d2x2 EndIf If (err3 > 0) Then dim4+= inc4 err3 -= d2x2 EndIf If (err4 > 0) Then dim5+= inc5 err4 -= d2x2 EndIf If (err5 > 0) Then dim6+= inc6 err5 -= d2x2 EndIf err1 += d1x2 err2 += d3x2 err3 += d4x2 err4 += d5x2 err5 += d6x2 dim2+= inc2 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf If(Ad3>Ad1)And(Ad3>Ad2)And(Ad3>=Ad4)And(Ad3>=Ad5)And(Ad3>=Ad6) Then err1 = d2x2 - Ad3 err2 = d1x2 - Ad3 err3 = d4x2 - Ad3 err4 = d5x2 - Ad3 err5 = d6x2 - Ad3 For Cont3 = 1 To Ad3 If (err1 > 0) Then dim2+= inc2 err1 -= d3x2 EndIf If (err2 > 0) Then dim1+= inc1 err2 -= d3x2 EndIf If (err3 > 0) Then dim4+= inc4 err3 -= d3x2 EndIf If (err4 > 0) Then dim5+= inc5 err4 -= d3x2 EndIf If (err5 > 0) Then dim6+= inc6 err5 -= d3x2 EndIf err1 += d2x2 err2 += d1x2 err3 += d4x2 err4 += d5x2 err5 += d6x2 dim3+= inc3 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf If(Ad4>Ad1)And(Ad4>Ad2)And(Ad4>Ad3)And(Ad4>=Ad5)And(Ad4>=Ad6) Then err1 = d1x2 - Ad4 err2 = d2x2 - Ad4 err3 = d3x2 - Ad4 err4 = d5x2 - Ad4 err5 = d6x2 - Ad4 For Cont3 = 1 To Ad4 If (err1 > 0) Then dim1+= inc1 err1 -= d4x2 EndIf If (err2 > 0) Then dim2+= inc2 err2 -= d4x2 EndIf If (err3 > 0) Then dim3+= inc3 err3 -= d4x2 EndIf If (err4 > 0) Then dim5+= inc5 err4 -= d4x2 EndIf If (err5 > 0) Then dim6+= inc6 err5 -= d4x2 EndIf err1 += d1x2 err2 += d2x2 err3 += d3x2 err4 += d5x2 err5 += d6x2 dim4+= inc4 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf If(Ad5>Ad1)And(Ad5>Ad2)And(Ad5>Ad3)And(Ad5>Ad4)And(Ad5>=Ad6) Then err1 = d1x2 - Ad5 err2 = d2x2 - Ad5 err3 = d3x2 - Ad5 err4 = d4x2 - Ad5 err5 = d6x2 - Ad5 For Cont3 = 1 To Ad5 If (err1 > 0) Then dim1+= inc1 err1 -= d5x2 EndIf If (err2 > 0) Then dim2+= inc2 err2 -= d5x2 EndIf If (err3 > 0) Then dim3+= inc3 err3 -= d5x2 EndIf If (err4 > 0) Then dim4+= inc4 err4 -= d5x2 EndIf If (err5 > 0) Then dim6+= inc6 err5 -= d5x2 EndIf err1 += d1x2 err2 += d2x2 err3 += d3x2 err4 += d4x2 err5 += d6x2 dim5+= inc5 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf If(Ad6>Ad1)And(Ad6>Ad2)And(Ad6>Ad3)And(Ad6>Ad4)And(Ad6>Ad5) Then err1 = d1x2 - Ad6 err2 = d2x2 - Ad6 err3 = d3x2 - Ad6 err4 = d4x2 - Ad6 err5 = d5x2 - Ad6 For Cont3 = 1 To Ad6 If (err1 > 0) Then dim1+= inc1 err1 -= d6x2 EndIf If (err2 > 0) Then dim2+= inc2 err2 -= d6x2 EndIf If (err3 > 0) Then dim3+= inc3 err3 -= d6x2 EndIf If (err4 > 0) Then dim4+= inc4 err4 -= d6x2 EndIf If (err5 > 0) Then dim5+= inc5 err5 -= d6x2 EndIf err1 += d1x2 err2 += d2x2 err3 += d3x2 err4 += d4x2 err5 += d5x2 dim6+= inc6 Print dim1;" ";dim2;" ";dim3;" ";dim4;" ";dim5;" ";dim6 Next EndIf Old1=New1 Old2=New2 Old3=New3 Old4=New4 Old5=New5 Old6=New6 Wend EndGoogle Sites
Report abuse