005 tree
006 bugs
007 driver
+008 nam
+
--- /dev/null
+set Test "TNaming_Builder test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+#################### PRIMITIVE EVOLUTION ####################
+box b 100 200 300
+explode b E
+if {[catch {BuildNamedShape D $TestLab:1 PRIMITIVE b}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build solid as primitive"
+}
+if {[catch {BuildNamedShape D [set TestLab]:1:1 PRIMITIVE b_1}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build edge as alone primitive"
+}
+if {[catch {BuildNamedShape D [set TestLab]:1:1 PRIMITIVE b_1 b_2 b_3}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build several edges as primitive over the old one"
+}
+if {[catch {BuildNamedShape D [set TestLab]:1:2 PRIMITIVE b_4 b_5 b_6}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build several edges as primitive"
+}
+
+#################### GENERATED EVOLUTION ####################
+box b2 200 300 400
+explode b2 F
+if {[catch {BuildNamedShape D $TestLab:2 GENERATED b b2}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build solid as generation"
+}
+if {[catch {BuildNamedShape D [set TestLab]:2:1 GENERATED b_1 b2_1}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as alone generation"
+}
+if {[catch {BuildNamedShape D [set TestLab]:2:2 GENERATED b_2 b2_2 b_2 b2_3 b_3 b2_4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as generation n:m"
+}
+if {[catch {BuildNamedShape D [set TestLab]:2:1 GENERATED b_3 b2_1 b_3 b2_3 b_4 b2_4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as generation n:m to the exists named shape"
+}
+
+#################### MODIFY EVOLUTION ####################
+box b3 300 400 500
+explode b3 F
+if {[catch {BuildNamedShape D $TestLab:3 MODIFY b2 b3}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build solid as modification"
+}
+if {[catch {BuildNamedShape D [set TestLab]:3:1 MODIFY b2_1 b3_1}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as alone modification"
+}
+if {[catch {BuildNamedShape D [set TestLab]:3:2 MODIFY b2_5 b3_2 b2_2 b3_3 b2_3 b3_4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as modification n:m"
+}
+if {[catch {BuildNamedShape D [set TestLab]:3:1 MODIFY b2_3 b3_1 b_3 b3_3 b2_4 b3_4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build face as modification n:m to the exists named shape"
+}
+
+#################### DELETE EVOLUTION ####################
+if {[catch {BuildNamedShape D $TestLab:4:1 DELETE b3_1}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't delete face"
+}
+if {[catch {BuildNamedShape D $TestLab:4:1 DELETE b3_1 b3_4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't delete faces at the same label"
+}
+
+#################### REPLACE EVOLUTION DELETED: TEST REPLACED BY MODIFY ####################
+box b4 100 100 100 300 400 500
+explode b4 F
+if {[catch {BuildNamedShape D [set TestLab]:5 MODIFY b3 b4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build solid as replace"
+}
+if {[catch {BuildNamedShape D [set TestLab]:5:1 MODIFY b3_2 b4_2 b3_3 b4_3}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build faces as replace 2:2"
+}
+
+#################### SELECTED ####################
+if {[catch {BuildNamedShape D [set TestLab]:6 SELECTED b4 b4}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build solid selection"
+}
+if {[catch {BuildNamedShape D [set TestLab]:6:1 SELECTED b4_2 b4_2 b2_5 b2_5}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # Can't build faces selection"
+}
--- /dev/null
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set IsDone 1
+source ${scriptdir}/A1
+
+if {$IsDone == 0} {
+ set Test "TNaming_Iterator test"
+ set IsDone 0
+ set TestError " # Can't test iterators becouse of Builder errors"
+} else {
+
+set Test "TNaming_Iterator test"
+set IsDone 1
+set TestError ""
+
+set labels "1 1:1 1:2 2 2:1 2:2 3 3:1 3:2 4:1 5 5:1 6 6:1"
+set myNewShapesOutput "PRIMITIVE 1 PRIMITIVE 3 PRIMITIVE 3 GENERATED 1 GENERATED 3 GENERATED 3 MODIFY 1 MODIFY 3 MODIFY 3 DELETE 0 MODIFY 1 MODIFY 2 SELECTED 1 SELECTED 2"
+set myOldShapesOutput "PRIMITIVE 0 PRIMITIVE 0 PRIMITIVE 0 GENERATED 1 GENERATED 3 GENERATED 3 MODIFY 1 MODIFY 3 MODIFY 3 DELETE 2 MODIFY 1 MODIFY 2 SELECTED 1 SELECTED 2"
+set myAllNewShapesOutput "3 14 2 2 3 5 1 1 2 0 0 0 0 2"
+set myAllOldShapesOutput "0 0 0 1 3 3 2 6 5 0 3 5 3 2"
+
+set r ""
+for {set i 0} {[lindex $labels $i]!=""} {incr i} {
+ set lab [set TestLab]:[lindex $labels $i]
+
+#################### Iterator ####################
+ if {[catch {GetNewShapes D $lab}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # GetNewShapes at label $lab"
+ } else {
+ set r [GetNewShapes D $lab]
+ set oldr "[lindex $myNewShapesOutput [expr $i*2]] [lindex $myNewShapesOutput [expr $i*2+1]]"
+ if { $r != $oldr } {
+ set IsDone 0
+ set TestError "$TestError # GetNewShapes at label $lab: need $oldr, but got $r"
+ }
+ }
+
+#################### Iterator ####################
+ if {[catch {GetOldShapes D $lab}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # GetOldShapes at label $lab"
+ } else {
+ set r [GetOldShapes D $lab]
+ set oldr "[lindex $myOldShapesOutput [expr $i*2]] [lindex $myOldShapesOutput [expr $i*2+1]]"
+ if { $r != $oldr } {
+ set IsDone 0
+ set TestError "$TestError # GetOldShapes at label $lab: need $oldr, but got $r"
+ }
+ }
+
+#################### NewShapesIterator ####################
+ if {[catch {GetAllNewShapes D $lab}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # GetAllNewShapes at label $lab"
+ } else {
+ set r [GetAllNewShapes D $lab]
+ set oldr "[lindex $myAllNewShapesOutput $i]"
+ if { $r != $oldr } {
+ set IsDone 0
+ set TestError "$TestError # GetAllNewShapes at label $lab: need $oldr, but got $r"
+ }
+ }
+
+#################### OldShapesIterator ####################
+ if {[catch {GetAllOldShapes D $lab}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # GetAllOldShapes at label $lab"
+ } else {
+ set r [GetAllOldShapes D $lab]
+ set oldr "[lindex $myAllOldShapesOutput $i]"
+ if { $r != $oldr } {
+ set IsDone 0
+ set TestError "$TestError # GetAllOldShapes at label $lab: need $oldr, but got $r"
+ }
+ }
+
+}
+
+#################### SameShapesIterator && NewShapesIterator ####################
+set mySame "1 2 2 1 3 2 1 2 1 1 2 1 3 2 1 3 4 3 4 1 2"
+
+GetAllNewShapes D [set TestLab]:1:1 o
+GetAllOldShapes D [set TestLab]:3:1 u
+
+set shapes "b o_1_1 o_1_2 o_1_3 o_1_4 o_1_5 o_1_6 o_1_7 o_1_8 o_2_1 o_2_2 o_2_3 o_2_4 o_2_5 o_2_6 u_3_1 u_3_2 u_1_1 u_1_2 u_2_1 u_2_2"
+
+for {set i 0} {[lindex $shapes $i]!=""} {incr i} {
+ if {[catch {GetSameShapes D [lindex $shapes $i]}] == 1} {
+ set IsDone 0
+ set TestError "$TestError # GetSameShapes D for [lindex $shapes $i]"
+ } else { if {[lindex $mySame $i] != [llength [GetSameShapes D [lindex $shapes $i]]]} {
+ set IsDone 0
+ set TestError "$TestError # GetSameShapes D for [lindex $shapes $i]: \
+ [lindex $mySame $i] != [llength [GetSameShapes D [lindex $shapes $i]]]"
+ }
+ }
+}
+
+set myr "u_2_1 o_2_1 u_1_2 u_3_2 u_1_1 u_3_1 u_1_1 o_2_4 u_1_1 o_1_4 u_3_1 o_2_4 u_3_1 o_1_4 o_2_6 o_1_6 o_2_5 o_1_5 o_2_5 o_1_2 o_2_4 o_1_4 o_2_3 o_1_8 o_2_2 o_1_7 o_1_5 o_1_2"
+
+for {set i 0} {[lindex $myr $i]!=""} {incr i 2} {
+ if {[IsSameShapes [lindex $myr $i] [lindex $myr [expr $i+1]]]!=1} {
+ set IsDone 0
+ set TestError "$TestError # [lindex $myr $i] and [lindex $myr [expr $i+1]] not equal"
+ }
+}
+
+for {set i 1} {[lindex $shapes $i]!=""} {incr i} {
+ for {set j 0} {$j < $i} {incr j} {
+ if {[IsSameShapes [lindex $shapes $i] [lindex $shapes $j]]==1} {
+ set r "[lindex $shapes $i] [lindex $shapes $j]"
+ set yes 0
+ for {set k 0} {[lindex $myr $k]!=""} {incr k 2} {
+ if {[lindex $myr $k] == [lindex $r 0]} {if {[lindex $myr [expr $k+1]] == [lindex $r 1]} {set yes 1}}
+ if {[lindex $myr $k] == [lindex $r 1]} {if {[lindex $myr [expr $k+1]] == [lindex $r 0]} {set yes 1}}
+ }
+ if {$yes == 0} {
+ set IsDone 0
+ set TestError "$TestError # $r not equal"
+ }
+ }
+ }
+}
+
+}
--- /dev/null
+set Test "TNaming_Tool test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+#################### make triangle face ####################
+vertex v1 0 0 0
+vertex v2 0 100 0
+vertex v3 100 0 0
+line l1 0 0 0 0 1 0
+line l2 0 100 0 1 -1 0
+line l3 100 0 0 -1 0 0
+mkedge e1 l1 v1 v2
+mkedge e2 l2 v2 v3
+mkedge e3 l3 v3 v1
+wire w e1 e2 e3
+plane pl 0 0 1
+mkface f pl w
+
+#################### load it to the DF ####################
+BuildNamedShape D [set TestLab]:1 PRIMITIVE f
+for {set a 1} {$a <= 3} {incr a} {
+ set lab [set TestLab]:1:$a
+ BuildNamedShape D $lab PRIMITIVE e$a
+}
+
+#################### make prism at face and load ####################
+prism p f 0 0 100
+BuildNamedShape D [set TestLab]:2 PRIMITIVE p
+
+explode p F
+set needgenerate ""
+set primitivelabel 2
+for {set a 1} {$a <= 5} {incr a} {
+ set ex [explode p_$a E]
+ if {[llength $ex] == 4} {
+ for {set i 1} {$i <= 3} {incr i} {
+ for {set j 1} {$j <= 3} {incr j} {
+ if {[IsSameShapes e$i [lindex $ex $j]]==1} {
+ if {[string compare $needgenerate ""] == 0} {set needgenerate "e$i p_$a"} else {set needgenerate "$needgenerate e$i p_$a"}
+ }
+ }
+ }
+ } else {
+ BuildNamedShape D [set TestLab]:2:$primitivelabel PRIMITIVE p_$a
+ incr primitivelabel
+ }
+}
+BuildNamedShape D [set TestLab]:2:1 GENERATED [lindex $needgenerate 0] [lindex $needgenerate 1] [lindex $needgenerate 2] [lindex $needgenerate 3] [lindex $needgenerate 4] [lindex $needgenerate 5]
+
+#################### make box, cut prism, load ####################
+box b 0 0 20 100 100 20
+explode b F
+BuildNamedShape D [set TestLab]:3 PRIMITIVE b
+for {set a 1} {$a <= 6} {incr a} {
+ BuildNamedShape D [set TestLab]:3:$a PRIMITIVE b_$a
+}
+
+cut c p b
+BuildNamedShape D [set TestLab]:4 MODIFY p c
+explode c F
+set needgenerate ""
+set needmodify ""
+set py ""
+set px ""
+set pxy ""
+set p0 ""
+set pz ""
+
+for {set i 1} {$i<=5} {incr i} {
+ set center [CenterOfShape p_$i]
+ if {[lindex $center 0] == 50} {
+ if {[lindex $center 1] == 50} {set pxy p_$i} else {set px p_$i}
+ } else {if {[lindex $center 1] == 50} {set py p_$i}}
+}
+for {set i 1} {$i <= 10} {incr i} {
+ set center [CenterOfShape c_$i]
+ if {[lindex $center 0] == 50} {
+ if {[lindex $center 1] == 50} {set needgenerate "$pxy c_$i $needgenerate"} else {
+ set needgenerate "$px c_$i $needgenerate"}
+ } else {if {[lindex $center 1] == 50} {set needgenerate "$py c_$i $needgenerate"} else {
+ if {[lindex $center 2] == 20} {set needmodify "b_5 c_$i $needmodify"}
+ if {[lindex $center 2] == 40} {set needmodify "b_6 c_$i $needmodify"}
+ }
+ }
+}
+BuildNamedShape D [set TestLab]:4:1 MODIFY [lindex $needgenerate 0] [lindex $needgenerate 1] [lindex $needgenerate 2] [lindex $needgenerate 3] [lindex $needgenerate 4] [lindex $needgenerate 5] [lindex $needgenerate 6] [lindex $needgenerate 7] [lindex $needgenerate 8] [lindex $needgenerate 9] [lindex $needgenerate 10] [lindex $needgenerate 11]
+BuildNamedShape D [set TestLab]:4:2 GENERATED [lindex $needmodify 0] [lindex $needmodify 1] [lindex $needmodify 2] [lindex $needmodify 3] b_1 b_1
+
+#################### test TNamig_Tool::NamedShape commmand ####################
+set names "e1 e2 e3 p p_1 p_2 p_3 p_5 b b_1 b_2 b_3 b_4 b_5 b_6 c c_1 c_2 c_3 c_5 c_6 c_7 c_8 c_9 c_10"
+set entities "1:1 1:2 1:3 2 2:1 2:1 2:1 2:3 3 3:1 3:2 3:3 3:4 3:5 3:6 4 4:1 4:1 4:2 4:1 4:1 4:1 4:2 2:3 4:1"
+
+for {set i 0} {[string compare [lindex $names $i] ""] != 0} {incr i} {
+# puts "name = [lindex $names $i], entity = [lindex $entities $i]"
+ set r [NamedShape D [lindex $names $i]]
+ if {[string compare $r "[set TestLab]:[lindex $entities $i]"] != 0} {
+# puts "error"
+ set IsDone 0
+ set TestError "$TestError # NamedShape: need [set TestLab]:[lindex $entities $i] label, got $r"
+ }
+}
+#################### test TNaming_Tool::CurrentShape command ####################
+set entities "1 1:1 1:2 1:3 2 2:1 2:2 2:3 3 3:1 3:2 3:3 3:4 3:5 3:6 4 4:1 4:2"
+# rem: f p_4 c_4 are same, p_5 c_9 are same
+set names "c_4 e1 e2 e3 c # p_4 c_9 b b_1 b_2 b_3 b_4 b_5 b_6 c # #"
+
+for {set i 0} {[string compare [lindex $entities $i] ""] != 0} {incr i} {
+ CurrentShape D "[set TestLab]:[lindex $entities $i]" r
+ if {[string compare [lindex $names $i] "#"] == 0} {
+ set a [explode r F]
+ if {[expr {([llength $a]!=6 && ($i==5 || $i==16)) || ([llength $a]!=2 && $i==17)}]} {
+ set IsDone 0
+ set TestError "$TestError # CurrentShape shape at [set TestLab]:[lindex $entities $i] has bad compound"
+ }
+ } else {
+ if {[IsSameShapes r [lindex $names $i]]!=1} {
+ set IsDone 0
+ set TestError "$TestError # CurrentShape shape at [set TestLab]:[lindex $entities $i] and [lindex $names $i] is not same"
+ }
+ }
+}
+
+#################### test TNaming_Tool::GetShape command ####################
+set entities "1 1:1 1:2 1:3 2 2:1 2:2 2:3 3 3:1 3:2 3:3 3:4 3:5 3:6 4 4:1 4:2"
+# rem: f p_4 c_4 are same, p_5 c_9 are same
+set names "c_4 e1 e2 e3 p # p_4 c_9 b b_1 b_2 b_3 b_4 b_5 b_6 c # #"
+
+for {set i 0} {[string compare [lindex $entities $i] ""] != 0} {incr i} {
+ GetShape D "[set TestLab]:[lindex $entities $i]" r
+ if {[string compare [lindex $names $i] "#"] == 0} {
+ set a [explode r F]
+ if {[expr {([llength $a]!=3 && $i==5) || ([llength $a]!=6 && $i==16) || ([llength $a]!=2 && $i==17)}]} {
+ set IsDone 0
+ set TestError "$TestError # GetShape shape at [set TestLab]:[lindex $entities $i] has bad compound"
+ }
+ } else {
+ if {[IsSameShapes r [lindex $names $i]]!=1} {
+ set IsDone 0
+ set TestError "$TestError # GetShape shape at [set TestLab]:[lindex $entities $i] and [lindex $names $i] is not same"
+ }
+ }
+}
--- /dev/null
+set Test "TNaming_Translator test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+#################### make box and it's copy ####################
+box b 12 13 14
+set cb [CopyShape b]
+
+explode b F
+if {[llength [explode $cb F]] != 6} {
+ set IsDone 0
+ set TestError "$TestError # Copy of box has bad number of faces"
+}
+
+if {[IsSameShapes b $cb]==1} {
+ set IsDone 0
+ set TestError "$TestError # Box and it's copy are same"
+}
+for {set i 1} {$i <= 6} {incr i} {
+ set comp 0
+ for {set j 1} {$j <= 6} {incr j} {
+ if {[IsSameShapes b_$i [set cb]_$j]==1} {
+ set IsDone 0
+ set TestError "$TestError # Subface of copy of box [set cb]_$j] and face b_$i are same"
+ }
+ if {[CenterOfShape b_$i] == [CenterOfShape [set cb]_$j]} {incr comp}
+ }
+ if {$comp != 1} {
+ set IsDone 0
+ set TestError "$TestError # face b_$i has no twin in the copy subshapes set"
+ }
+}
+
+#################### translation testing ####################
+if {[CenterOfShape b] != [CenterOfShape $cb]} {
+ set IsDone 0
+ set TestError "$TestError # shapes has different location"
+}
+ttranslate b 50 40 30
+if {[CenterOfShape b] == [CenterOfShape $cb]} {
+ set IsDone 0
+ set TestError "$TestError # shapes has same location after retranslation"
+}
+set cb [CopyShape b]
+if {[CenterOfShape b] != [CenterOfShape $cb]} {
+ set IsDone 0
+ set TestError "$TestError # shapes has different location after retranslation"
+}
--- /dev/null
+#################### select shape and check selection procedure ####################
+proc Select {lab shape context} {
+ global D IsDone TestError
+ upvar 1 $shape myshape $context mycontext
+ set res ""
+ if {[string compare $context ""] == 0} {
+ if {[catch {set res [SelectShape D $lab myshape]}]} {
+ set IsDone 0
+ set TestError "$TestError # SelectShape bad result for args: $lab myshape"
+ }
+ } else {
+ if {[catch {set res [SelectShape D $lab myshape mycontext]}]} {
+ set IsDone 0
+ set TestError "$TestError # SelectShape bad result for args: $lab myshape"
+ }
+ }
+ return [CenterOfShape myshape]
+}
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set IsDone 1
+source ${scriptdir}/A3
+set Test "TNaming_Selector test"
+if {$IsDone == 0} {
+ set TestError " # Can't test iterators becouse of Tool errors: # $TestError"
+} else {
+
+#################### selection and checking shapes ####################
+
+### IDENTIFY NAMING
+set res1 [Select "[set TestLab]:10:1" f ""]
+set res2 [Select "[set TestLab]:10:2" e1 f]
+set res3 [Select "[set TestLab]:10:3" e2 ""]
+### INTERSECTION NAMING (complex : with GENERATION and IDENTITY)
+set res4 [Select "[set TestLab]:10:4" v1 "f"]
+explode b E
+set res5 [Select "[set TestLab]:10:5" b_1 "b"]
+puts [dump $res5]
+explode b V
+set res6 [Select "[set TestLab]:10:6" b_1 "b"]
+explode c E
+# labels 7-24
+
+if {0} {
+
+for {set i 1} {$i <= 18} {incr i} {
+ set res[expr $i+6] [Select "[set TestLab]:10:[expr $i+6]" c_$i "c"]
+}
+explode c F
+# labels 25-32
+for {set i 1} {$i <= 8} {incr i} {
+ set res[expr $i+24] [Select "[set TestLab]:10:[expr $i+24]" c_$i "c"]
+}
+#################### simple GENERATION naming ####################
+#explode p F
+##labels 33-35
+#for {set i 1} {$i <= 3} {incr i} {
+# set res[expr $i+32] [Select "[set TestLab]:10:[expr $i+32]" p_$i "p"]
+#}
+explode c So
+set res33 [Select "[set TestLab]:10:33" c_1 c]
+set res34 [Select "[set TestLab]:10:34" c_2 c]
+####################### simple MODIFUNTIL naming ####################
+set res35 [Select "[set TestLab]:10:35" c ""]
+
+#################### solve selection checking with empty valid map ####################
+for {set i 1} {$i <= 35} {incr i} {
+ if {[catch {SolveSelection D [set TestLab]:10:$i}]} {
+ set IsDone 0
+ set TestError "$TestError # SolveSelection failed for label [set TestLab]:10:$i"
+ } else {
+ GetShape D [set TestLab]:10:$i r
+ if {[string compare [CenterOfShape r] [set res$i]] != 0} {
+ set IsDone 0
+ set TestError "$TestError # SolveSelection result not same for lab $i : [CenterOfShape r] and [set res$i]"
+ }
+ }
+}
+#################### with setted valid map ####################
+
+}
+
+puts "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+
+if {[catch {SolveSelection D [set TestLab]:10:4 [set TestLab]:1:1}] == 0} {
+ set IsDone 0
+ set TestError "$TestError # SolveSelection is not failed with deficit of valid map (label [set TestLab]:10:4)"
+}
+#if {[catch {SolveSelection D [set TestLab]:10:4 [set TestLab]:1:1 [set TestLab]:1:3}] == 1} {
+# set IsDone 0
+# set TestError "$TestError # SolveSelection failed for good valid map (label [set TestLab]:10:4)"
+#}
+
+}
--- /dev/null
+set Test "Primitives naming test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set myLab [set TestLab]:1
+set myNameLab [set TestLab]:101
+
+#################### box ####################
+NameBox D $myLab 10 20 30
+Checking "Box as solid"
+
+#################### cylinder: cutted and full ####################
+NameCylinder D $myLab 10 20 1 1
+Checking "Cutted cylinder as solid"
+
+NameCylinder D $myLab 20 30 0 1
+Checking "Cylinder as solid"
+
+NameCylinder D $myLab 15 15 0 0
+Checking "Cylinder as shell"
+
+#################### sphere: cutted and full ####################
+NameSphere D $myLab 20 10 15 5 0.1 0.2 0.3 1
+Checking "Cutted sphere as solid"
+
+NameSphere D $myLab 5 15 15 5 0.1 0.2 0.3 0
+Checking "Cutted sphere as shell"
+
+NameSphere D $myLab 10 5 15 5 0 0 0 1
+Checking "Sphere as solid"
+
+NameSphere D $myLab 15 20 15 5 0 0 0 0
+Checking "Sphere as shell"
+
+#################### import brep shapes from "forimport" directory ####################
+
+erase
+set shapes_list {compound.brep compsol.brep HV_O1.brep HV_T1.brep HW_T0.brep HW_T3.brep SH_O.brep solid1.brep}
+foreach shape $shapes_list {
+ restore [locate_data_file ${shape}] s
+ disp s
+ fit
+ NameImportShape D $myLab s
+ erase
+}
+
+# if {$IsDone==0} {puts "not done"} else {puts done}
--- /dev/null
+set Test "Primitives at selection naming test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set myLab [set TestLab]:1
+set myNameLab [set TestLab]:105
+
+#################### prepare source shapes ####################
+# label #1 - box
+NameBox D $myLab 10 20 30
+GetShape D $myLab b
+explode b F
+NextLabel myLab
+
+# label #2 - cutted cylinder
+NameCylinder D $myLab 10 20 1 1
+NextLabel myLab
+
+# label #3 - full cylinder
+NameCylinder D $myLab 20 30 0 1
+NextLabel myLab
+
+# label #4 - spere
+NameSphere D $myLab 10 5 15 5 0 0 0 1
+NextLabel myLab
+
+#################### prism: infinite, at box and cylinder faces, at closed wire ####################
+
+### MPV:naming is not allowed for infinity prism
+#SelectShape D $myLab b_1 b
+#set PrevLab $myLab
+#NextLabel myLab
+#NamePrism D $myLab $PrevLab 10 1 1 1 1
+#Checking "NamePrism infinity"
+
+
+SelectShape D $myLab b_2 b
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NamePrism D $myLab $PrevLab 10 1 1 1
+Checking NamePrism
+
+GetShape D [set TestLab]:3 c
+explode c F
+set vv [explode c_1 V]
+set cf c_1
+if {[llength $vv] > 1} {
+ set vv [explode c_2 V]
+ set cf c_2
+}
+
+SelectShape D $myLab $cf c
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NamePrism D $myLab $PrevLab 10 1 1 1
+Checking "NamePrism at circle"
+
+GetShape D [set TestLab]:2 cutc
+explode cutc F
+
+set cc [explode cutc_2 W]
+SelectShape D $myLab $cc cutc
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NamePrism D $myLab $PrevLab 10 1 1 1
+Checking "NamePrism at wire"
+
+#################### revolution: box face and cylinder closed wire ####################
+GetShape D [set TestLab]:1 b
+explode b F
+SelectShape D $myLab b_2 b
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+explode b_2 E
+set cb [CopyShape b_2_1]
+ttranslate $cb 30 30 0
+BuildNamedShape D $myLab SELECTION $cb $cb
+set Axis $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameRevol D $myLab $PrevLab $Axis 10
+Checking "NameRevol at box face"
+
+GetShape D [set TestLab]:2 cutc
+explode cutc W
+NameImportShape D $myLab cutc_1
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+explode cutc_1 E
+set cc [CopyShape cutc_1_2]
+ttranslate $cc 20 40 0
+BuildNamedShape D $myLab SELECTION $cc $cc
+set Axis $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameRevol D $myLab $PrevLab $Axis
+Checking "NameRevol at cylinder face"
+
+#################### fillet: at box wire, cylinder (not lateral) edge ####################
+GetShape D [set TestLab]:1 b
+explode b F
+explode b_3 W
+SelectShape D $myLab b_3_1 b
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameFillet D $myLab [set TestLab]:1 $PrevLab 3
+Checking "NameFillet at box wire"
+
+GetShape D [set TestLab]:3 c
+explode c E
+set ce c_1
+if {[llength [explode $ce V]] > 1} {set ce c_2}
+SelectShape D $myLab $ce c
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameFillet D $myLab [set TestLab]:3 $PrevLab 3
+Checking "NameFillet at cylinder edge"
+
+#################### chamfer: at cutted cylinder top wire, cylinder (not lateral) edge ####################
+GetShape D [set TestLab]:2 cutc
+set cutf [explode cutc F]
+set cuttop cutc_1
+for {set i 1} {[lindex $cutf $i]!=""} {incr i} {
+ if {[lindex [CenterOfShape [lindex $cutf $i]] 2] > [lindex [CenterOfShape $cuttop] 2]} {set cuttop [lindex $cutf $i]}
+}
+SelectShape D $myLab $cuttop cutc
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+set cutw [explode $cuttop W]
+SelectShape D $myLab $cutw cutc
+set WireLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameChamfer D $myLab [set TestLab]:2 $WireLab $PrevLab 2 3
+Checking "NameChamfer at cutted cylinder wire"
+
+GetShape D [set TestLab]:3 c
+set cf [explode c F]
+set cbottom c_1
+for {set i 1} {[lindex $cf $i]!=""} {incr i} {
+ if {[lindex [CenterOfShape [lindex $cf $i]] 2] < [lindex [CenterOfShape $cbottom] 2]} {set cbottom [lindex $cf $i]}
+}
+SelectShape D $myLab $cbottom c
+set PrevLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+set ce [explode $cbottom E]
+SelectShape D $myLab $ce c
+set WireLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameChamfer D $myLab [set TestLab]:3 $WireLab $PrevLab 4 3
+Checking "NameChamfer at cylinder bottom edge"
+
--- /dev/null
+puts "TODO OCC12345 ALL: An exception was caught"
+puts "TODO OCC12345 ALL: \\*\\* Exception \\*\\*.*"
+puts "TODO OCC12345 ALL: TEST INCOMPLETE"
+
+set Test "Boolean operations naming test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set myLab [set TestLab]:1
+set myNameLab [set TestLab]:105
+
+#################### four boxes: fuse, cut, common, intersection ####################
+NameBox D $myLab 20 30 25
+GetShape D $myLab b1
+set Box1Lab $myLab
+NextLabel myLab
+box b2 10 15 10 15 20 25
+BuildNamedShape D $myLab PRIMITIVE b2
+set Box2Lab $myLab
+set bf [explode b2 F]
+for {set i 0} {[lindex $bf $i]!=""} {incr i} {
+ BuildNamedShape D [set myLab]:[expr $i+1] PRIMITIVE [lindex $bf $i]
+}
+NextLabel myLab
+box b3 20 25 30 20 20 20
+BuildNamedShape D $myLab PRIMITIVE b3
+set Box3Lab $myLab
+set bf [explode b3 F]
+for {set i 0} {[lindex $bf $i]!=""} {incr i} {
+ BuildNamedShape D [set myLab]:[expr $i+1] PRIMITIVE [lindex $bf $i]
+}
+NextLabel myLab
+box b4 15 10 20 20 20 20
+#box b4 5 5 5 20 20 20
+BuildNamedShape D $myLab PRIMITIVE b4
+set Box4Lab $myLab
+set bf [explode b4 F]
+for {set i 0} {[lindex $bf $i]!=""} {incr i} {
+ BuildNamedShape D [set myLab]:[expr $i+1] PRIMITIVE [lindex $bf $i]
+}
+NextLabel myLab
+
+NameFuse D $myLab b1 b2
+set FuseLab $myLab
+Checking "Two boxes fuse"
+GetShape D $FuseLab FuseShape
+GetShape D $Box3Lab b3
+NameCut D $myLab FuseShape b3
+set CutLab $myLab
+Checking "Fuse result and box cut"
+GetShape D $CutLab CutShape
+GetShape D $Box4Lab b4
+NameCommon D $myLab b4 CutShape
+set CommonLab $myLab
+Checking "Fuse cut result and box common"
+GetShape D $CommonLab CommonShape
+GetShape D $Box2Lab b2
+#NameIntersection D $myLab CommonShape b2
+#Checking "Fuse cut common result and box intersection"
+
+#################### limit operation ####################
+NameBox D $myLab 20 10 30
+GetShape D $myLab b1
+NextLabel myLab
+NextLabel myNameLab
+vertex v1 -10 -10 15
+vertex v2 -10 100 15
+vertex v3 100 -10 15
+line l1 -10 -10 15 0 1 0
+line l2 -10 100 15 1 -1 0
+line l3 100 -10 15 -1 0 0
+mkedge e1 l1 v1 v2
+mkedge e2 l2 v2 v3
+mkedge e3 l3 v3 v1
+wire w e1 e2 e3
+plane pl 0 0 15 0 0 15
+mkface f pl w
+NameImportShape D $myLab f
+NextLabel myLab
+NextLabel myNameLab
+NameLimit D $myLab b1 f
+Checking "Limit naming (box and planar face)"
+
+#################### Intersection operation ####################
+restore [locate_data_file Int_Sh1_3.brep] Obj1
+NameImportShape D $myLab Obj1
+NextLabel myLab
+NextLabel myNameLab
+
+restore [locate_data_file Int_Sh2_3.brep] Tool1
+NameImportShape D $myLab Tool1
+NextLabel myLab
+NextLabel myNameLab
+
+NameIntersection D $myLab Obj1 Tool1
+Checking "Two opened shells intersection"
+
+restore [locate_data_file Int_shell1.brep] Obj2
+NameImportShape D $myLab Obj2
+NextLabel myLab
+NextLabel myNameLab
+
+restore [locate_data_file Int_Sh1_3.brep] Tool2
+NameImportShape D $myLab Tool2
+NextLabel myLab
+NextLabel myNameLab
+
+NameIntersection D $myLab Obj2 Tool2
+Checking "Two shells intersection (one opened)"
+
+
+restore [locate_data_file Int_shell.brep] Obj3
+NameImportShape D $myLab Obj3
+NextLabel myLab
+NextLabel myNameLab
+
+restore [locate_data_file Int_wire.brep] Tool3
+NameImportShape D $myLab Tool3
+NextLabel myLab
+NextLabel myNameLab
+
+NameIntersection D $myLab Obj3 Tool3
+Checking "Shell and wire intersection"
+
+#################### bug with premature "IDENTIFY" naming: one cylinder cut another in the middle ####################
+NameCylinder D $myLab 20 100 0 1
+GetShape D $myLab c1
+NextLabel myLab
+NextLabel myNameLab
+pcylinder c2 20 30
+ttranslate c2 0 0 30
+BuildNamedShape D $myLab PRIMITIVE c2
+set cf [explode c2 F]
+for {set i 0} {[lindex $cf $i]!=""} {incr i} {
+ BuildNamedShape D [set myLab]:[expr $i+1] PRIMITIVE [lindex $cf $i]
+}
+NextLabel myLab
+NextLabel myNameLab
+NameCut D $myLab c1 c2
+Checking "Cut of two cylinders ( = = )"
+
+#################### bug with MODIFUNTIL conceit: three cutted cylinders ####################
+NameCylinder D $myLab 20 100 0 1
+GetShape D $myLab c1
+NextLabel myLab
+NextLabel myNameLab
+NameCylinder D $myLab 10 100 0 1
+GetShape D $myLab c2
+NextLabel myLab
+NextLabel myNameLab
+pcylinder c3 20 30
+ttranslate c3 0 0 30
+BuildNamedShape D $myLab PRIMITIVE c3
+set cf [explode c3 F]
+for {set i 0} {[lindex $cf $i]!=""} {incr i} {
+ BuildNamedShape D [set myLab]:[expr $i+1] PRIMITIVE [lindex $cf $i]
+}
+NextLabel myLab
+NextLabel myNameLab
+NameCut D $myLab c1 c2
+GetShape D $myLab CutShape
+NextLabel myLab
+NextLabel myNameLab
+NameCut D $myLab CutShape c3
+#Checking "Cut of three cylinders ( 0=) 0=) )"
+
+# mpv: BRepNaming_Fillet is not ready now for this test
+#################### bug with FILTERBYNEIGHBOURGS confusion: cylinder, cutted by shpere + fillet ####################
+#NameCylinder D $myLab 20 100 0 1
+#GetShape D $myLab c1
+#NextLabel myLab
+#NextLabel myNameLab
+#psphere s 20
+#ttranslate s 30 20 50
+#BuildNamedShape D $myLab PRIMITIVE s
+#explode s F
+##name only face of sphere: it's enoth for this example
+#BuildNamedShape D [set myLab]:1 PRIMITIVE s_1
+#NextLabel myLab
+#NextLabel myNameLab
+#NameCut D $myLab c1 s
+#set CutLab $myLab
+#GetShape D $myLab CutShape
+#NextLabel myLab
+#NextLabel myNameLab
+#set se [explode CutShape E]
+#set CutEdge CutShape_1
+#set minX [lindex [CenterOfShape CutShape_1] 0]
+#for {set i 1} {[lindex $se $i]!=""} {incr i} {
+# set minC [lindex [CenterOfShape [lindex $se $i]] 0]
+# if {$minC < $minX} {
+# set minX $minC
+# set CutEdge [lindex $se $i]
+# }
+#}
+#SelectShape D $myLab $CutEdge CutShape
+#set EdgeLab $myLab
+#NextLabel myLab
+#NextLabel myNameLab
+#NameFillet D $myLab $CutLab $EdgeLab 10
+#Checking "Fillet at cut cylinder by sphere ( \[( )"
--- /dev/null
+set Test "Specific operations naming test"
+set IsDone 1
+set TestError ""
+
+if {[catch {set TestLab}] == 1} {
+ NewDocument D
+ set TestLab 0:1
+}
+
+set myLab [set TestLab]:1
+set myNameLab [set TestLab]:100
+
+#################### two boxes glueing ####################
+NameBox D $myLab 20 30 40
+set Box1Lab $myLab
+NextLabel myLab
+NextLabel myNameLab
+box b 20 10 20 20 30 40
+NameImportShape D $myLab b
+set Box2Lab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameGlue D $myLab $Box1Lab $Box2Lab
+Checking "Two boxes glueing"
+
+#################### 3-faces shell and 2-faces shell glueing ####################
+restore [locate_data_file HH_O.brep] object
+restore [locate_data_file HH_T.brep] tool
+global object
+NameImportShape D $myLab object
+set ObjectLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+global tool
+NameImportShape D $myLab tool
+set ToolLab $myLab
+NextLabel myLab
+NextLabel myNameLab
+NameGlue D $myLab $ObjectLab $ToolLab
+Checking "Two shells glueing"
+
+#################### import box with broken edges and internal vertex at the face ####################
+restore [locate_data_file brockenedgesbox.brep] bbox
+NameImportShape D $myLab object
+Checking "Box with broken edges"
--- /dev/null
+# File : begin
+if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
+ pload TOPTEST
+ pload VISUALIZATION
+}
+pload XDE
+pload QAcommands
+
+if { [info exists imagedir] == 0 } {
+ set imagedir .
+}
+if { [info exists test_image] == 0 } {
+ set test_image photo
+}
+
+set scriptdir [file dirname [info script]]
+
+set mistake 0
+
+#################### procedure GetDigit returns digit (cutted) from string ####################
+proc GetDigit {s} {
+ set res ""
+ for {set a 0} {$a < [string length $s]} {incr a} {
+ if {[string index $s $a]>="0" && [string index $s $a]<="9"} {
+ set res [set res][string index $s $a]
+ } else {
+ if {[string index $s $a]=="e" || [string index $s $a]=="-"} {
+ set res [set res][string index $s $a]
+ } else {return $res}
+ } else {return $res}
+ }
+ return $res
+}
+
+#################### procedure ShapeCenter returns (three coords string) center of given shape
+proc ShapeCenter {s} {
+puts $s
+ global $s
+ return [CenterOfShape $s]
+# set ss [explode $s V]
+# if {[llength $ss] == 0} {set ss $s}
+# set x 0
+# set y 0
+# set z 0
+# for {set a 0} {[lindex $ss $a] != ""} {incr a} {
+# set dmp [dump [lindex $ss $a]]
+# set fromindex [lsearch $dmp Elementary]
+# if {$fromindex != -1} {
+# set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+6]]]]
+# set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+12]]]]
+# set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+18]]]]
+# }
+# set fromindex [lsearch $dmp "3D"]
+# set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+2]]]]
+# set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+3]]]]
+# set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+4]]]]
+# }
+# set x [expr $x/[llength $ss]]
+# set y [expr $y/[llength $ss]]
+# set z [expr $z/[llength $ss]]
+# return "$x $y $z"
+}
+
+#################### procedure IsSame returns true, if given shapes has same TShapes ####################
+proc IsSame {s1 s2} {
+ global $s1 $s2
+puts "$s1 $s2"
+ if {[IsSameShapes $s1 $s2] == 1} {return 1}
+ return 0
+#
+# set d1 [dump $s1]
+# set d2 [dump $s1]
+# if {[llength $d1]<10 || [llength $d2]<10} {
+# return 0
+# }
+#
+# if {[lindex [dump $s1] 28] == [lindex [dump $s2] 28]} {
+# if {[lindex [dump $s1] 29] == [lindex [dump $s2] 29]} {return 1}
+# }
+# return 0
+}
+
+#################### procedure NextLabel set lab as next label of lab at this level ####################
+proc NextLabel {lab} {
+ upvar 1 $lab l
+ set i [string last ":" "[set l]"]
+ if {$i == -1} {set l [expr [set l]+1]} else {
+ set l [string range [set l] 0 $i][expr 1+[string range [set l] [expr $i+1] [string length [set l]]]]
+ }
+}
+
+#################### checking the naming at myLab label ( tests at myNameLab label ) ####################
+#################### show errors, increments working labels ####################
+proc Checking {Name} {
+ global D IsDone TestError
+ upvar 1 myLab l1 myNameLab l2
+
+ set bad ""
+ if {[catch {set bad [CheckNaming D $l2 1 Label $l1 1 1 1]}]} {
+ set IsDone 0
+ set TestError "$TestError # $Name naming failed at label $l2 with exception"
+ } else {
+ if {[llength $bad] > 0} {
+ set IsDone 0
+ set TestError "$TestError # $Name naming failed at label $l2 sublabels $bad"
+ }
+ }
+ NextLabel l1
+ NextLabel l2
+}
--- /dev/null
+puts " "
+puts "----------------------------------------------------------------------------------------------------------------------------------"
+puts " "
+if {$IsDone == 0 } {
+ puts "Test errors:"
+ set err ""
+ for {set i 1} {[lindex $TestError $i]!=""} {incr i} {
+ if {[lindex $TestError $i] == "#"} {
+ puts $err
+ set err ""
+ } else {set err "$err [lindex $TestError $i]"}
+ }
+ puts $err
+ puts "ERROR OCCURS DURING TEST - FAULTY"
+} else { puts "TEST COMPLETED"}
+
+# puts "TEST COMPLETED"
+#exit
projects / occt.git / commitdiff