1if { [catch { load liboccvis[info sharedlibextension] Ng_OCC } result ] } {
2    # puts "cannot load occ"
3    # puts "error: $result"
4}
5
6
7if { [catch { Ng_OCCCommand isoccgeometryloaded }] } {
8    # dummy
9    proc rebuildoccdialog { } { }
10} {
11    puts "OCC module loaded"
12    set hasocc yes
13
14
15
16.ngmenu.geometry add separator
17
18.ngmenu.geometry add command -label "IGES/STEP Topology Explorer/Doctor..." \
19    -command { occdialog; }
20
21
22# Philippose - 30/01/2009
23# Add menu item for local face mesh size definition in the
24# TCL Gui
25.ngmenu.geometry add command -label "Edit Face Mesh Size..." \
26    -command { surfacemeshsizedialog }
27
28
29# .ngmenu.geometry add command -label "OCC Construction" \
30    #     -command { Ng_OCCConstruction; }
31
32
33
34
35set entities [ ]
36
37
38proc occdialogbuildtree {} {
39    global entities
40
41    set w .occ_dlg
42    #set hlist [$w.mtre subwidget hlist]
43
44    set entities [Ng_GetOCCData getentities]
45    set nrentities [expr [llength $entities]]
46
47
48    if {$nrentities != 0} {
49
50	#$hlist add Topology -itemtype text -text "Topology"
51
52	#$hlist add Topology/CompSolids   -itemtype text -text "Composite Solids" -data "Composite Solids"
53	#$hlist add Topology/FreeSolids   -itemtype text -text "Free Solids" -data "Free Solids"
54	#$hlist add Topology/FreeShells   -itemtype text -text "Free Shells" -data "Free Shells"
55	#$hlist add Topology/FreeFaces    -itemtype text -text "Free Faces" -data "Free Faces"
56	#$hlist add Topology/FreeWires    -itemtype text -text "Free Wires" -data "Free Wires"
57	#$hlist add Topology/FreeEdges    -itemtype text -text "Free Edges" -data "Free Edges"
58	#$hlist add Topology/FreeVertices -itemtype text -text "Free Vertices" -data "Free Vertices"
59    $w.tree insert {Topology} end -id "CompSolids" -text "Composite Solids"
60    $w.tree insert {Topology} end -id "FreeSolids" -text "Free Solids"
61    $w.tree insert {Topology} end -id "FreeShells" -text "Free Shells"
62    $w.tree insert {Topology} end -id "FreeFaces" -text "Free Faces"
63    $w.tree insert {Topology} end -id "FreeWires" -text "Free Wires"
64    $w.tree insert {Topology} end -id "FreeEdges" -text "Free Edges"
65    $w.tree insert {Topology} end -id "FreeVertices" -text "Free Vertices"
66
67	#	$hlist add SingularEntities -itemtype text -text "Entities marked as singular"
68    $w.tree item "Topology" -open true
69	set i [expr 0]
70	while {$i < $nrentities} {
71	    set entity [lindex $entities [expr $i]]
72	    incr i 1
73	    set entityname [lindex $entities [expr $i]]
74	    #$hlist add Topology/$entity -text $entityname -data $entityname
75        set myroot [string range $entity 0 [string last / $entity]-1]
76        $w.tree insert $myroot end -id $entity -text $entityname -value 1
77	    incr i 1
78	    #$w.mtre close Topology/$entity
79	}
80
81	#$w.mtre autosetmode
82
83	#$w.mtre open Topology
84	#$w.mtre close Topology/CompSolids
85	#$w.mtre close Topology/FreeSolids
86	#$w.mtre close Topology/FreeShells
87	#$w.mtre close Topology/FreeFaces
88	#$w.mtre close Topology/FreeWires
89	#$w.mtre close Topology/FreeEdges
90	#$w.mtre close Topology/FreeVertices
91
92	set i [expr 0]
93	while {$i < $nrentities} {
94	    set entity [lindex $entities [expr $i]]
95	    #$w.mtre close Topology/$entity
96        $w.tree item $entity -open false
97	    incr i 2
98	}
99
100	set faces [Ng_OCCCommand getunmeshedfaceinfo]
101	set nrfaces [expr [llength $faces]]
102	if {$nrfaces >= 2} {
103	    #$hlist add ErrorFaces -itemtype text -text "Faces with surface meshing error"
104        $w.tree insert {} -id ErrorFaces -text "Faces with surface meshing error"
105	    #$w.mtre open ErrorFaces
106        $w.tree item ErrorFaces -open true
107	    set i [expr 0]
108	    while {$i < $nrfaces} {
109		set entity [lindex $faces [expr $i]]
110        set myroot [string range $entity 0 [string last / $entity]-1]
111        if { [string length $myroot] == 0 } {
112            set myroot ErrorFaces
113        }
114		incr i 1
115		set entityname [lindex $faces [expr $i]]
116		#$hlist add ErrorFaces/$entity -text $entityname -data $entityname
117        $w.tree insert {myroot} end -id $entity -text $entityname -value 0
118		incr i 1
119	    }
120	}
121
122
123	set faces [Ng_OCCCommand getnotdrawablefaces]
124	set nrfaces [expr [llength $faces]]
125	if {$nrfaces >= 2} {
126	    #$hlist add NotDrawableFaces -itemtype text -text "Faces impossible to visualize"
127        $w.tree insert {} -id NotDrawableFaces -text "Faces impossible to visualize"
128	    #$w.mtre open NotDrawableFaces
129        $w.tree item NotDrawableFaces -open true
130	    set i [expr 0]
131	    while {$i < $nrfaces} {
132		set entity [lindex $faces [expr $i]]
133        set myroot [string range $entity 0 [string last / $entity]-1]
134        if { [string length $myroot ] == 0 } {
135            set myroot NotDrawableFaces
136        }
137		incr i 1
138		set entityname [lindex $faces [expr $i]]
139		#$hlist add NotDrawableFaces/$entity -text $entityname -data $entityname
140        $w.tree insert $myroot end -id $entity -text $entityname -value 0
141		incr i 1
142	    }
143	}
144
145
146	#$w.mtre autosetmode
147
148	puts "done"
149    }
150}
151
152
153proc rebuildoccdialog {} {
154    if {[winfo exists .occ_dlg] == 1} {
155    .occ_dlg.tree delete [.occ_dlg.tree children Topology]
156	#[.occ_dlg.mtre subwidget hlist] delete all
157	occdialogbuildtree
158    }
159}
160
161proc checkoccloaded { } {
162    set isoccgeometryloaded [Ng_OCCCommand isoccgeometryloaded]
163    if {$isoccgeometryloaded == 0} {
164	puts "no IGES/STEP geometry loaded"
165	destroy .occ_dlg
166    }
167}
168
169#proc setocctolerance { } {
170#    set w .setocctolerance
171#}
172
173
174proc selectentity { entityname } {
175    global entities
176    set nrentities [expr [llength $entities]]
177    set i [expr 0]
178    while {$i < $nrentities} {
179	set entitylength []
180	set entity2 [lindex $entities [expr $i]]
181	incr i 1
182	set entityname2 [lindex $entities [expr $i]]
183	incr i 1
184	set entityname2 [string range $entityname2 0 [expr [string length $entityname]-1]]
185	if {$entityname == $entityname2} {
186	    # #set hlist [.occ_dlg.mtre subwidget hlist]
187	    # #.occ_dlg.mtre open Topology
188        # .occ_dlg.tree item Topology -open true
189        # puts $entity2
190	    # set slashpos [string last "/" $entity2]
191	    # set entity3 [string range $entity2 0 [expr $slashpos-1]]
192	    # while {$slashpos != -1} {
193		# #.occ_dlg.mtre open Topology/$entity3
194        # .occ_dlg.tree item $entity3 -open true
195		# puts $entity3
196		# set slashpos [string last "/" $entity3]
197		# set entity3 [string range $entity3 0 [expr $slashpos-1]]
198	    # }
199	    #$hlist selection clear
200	    .occ_dlg.tree see $entity2
201	    .occ_dlg.tree selection set $entity2
202	}
203    }
204}
205
206
207
208proc occdialog { } {
209
210    uplevel 1 {
211
212	global entities
213	set selectvisual geometry
214	Ng_SetVisParameters
215	redraw
216
217	set w .occ_dlg
218
219	if {[winfo exists .occ_dlg] == 1} {
220	    wm withdraw $w
221	    wm deiconify $w
222	    focus $w
223	} {
224	    toplevel $w
225
226        ttk::treeview $w.tree
227        $w.tree insert {} end -id "Topology" -text "Topology"
228        pack $w.tree -fill both -expand yes
229	    occdialogbuildtree
230
231        bind $w.tree <Double-1> {
232            set entityname [.occ_dlg.tree item [.occ_dlg.tree selection] -text ]
233            set rootname ""
234            if {[.occ_dlg.tree item [.occ_dlg.tree selection] -value] == 1 } {
235                set rootname "Topology"
236            }
237		    set spacepos [string first " " $entityname]
238		    set entitytype [string range $entityname 0 [expr $spacepos-1]]
239		    set helpstring [string range $entityname [expr $spacepos+1] [expr [string length $entityname]-1]]
240		    set spacepos2 [string first " " $helpstring]
241		    set entitynumber [string range $helpstring 0 [expr $spacepos2-1]]
242		    if {$rootname == "Topology"} {
243			Ng_OCCCommand highlightentity $entitytype $entitynumber
244			set selectvisual geometry
245			redraw
246		    } {
247			set brackpos [string first " (" $entityname]
248			if {$brackpos != -1} {
249			    set entityname [string range $entityname 0 $brackpos]
250			}
251			selectentity $entityname
252		    }
253            }
254	    ttk::button $w.cl -text "Close" -command {
255		destroy .occ_dlg
256	    }
257
258	    ttk::button $w.show -text "Show" -command {
259        set entityname [.occ_dlg.tree item [.occ_dlg.tree selection] -text ]
260		set spacepos [string first " " $entityname]
261		set entitytype [string range $entityname 0 [expr $spacepos-1]]
262		set helpstring [string range $entityname [expr $spacepos+1] [expr [string length $entityname]-1]]
263		set spacepos2 [string first " " $helpstring]
264		set entitynumber [string range $helpstring 0 [expr $spacepos2-1]]
265
266		Ng_OCCCommand show $entitytype $entitynumber
267		set selectvisual geometry
268		#	    Ng_SetVisParameters
269		redraw
270	    }
271	    ttk::button $w.hide -text "Hide" -command {
272        set entityname [.occ_dlg.tree item [.occ_dlg.tree selection] -text ]
273		set spacepos [string first " " $entityname]
274		set entitytype [string range $entityname 0 [expr $spacepos-1]]
275		set helpstring [string range $entityname [expr $spacepos+1] [expr [string length $entityname]-1]]
276		set spacepos2 [string first " " $helpstring]
277		set entitynumber [string range $helpstring 0 [expr $spacepos2-1]]
278
279		Ng_OCCCommand hide $entitytype $entitynumber
280		set selectvisual geometry
281		#	    Ng_SetVisParameters
282		redraw
283	    }
284
285	    ttk::button $w.swaporientation -text "Swap orientation" -command {
286        set entityname [.occ_dlg.tree item [.occ_dlg.tree selection] -text ]
287		set spacepos [string first " " $entityname]
288		set entitytype [string range $entityname 0 [expr $spacepos-1]]
289		set helpstring [string range $entityname [expr $spacepos+1] [expr [string length $entityname]-1]]
290		set spacepos2 [string first " " $helpstring]
291		set entitynumber [string range $helpstring 0 [expr $spacepos2-1]]
292
293		Ng_OCCCommand swaporientation $entitytype $entitynumber
294		set selectvisual geometry
295		#	    Ng_SetVisParameters
296		redraw
297        .occ_dlg.tree delete [.occ_dlg.tree children Topology]
298		#[.occ_dlg.mtre subwidget hlist] delete all
299		occdialogbuildtree
300	    }
301
302	    ttk::button $w.marksingular -text "Mark/Unmark as singular" -command {
303        set entityname [.occ_dlg.tree item [.occ_dlg.tree selection] -text ]
304		set spacepos [string first " " $entityname]
305		if { $spacepos != 0 } {
306		    set entitytype [string range $entityname 0 [expr $spacepos-1]]
307		    set helpstring [string range $entityname [expr $spacepos+1] [expr [string length $entityname]-1]]
308		    set spacepos2 [string first " " $helpstring]
309		    if { $spacepos2 != 0 } {
310			set entitynumber [string range $helpstring 0 [expr $spacepos2-1]]
311			puts $entitytype
312            puts $entitynumber
313			global ismarkedsingular
314			Ng_OCCCommand marksingular $entitytype $entitynumber
315
316			if { $ismarkedsingular == 0 } {
317                .occ_dlg.tree tag remove "Color" [.occ_dlg.tree selection]
318			} {
319                .occ_dlg.tree tag add "Color" [.occ_dlg.tree selection]
320                .occ_dlg.tree tag configure "Color" -foreground "red"
321                .occ_dlg.tree tag configure "Color" -background "blue"
322			}
323		    }
324		}
325	    }
326
327	    ttk::checkbutton $w.zoomtohighlightedentity -text "Zoom to highlighted entity" \
328		-variable occoptions.zoomtohighlightedentity \
329		-command {
330		    Ng_SetOCCVisParameters
331		    if { ${occoptions.zoomtohighlightedentity} == 1} {
332			set selectvisual geometry
333			#		    Ng_SetVisParameters
334			Ng_OCCCommand redrawstatus 1
335			redraw
336		    } {
337			Ng_OCCCommand redrawstatus 0
338		    }
339		}
340
341
342
343	    ttk::frame $w.healing -relief groove -borderwidth 3
344
345	    ttk::button $w.healing.checkentities -text "Analyze geometry" -command {
346		set irregent [Ng_OCCCommand findsmallentities]
347		set w .occ_dlg
348		set nritems [expr [llength $irregent]]
349		set i [expr 0]
350        if {$nritems > 0 } {
351            if { [.occ_dlg.tree exists ProblematicEntities] == 1 } {
352                $w.tree delete ProblematicEntities
353            }
354            $w.tree insert {} end -id ProblematicEntities -text "Problematic Entities"
355        }
356		while {$i < $nritems} {
357		    set entity [lindex $irregent [expr $i]]
358		    incr i 1
359		    set entityname [lindex $irregent [expr $i]]
360            #puts $entity
361            #puts $entityname
362            set myroot [string range $entity 0 [string last / $entity]-1]
363            if { [string length $myroot] == 0 } {
364                set myroot ProblematicEntities
365            }
366            $w.tree insert $myroot end -id $entity -text $entityname
367		    incr i 1
368		}
369        $w.tree item ProblematicEntities -open true
370	    }
371
372	    # tixControl $w.healing.tolerance -label "Healing tolerance: " -integer false \
373		# -variable occoptions.tolerance -min 1e-9 -max 1e6 \
374		# -options {
375		    # entry.width 6
376		    # label.width 25
377		    # label.anchor e
378		# }
379
380        ttk::frame $w.healing.tolerance
381        ttk::label $w.healing.tolerance.label -text "Healing tolerance: "
382        ttk::spinbox $w.healing.tolerance.sp -textvariable occoptions.tolerance -width 6 -increment 0.01 -validate focus -validatecommand "my_validatespinbox %W %P 12" \
383        -invalidcommand "my_invalidspinbox %W" -from -1e-9 -to 1e6
384        grid $w.healing.tolerance.label $w.healing.tolerance.sp
385
386	    ttk::checkbutton $w.healing.fixsmalledges -text "Fix small edges" \
387		-variable occoptions.fixsmalledges
388
389	    ttk::checkbutton $w.healing.fixspotstripfaces -text "Fix spot/strip faces" \
390		-variable occoptions.fixspotstripfaces
391
392	    ttk::checkbutton $w.healing.sewfaces -text "Sew faces" \
393		-variable occoptions.sewfaces
394
395	    ttk::checkbutton $w.healing.makesolids -text "Make solids" \
396		-variable occoptions.makesolids
397
398	    ttk::checkbutton $w.healing.splitpartitions -text "Split partitions" \
399		-variable occoptions.splitpartitions
400
401	    ttk::button $w.healing.heal -text "Heal geometry" -command {
402		#.occ_dlg.healing.tolerance.sp invoke
403		Ng_OCCCommand shapehealing
404		redraw
405        .occ_dlg.tree delete [.occ_dlg.tree children Topology]
406		#[.occ_dlg.mtre subwidget hlist] delete all
407		occdialogbuildtree
408	    }
409
410	    pack $w.healing.checkentities
411
412	    pack $w.healing.tolerance $w.healing.fixsmalledges \
413		$w.healing.fixspotstripfaces $w.healing.sewfaces \
414		$w.healing.makesolids $w.healing.splitpartitions -anchor w
415
416	    pack $w.healing.heal
417
418
419
420
421	    pack $w.show $w.hide
422
423	    pack $w.zoomtohighlightedentity -anchor w
424	    #	pack $w.checkentities
425	    pack $w.swaporientation
426	    pack $w.marksingular
427	    pack $w.healing -fill x
428	    pack $w.cl
429
430
431	    wm withdraw $w
432	    wm geom $w +100+100
433	    wm deiconify $w
434	    wm title $w "IGES/STEP Topology Explorer/Doctor"
435	    focus .occ_dlg
436	}
437    }
438}
439
440
441}