Revision: 65351
http://sourceforge.net/p/brlcad/code/65351
Author: bob1961
Date: 2015-06-17 14:51:34 +0000 (Wed, 17 Jun 2015)
Log Message:
-----------
Fixed multiple issues that broke grouper. Now calling select with -- to
indicate end of options. Fixed the issue where the group being added to was
getting added to itself.
Modified Paths:
--------------
brlcad/branches/eab/src/tclscripts/mged/grouper.tcl
Modified: brlcad/branches/eab/src/tclscripts/mged/grouper.tcl
===================================================================
--- brlcad/branches/eab/src/tclscripts/mged/grouper.tcl 2015-06-17 14:50:41 UTC
(rev 65350)
+++ brlcad/branches/eab/src/tclscripts/mged/grouper.tcl 2015-06-17 14:51:34 UTC
(rev 65351)
@@ -55,18 +55,31 @@
set size_orig ""
set ae_orig ""
+
+ proc getTreeMembers {_comb} {
+ if {![exists $_comb]} {
+ return ""
+ }
+
+ set i 0
+
+ set tlist {}
+ foreach item [regsub -all {/|/R} [lrange [split [tree -d 1 $_comb]
"\n"] 1 end-1] ""] {
+ lappend tlist [lindex $item 1]
+ incr i
+ }
+
+ return $tlist
+ }
+
+
proc remdup { GroupName } {
- set ItemList [search $GroupName -maxdepth 1]
- set ItemList [lrange $ItemList 1 end]
+ set ItemList [getTreeMembers $GroupName]
set ItemList [lsort -unique $ItemList]
- set found_tmp 0
- while { !$found_tmp } {
- set tmp_grp [expr rand()]
- if { [search -name $tmp_grp] == "" } {
- set found_tmp 1
- }
- }
+ make_name -s 0
+ set tmp_grp [make_name tmp_group]
+
eval g $tmp_grp $ItemList
kill $GroupName
mv $tmp_grp $GroupName
@@ -99,11 +112,19 @@
if { $dimX > 0 } {
# Rectangle was created left-to-right. Select only
# objects completely in the rectangle.
- set objs [select $posX $posY $dimX $dimY]
+# set objs [select $posX $posY $dimX $dimY]
+ if {[catch {select -- $posX $posY $dimX $dimY} objs]} {
+ puts $objs
+ return "no_result"
+ }
} else {
# Rectangle was created right-to-left. Select everything
# completely and partly in the rectangle.
- set objs [select -p $posX $posY $dimX $dimY]
+# set objs [select -p $posX $posY $dimX $dimY]
+ if {[catch {select -p -- $posX $posY $dimX $dimY} objs]} {
+ puts $objs
+ return "no_result"
+ }
}
if { $objs == "" } {
@@ -144,27 +165,15 @@
set size_orig [size]
set ae_orig [ae]
- # Temporarily erase group from display while getting objects in
rectangle"
- after 1 {
- if { [search -name $::Grouper::GroupNameGlobal] != "" } {
- set ::Grouper::erase_status [erase $::Grouper::GroupNameGlobal]
- } else {
- set ::Grouper::erase_status 1
- }
+ if {[exists $::Grouper::GroupNameGlobal]} {
+ erase $::Grouper::GroupNameGlobal
}
+ set ::Grouper::objs [::Grouper::getObjInRectangle]
- # Wait for the group to be erased from the display before we continue
- vwait ::Grouper::erase_status
-
- after 1 {set ::Grouper::objs [::Grouper::getObjInRectangle]}
-
- puts stdout "Selection running ..."
- vwait ::Grouper::objs
-
if { $objs == "invalid_selection" } {
puts stdout "Invalid selection (zero area selection box)."
# highlight in yellow current group
- if { [search -name $GroupName] != "" } {
+ if {[exists $GroupName]} {
e -C255/255/0 $GroupName
center $center_orig
size $size_orig
@@ -176,7 +185,7 @@
if { $objs == "no_result" } {
puts stdout "Nothing selected."
# highlight in yellow current group
- if { [search -name $GroupName] != "" } {
+ if {[exists $GroupName]} {
e -C255/255/0 $GroupName
center $center_orig
size $size_orig
@@ -188,34 +197,36 @@
set objs [lsort -unique $objs]
set tot_obj_in_rect [llength $objs]
- if { [search -name $GroupName] == "" } {
+ if {![exists $GroupName]} {
set grp_obj_list_before ""
set grp_obj_list_len_before 0
} else {
- set grp_obj_list_before [search $GroupName -maxdepth 1]
- set grp_obj_list_len_before [expr [llength $grp_obj_list_before] -
1]
+ set grp_obj_list_before [getTreeMembers $GroupName]
+ set grp_obj_list_len_before [llength $grp_obj_list_before]
}
if { $Boolean == "+" } {
foreach obj $objs {
- g $GroupName $obj
+ #puts "Adding $obj to $GroupName ..."
+ catch {g $GroupName $obj}
}
} else {
foreach obj $objs {
- catch {rm $GroupName $obj} tmp_msg
+ #puts "Removing $obj from $GroupName ..."
+ catch {rm $GroupName $obj}
}
}
- if { ([search -name $GroupName] != "") && ($Boolean == "+") } {
+ if {[exists $GroupName] && $Boolean == "+"} {
remdup $GroupName
}
- if { [search -name $GroupName] == "" } {
+ if {![exists $GroupName]} {
set grp_obj_list_after ""
set grp_obj_list_len_after 0
} else {
- set grp_obj_list_after [search $GroupName -maxdepth 1]
- set grp_obj_list_len_after [expr [llength $grp_obj_list_after] - 1]
+ set grp_obj_list_after [getTreeMembers $GroupName]
+ set grp_obj_list_len_after [llength $grp_obj_list_after]
}
if { $grp_obj_list_len_after > $grp_obj_list_len_before } {
@@ -258,7 +269,7 @@
}
# highlight in yellow current group
- if { [search -name $GroupName] != "" } {
+ if {[exists $GroupName]} {
e -C255/255/0 $GroupName
center $center_orig
size $size_orig
@@ -352,7 +363,7 @@
bind $mged_gui($id,active_dm) <Control-ButtonRelease-2> " winset
$mged_gui($id,active_dm); dm idle; done_grouper"
# highlight in yellow current group
- if { [search -name $GroupName] != "" } {
+ if {[exists $GroupName]} {
e -C255/255/0 $GroupName
center $::Grouper::center_orig
size $::Grouper::size_orig
@@ -385,7 +396,7 @@
bind $mged_gui($id,active_dm) <ButtonRelease-2> ""
# remove yellow highlights from the display
- if { [search -name $::Grouper::GroupNameGlobal] != "" } {
+ if {[exists $::Grouper::GroupNameGlobal]} {
erase $::Grouper::GroupNameGlobal
}
set ::Grouper::GrouperRunning 0
This was sent by the SourceForge.net collaborative development platform, the
world's largest Open Source development site.
------------------------------------------------------------------------------
_______________________________________________
BRL-CAD Source Commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/brlcad-commits
