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