# Programas para el tratamiento de nubes de puntos # Vitoria-Gasteiz 16 de junio de 2006 # Álvaro R. Miranda # azaroa@yahoo.com # Regulariza una nube de puntos, eliminando las coordenadas repetidas y # promediando sus valores de color. proc 0309_inicio {} { global mensaje0309 set mensaje0309 "Seleccionar archivos origen y salida" global camin set camin "" destroy .0309 toplevel .0309 wm title .0309 "Regularizar nube" label .0309.tit -text "Eliminar puntos duplicados" frame .0309.uno frame .0309.dos button .0309.b -text "Extraer nube de puntos" -command {0309_LimpiarNube $fxyz} label .0309.men -textvariable mensaje0309 -relief sunken -fg "#009900" button .0309.dos.b -text "Nube de salida .xyz:" -command { global camin set fxyz [tk_getSaveFile -filetypes {{"Nube de puntos" .xyz}} -title "Nube de puntos" \ -initialdir $camin] set camin [file dirname $fxyz] } label .0309.dos.l -textvariable fxyz -relief sunken frame .0309.uno.i frame .0309.uno.d frame .0309.tre frame .0309.cua frame .0309.cin scrollbar .0309.uno.sy -orient vertical -command [list .0309.uno.i.lb yview] listbox .0309.uno.i.lb -xscrollcommand [list .0309.uno.i.sx set] -yscrollcommand [list .0309.uno.sy set] \ -width 40 -height 10 -selectmode extended scrollbar .0309.uno.i.sx -orient horizontal -command [list .0309.uno.i.lb xview] button .0309.uno.d.b1 -text "Añadir elemento" -command { global camin set tipos {{"Nube" .xyz} {"Todos" .*}} set fmed [tk_getOpenFile -filetypes $tipos -title "Añadir Elemento" -initialdir $camin] if {$fmed!=""} { set camin [file dirname $fmed] .0309.uno.i.lb insert end "$fmed" } } button .0309.uno.d.b2 -text "Añadir carpeta" -command { global camin set tipos {{"Nube" .xyz}} set fmed [tk_getOpenFile -filetypes $tipos -title "Añadir toda la carpeta"\ -initialdir $camin] if {$fmed!=""} { if {[catch { set camin [file dirname $fmed] set lcam [split $camin "/"] set camin2 [lindex $lcam 0] foreach l [lrange $lcam 1 end] { set camin2 "$camin2\\$l" } set fid [open tmpmdl1.bat w] puts $fid "dir \"$camin2\\*.xyz\" >tmpmdl2.dat" close $fid exec tmpmdl1.bat set fid [open tmpmdl2.dat r] set archivo [read -nonewline $fid] close $fid set lista [split $archivo "\n"] set ltot "" foreach ll $lista { set el [lindex $ll end] set el2 [lindex [split $el "."] 1] if {$el2=="xyz"} { .0309.uno.i.lb insert end "$camin/$el" } } file delete tmpmdl2.dat file delete tmpmdl1.bat } er]} { tk_messageBox -title "Error" -message \ "No se ha podido completar la carga de archivos,\n\ esta opción necesita crear ficheros temporales,\ quizás no haya permiso de escritura en \n\ la carpeta donde reside el programa." \ -type ok } } } button .0309.uno.d.b3 -text "Eliminar" -command { set inl [lsort -integer -decreasing [.0309.uno.i.lb curselection]] if {$inl!=""} { foreach el $inl { .0309.uno.i.lb delete $el } } } label .0309.tre.l1 -text "Archivo Ascii (empieza en 0); ColumnaX:" global colX ; set colX 0 entry .0309.tre.ex -textvariable colX -width 2 label .0309.tre.l2 -text " ColumnaY:" global colY ; set colY 1 entry .0309.tre.ey -textvariable colY -width 2 label .0309.tre.l3 -text " ColumnaZ:" global colZ ; set colZ 2 entry .0309.tre.ez -textvariable colZ -width 2 label .0309.cua.l1 -text "Columnas del color, Rojo:" global colR ; set colR 3 entry .0309.cua.e1 -textvariable colR -width 2 label .0309.cua.l2 -text " Verde:" global colV ; set colV 4 entry .0309.cua.e2 -textvariable colV -width 2 label .0309.cua.l3 -text " Azul:" global colA ; set colA 5 entry .0309.cua.e3 -textvariable colA -width 2 global ndeci ; set ndeci 2 label .0309.cua.l4 -text ". Nº decimales:" entry .0309.cua.e4 -textvariable ndeci -width 2 global sol05 ; set sol05 0 checkbutton .0309.cua.ch -text "Sólo 0 y 5 como último decimal" -variable sol05 label .0309.cin.l1 -text "Nº mínimo de elementos por cubo:" global nelm ; set nelm 1 entry .0309.cin.e1 -textvariable nelm -width 3 global fdiv ; set fdiv 0 checkbutton .0309.cin.ch -text "Atenuar el color en función del número" -variable fdiv pack .0309.cin.l1 .0309.cin.e1 .0309.cin.ch -side left -fill y pack .0309.cua.l1 .0309.cua.e1 .0309.cua.l2 .0309.cua.e2 .0309.cua.l3 .0309.cua.e3 .0309.cua.l4 .0309.cua.e4 .0309.cua.ch -side left -fill y pack .0309.tre.l1 .0309.tre.ex .0309.tre.l2 .0309.tre.ey .0309.tre.l3 .0309.tre.ez -side left -fill y pack .0309.uno.d.b1 .0309.uno.d.b2 .0309.uno.d.b3 -fill x pack .0309.uno.i.lb .0309.uno.i.sx -fill x pack .0309.uno.i .0309.uno.sy .0309.uno.d -side left -fill y pack .0309.dos.b .0309.dos.l -side left -fill y pack .0309.tit .0309.uno .0309.dos .0309.tre .0309.cua .0309.cin .0309.b .0309.men -fill x } proc 0309_LimpiarNube {fxyz} { # Esta función elimina los puntos duplicados global colX ; global colY ; global colZ global colR ; global colV ; global colA global ndeci global nelm global fdiv global sol05 global mensaje0309 # Creando archivos auxiliares para repartir los puntos set raiz [file root $fxyz] set fsal [open $fxyz w] for {set i 0} {$i<=9} {incr i} { for {set j 0} {$j<=9} {incr j} { for {set k 0} {$k<=9} {incr k} { set mensaje0309 "Abriendo archivo $i$j$k" update set f($i,$j,$k) [open "$raiz$i$j$k.txt" w] } } } set lista [.0309.uno.i.lb get 0 end] set tot [llength $lista] set nn 0 foreach l $lista { incr nn set fid [open $l r] gets $fid var set np 0 set ffact [expr pow(10,[expr $ndeci-1])] while {![eof $fid]} { incr np set mensaje0309 "Clasificando: Nube $nn de $tot, punto $np" update if {$sol05=="1"} { set x [format "%.[set ndeci]f" [expr round([lindex $var $colX]*2*$ffact)/(2.0*$ffact)]] set y [format "%.[set ndeci]f" [expr round([lindex $var $colY]*2*$ffact)/(2.0*$ffact)]] set z [format "%.[set ndeci]f" [expr round([lindex $var $colZ]*2*$ffact)/(2.0*$ffact)]] set dx [string range [expr round($x*pow(10,[expr [set ndeci]-1]))] end end] set dy [string range [expr round($y*pow(10,[expr [set ndeci]-1]))] end end] set dz [string range [expr round($z*pow(10,[expr [set ndeci]-1]))] end end] } else { set x [format "%.[set ndeci]f" [lindex $var $colX]] set y [format "%.[set ndeci]f" [lindex $var $colY]] set z [format "%.[set ndeci]f" [lindex $var $colZ]] set dx [string range [expr round($x*pow(10,[set ndeci]))] end end] set dy [string range [expr round($y*pow(10,[set ndeci]))] end end] set dz [string range [expr round($z*pow(10,[set ndeci]))] end end] } set nR [lindex $var $colR] set nV [lindex $var $colV] set nA [lindex $var $colA] puts $f($dx,$dy,$dz) "$x $y $z $nR $nV $nA" gets $fid var } close $fid } for {set i 0} {$i<=9} {incr i} { for {set j 0} {$j<=9} {incr j} { for {set k 0} {$k<=9} {incr k} { set mensaje0309 "Cerrando archivo $i$j$k" update close $f($i,$j,$k) } } } # Organizando archivos set np 0 for {set i 0} {$i<=9} {incr i} { for {set j 0} {$j<=9} {incr j} { for {set k 0} {$k<=9} {incr k} { set mensaje0309 "Organizando archivo $i$j$k" update set f($i,$j,$k) [open "$raiz$i$j$k.txt" r] set archivo [read -nonewline $f($i,$j,$k)] close $f($i,$j,$k) file delete "$raiz$i$j$k.txt" set lord [lsort [split $archivo "\n"]] set lpri [lindex $lord 0] set xvj 0 ; set yvj 0 ; set zvj 0 set nrep 0 set sumX 0 ; set sumY 0 ; set sumZ 0 set sumR 0 ; set sumV 0 ; set sumA 0 set lord [lrange $lord 1 end] lappend lord "0 0 0 0 0 0" foreach lll $lord { set xx [lindex $lll 0] set yy [lindex $lll 1] set zz [lindex $lll 2] set nR [lindex $lll 3] set nV [lindex $lll 4] set nA [lindex $lll 5] if {($xvj!=$xx)||($yvj!=$yy)||($zvj!=$zz)} { if {$nrep!="0"} { set mxx [format "%.[set ndeci]f" [expr double($sumX)/$nrep]] set myy [format "%.[set ndeci]f" [expr double($sumY)/$nrep]] set mzz [format "%.[set ndeci]f" [expr double($sumZ)/$nrep]] set mnR [expr int($sumR/$nrep)] set mnV [expr int($sumV/$nrep)] set mnA [expr int($sumA/$nrep)] if {$fdiv=="0"} { if {$nrep>=$nelm} { puts $fsal "$mxx $myy $mzz $mnR $mnV $mnA" incr np set mensaje0309 "Escribiendo punto $np de archivo $i,$j,$k" update } } else { set factor [expr double($nrep)/$nelm] if {$factor>1} {set factor 1} puts $fsal "$mxx $myy $mzz [expr int($mnR*$factor)] [expr int($mnV*$factor)] [expr int($mnA*$factor)]" incr np set mensaje0309 "Escribiendo punto $np de archivo $i,$j,$k" update } } set nrep 1 set sumX $xx set sumY $yy set sumZ $zz set sumR $nR set sumV $nV set sumA $nA set xvj $xx ; set yvj $yy ; set zvj $zz } else { incr nrep set sumX [expr $sumX+$xx] set sumY [expr $sumY+$yy] set sumZ [expr $sumZ+$zz] set sumR [expr $sumR+$nR] set sumV [expr $sumV+$nV] set sumA [expr $sumA+$nA] } } } } } close $fsal set mensaje0309 "Proceso finalizado" }