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