gmmeshgen.tcl

来自「算断裂的」· TCL 代码 · 共 112 行

proc gmmeshgen args {
    ## gmset mesh [gmmeshgen $brep opt1 val1 opt2 val2 ...]
    ## Generates a mesh for the brep.  See the documentation
    ## for settings for the opt-val pairs.
    global gm_brep_type_code
    set domain [lindex $args 0]
    set domainl [gm_obj2list $domain]
    set di [lindex $domainl 2]
    set gdim [lindex $domainl 1]
    set type [lindex $domainl 0]
    if {$type != $gm_brep_type_code} {
	error "First argument to gmmeshgen must be a brep"
    }
    if {$gdim < 2 || $gdim > 3} {
	error "Dimension out of range for gmmeshgen"
    }
    if {$gdim != $di} {
	error "Brep must have equal intrinsic and embedded dimension for gmmeshgen"
    }
    if {[llength $args] % 2 != 1} {
	error "gmmeshgen must have an odd number of arguments"
    }
    set noptval [expr ([llength $args] - 1) / 2]
    set sizectl "(const 1e307)"
    set curvectl "(const 0.5)"
    global gm_default_tol
    set tol $gm_default_tol
    if {$di == 2} {
	set expa {.3 .15 .05}
	set aspdegrade {.5 .5 .5}
    } elseif {$di == 3} {
	set expa {.2 .1 .07 .01}
	set aspdegrade {.5 .5 .5 .5}
    }
    set showgui 1
    set logfile mglog[pid]
    set verbosity 1
    set userdata ""
    set orientation 1
    for {set j 0} {$j < $noptval} {incr j} {
	set thisopt [lindex $args [expr $j * 2 + 1]]
	set thisval [lindex $args [expr $j * 2 + 2]]
	set thisopt [string tolower $thisopt]
	set f [string first $thisopt "sizecontrol"]
	if {$f == 0} {
	    set sizectl $thisval
	    continue
	}
	set f [string first $thisopt "curvecontrol"]
	if {$f == 0} {
	    set curvectl $thisval
	    continue
	}
	set f [string first $thisopt "showgui"]
	if {$f == 0} {
	    set showgui $thisval
	    if {$showgui != 0 && $showgui != 1} {
		error "Showgui value must be 0 or 1"
	    }
	    continue
	}
	set f [string first $thisopt "expansion"]
	if {$f == 0} {
	    set expa $thisval
	    continue
	}
	set f [string first $thisopt "tol"]
	if {$f == 0} {
	    set tol $thisval
	    continue
	}
	set f [string first $thisopt "aspdegrade"]
	if {$f == 0} {
	    set aspdegrade $thisval
	    continue
	}
	set f [string first $thisopt "logfile"]
	if {$f == 0} {
	    set logfile $thisval
	    continue
	}
	set f [string first $thisopt "verbosity"]
	if {$f == 0} {
	    set verbosity $thisval
	    continue
	}
	set f [string first $thisopt "userdata"]
	if {$f == 0} {
	    set userdata $thisval
	    continue
	}
	set f [string first $thisopt "orientation"]
	if {$f == 0} {
	    set orientation $thisval
	    continue
	}
	error "Unrecognized option: $thisopt"
    }
    return [gm_meshgen $domain  $sizectl $curvectl  $userdata \
	    $expa $aspdegrade $logfile $verbosity $showgui $tol $orientation]
}

# ------------------------------------------------------------------
# Copyright (c) 1999 by Cornell University.  All rights reserved
# See the accompanying file 'Copyright' for authorship information,
# the terms of the license governing this software, and disclaimers
# concerning this software.
# ------------------------------------------------------------------
# This file is part of the QMG software.  
# Version 2.0 of QMG, release date September 3, 1999
# ------------------------------------------------------------------