40093367 |
1 | # File : begin |
2 | |
3 | # to prevent loops limit to 10 minutes |
4 | cpulimit 600 |
5 | |
6 | if { [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) |
11 | proc 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. |
83 | proc 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 |
196 | proc 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 | } |