0023161: Select publicly accessible data files for OCCT tests
[occt.git] / tests / chamfer / begin
CommitLineData
40093367 1# File : begin
2
3# to prevent loops limit to 10 minutes
4cpulimit 600
5
6if { [array get Draw_Groups "TOPOLOGY Fillet construction commands"] == "" } {
7 pload TOPTEST
8}
9
40093367 10# This procedure tries to load an EDGE (one point) or EDGE (two points)
11proc get_element { type args } {
12# First point
13 set x [lindex $args 0]
14 set y [lindex $args 1]
15 set z [lindex $args 2]
16
17# Second point if necessary
18 if { [string compare $type "FACE"] == 0 } {
19 set x1 [lindex $args 3]
20 set y1 [lindex $args 4]
21 set z1 [lindex $args 5]
22
23 } else {
24 set x1 $x
25 set y1 $y
26 set z1 $z
27 }
28
29 global ver
30 vertex ver $x $y $z
31 global dd
32 global dd_val
33 set res {}
34
35# Try to find element with points inside a bounding box
36 foreach element [directory] {
37 global $element
38 distmini dd ver $element
39 if { [string match "*$type*" [whatis $element]] } {
40 set bbox [bounding $element]
41# Get distance
42 set dv [lindex [dump dd_val] 5]
43 if { [expr {
44 [lindex $bbox 0] - 1e-2 <= $x && $x <= [lindex $bbox 3] + 1e-2
45 && [lindex $bbox 1] - 1e-2 <= $y && $y <= [lindex $bbox 4] + 1e-2
46 && [lindex $bbox 2] - 1e-2 <= $z && $z <= [lindex $bbox 5] + 1e-2
47 && [lindex $bbox 0] - 1e-2 <= $x1 && $x1 <= [lindex $bbox 3] + 1e-2
48 && [lindex $bbox 1] - 1e-2 <= $y1 && $y1 <= [lindex $bbox 4] + 1e-2
49 && [lindex $bbox 2] - 1e-2 <= $z1 && $z1 <= [lindex $bbox 5] + 1e-2
50 }]
51 } {
52 if { [llength $res] == 0 } {
53 lappend res $element
54 lappend res $dv
55 } else {
56 if { [lindex $res 1] > $dv } {
57 lset res 0 $element
58 lset res 1 $dv
59 }
60 }
61# return $element
62 }
63 }
64 }
65
66 unset dd
67 if { [llength $res] != 0 } {
68 return [lindex $res 0]
69 }
70
71 set error "Error : $type is not found at $x $y $z"
72 if { [string compare $type "FACE"] == 0 } {
73 set error "$error and $x1 $y1 $z1"
74 }
75
76 puts $error
77 return ""
78}
79
80# Compute chamfer sequentially
81# The edge and face numbers are changed after each step.
82# It is necessary to compute new names on result shape after each camf command.
83proc chamf_sequence { args } {
84 set len [llength $args]
85 if { $len == 1 } {
86 set args [lindex $args 0]
87 set len [llength $args]
88 }
89 set chamfer_list {}
90 set chamf_current {}
91 set result_shape [lindex $args 0]
92 set shape_edges [lindex $args 1]
93 set shape_faces [lindex $args 2]
94
95 global chamf_edge_face
96 global chamf_type
97 global chamf_parameters
98
99 global $result_shape
100 foreach d [directory] {
101 global $d
102 }
103
104 set len [llength $chamf_edge_face]
105 for {set i 0} {$i < $len} {incr i} {
106# Numbers of EDGE and FACE in inital shape for step $i
107 set ef [lindex $chamf_edge_face $i]
108# Parameters of chamfer for step $i
109 set p [lindex $chamf_parameters $i]
110
111# Name of EDGE in initial shape
112 set stre "${shape_edges}_[lindex $ef 0]"
113# Name of FACE in initial shape
114 set strf "${shape_faces}_[lindex $ef 1]"
115# Get a Cender of gravity for each element and compute new names of on each step.
116# get_element procedure tries to find an element with Cender of gravity inside an bounding box.
117 foreach name [list EDGE FACE] {
118 if { [string compare $name "EDGE"] == 0 } {
119 set props [lprops $stre]
120 if { [llength $chamf_current] != 0 } {
121 lappend chamfer_list $chamf_current
122 set chamf_current {}
123 }
124 lappend chamf_current $result_shape
125 lappend chamf_current $shape_edges
126 } else {
127 set props [sprops $strf]
128 }
129 if { [regexp {Center of gravity[^0-9=]+= +([-0-9.+eE]+)[^0-9=]+= +([-0-9.+eE]+)[^0-9=]+= +([-0-9.+eE]+)} $props full x y z] } {
130# New names of element will be computed dynamically on each step.
131 if { [string compare $name "EDGE"] == 0 } {
132 lappend chamf_current "\[get_element $name $x $y $z\]"
133# Save EDGE center for get_element command with FACE argument.
134 set x1 $x
135 set y1 $y
136 set z1 $z
137 } else {
138 lappend chamf_current "\[get_element $name $x $y $z $x1 $y1 $z1\]"
139 }
140 }
141 }
142 if { [string compare $chamf_type ""] != 0} {
143 lappend chamf_current $chamf_type
144 }
145 foreach pe $p {
146 lappend chamf_current $pe
147 }
148 }
149 lappend chamfer_list $chamf_current
150 foreach chamf_current $chamfer_list {
151# Compute new name of EDGE
152 lset chamf_current 2 [expr [lindex $chamf_current 2]]
153# Compute new name of FACE
154 lset chamf_current 3 [expr [lindex $chamf_current 3]]
155
156 set str "chamf $chamf_current"
157 puts $str
158# Compute chamfer
159 set failed [catch $str res]
160 if { $failed } {
161 puts "Error : chamfer is not done. $res"
162# Save previous shape in new name
163 renamevar $shape_edges $result_shape
164 }
165# Delete temporary edges and faces
166 foreach str [directory] {
167 set type [whatis $str]
168 set is_edge [string match "*EDGE*" $type]
169 set is_face [string match "*FACE*" $type]
170 if { $is_edge || $is_face } {
171 unset $str
172 }
173 }
174 if { $failed == 0 } {
175 unset $shape_edges
176 }
177# Allow to use exploded elements on next step
178 set nb [countshapes $result_shape]
179 regexp {EDGE[^0-9]+([0-9]+)} $nb full nbedges
180 regexp {FACE[^0-9]+([0-9]+)} $nb full nbfaces
181 for {set j 1} {$j <= $nbedges} {incr j} {
182 global "${result_shape}_$j"
183 }
184 for {set j 1} {$j <= $nbfaces} {incr j} {
185 global "${shape_edges}_$j"
186 }
187 explode $result_shape E
188 renamevar $result_shape $shape_edges
189 explode $shape_edges F
190 }
191# Save result shape in new name
192 renamevar $shape_edges $result_shape
193}
194
195# Compute chamfer at one command or sequentially
196proc compute_chamf { args } {
197 global command
198 if { [string compare $command "chamf_sequence"] == 0 } {
199 chamf_sequence $args
200 } else {
201 set len [llength $args]
202 set result_shape [lindex $args 0]
203 set shape_edges [lindex $args 1]
204 set shape_faces [lindex $args 2]
205
206 global chamf_edge_face
207 global chamf_type
208 global chamf_parameters
209
210 global $result_shape
211 foreach d [directory] {
212 global $d
213 }
214
215 set chamf_str "chamf $result_shape $shape_edges"
216
217 set len [llength $chamf_edge_face]
218 for {set i 0} {$i < $len} {incr i} {
219 set ef [lindex $chamf_edge_face $i]
220 set p [lindex $chamf_parameters $i]
221 set chamf_str "${chamf_str} ${shape_edges}_[lindex $ef 0] ${shape_faces}_[lindex $ef 1] $chamf_type $p"
222 }
223
224 puts $chamf_str
225# Compute chamfer in one command
226 if { [catch "$chamf_str" res] } {
227 puts "Error : chamfer is not done. $res"
228 renamevar $shape_edges $result_shape
229 }
230 }
231}