proc setFieldValidation {codeTable codeField valueField valueTable valueColumn} {
if {[$codeTable getCurrentValue] != "" && [$codeField getCurrentValue] != ""} {
set buffer [GuidoExecServer GetFieldInformation [subst {DatabaseType = "GeologyDatabase" SurpacTableName = "[$codeTable getCurrentValue]" SurpacFieldName = "[$codeField getCurrentValue]"}]]
set FieldType [GuidoGetParamBufferValue $buffer FieldType]
if {$FieldType == "integer"} {
set LowBound [GuidoGetParamBufferValue $buffer LowBound]
set HighBound [GuidoGetParamBufferValue $buffer HighBound]
$valueField setFormat integer
$valueColumn setFormat integer
$valueField setMaximumLength -1
$valueColumn setMaximumLength -1
if {$LowBound != ""} {
$valueField setLowBound $LowBound
$valueColumn setLowBound $LowBound
}
if {$HighBound != ""} {
$valueField setHighBound $HighBound
$valueColumn setHighBound $HighBound
}
} elseif {$FieldType == "character"} {
set Length [GuidoGetParamBufferValue $buffer Length]
set Case [GuidoGetParamBufferValue $buffer Case]
$valueField setFormat none
$valueField setMaximumLength $Length
if {[string length [$valueField getCurrentValue]] > $Length} {
$valueField setCurrentValue [string range [$valueField getCurrentValue] 0 [expr $Length - 1]]
}
$valueField setTranslate $Case
$valueColumn setFormat none
$valueColumn setMaximumLength $Length
for {set idx 0} {$idx < [$valueTable getRowCount]} {incr idx} {
if {[string length [$valueColumn getCurrentValue $idx]] > $Length} {
$valueColumn setCurrentValue $idx [string range [$valueColumn getCurrentValue $idx] 0 [expr $Length - 1]]
}
}
$valueColumn setTranslate $Case
}
}
}
proc loadConstraint {cons field operator value} {
GuidoForm loadconstraints {
-label "Select Database Constraint File To Load"
-layout CentreLineLayout
-default_buttons
GuidoFileBrowserField filename {
-display_length 32
-extension false
-file_mask *.dbc
-format none
-label Filename
-max_length FIO_MAX_LOCATION_LENGTH
-translate none
}
}
$loadconstraints show modal
if {[$loadconstraints getStatus] == "apply"} {
if {[$filename getCurrentValue] != ""} {
set loadFileParams [GuidoExecServer "LoadDatabaseConstraintsFile" [subst {databasetype = "GEOLOGY" table = "collar" filename = [$filename getCurrentValue]}]]
set status [GuidoGetParamBufferValue $loadFileParams status]
if {$status >= 0} {
set num_rows [GuidoGetParamBufferValue $loadFileParams num_rows]
$cons setInitialRows $num_rows 1 17
for {set i 0} {$i < $num_rows} {incr i} {
$field    setCurrentValue $i "[GuidoGetParamBufferValue $loadFileParams field($i)]"
$operator setCurrentValue $i "[GuidoGetParamBufferValue $loadFileParams operator($i)]"
$value    setCurrentValue $i "[GuidoGetParamBufferValue $loadFileParams value($i)]"
}
}
}
}
$loadconstraints destroy
}
proc saveConstraint {cons field operator value} {
GuidoForm saveconstraints {
-default_buttons
-label "Select Database Constraint File To Save"
GuidoFileBrowserField filename {
-display_length 32
-extension false
-file_mask *.dbc
-format none
-label Filename
-max_length FIO_MAX_LOCATION_LENGTH
-translate none
-file_access write
-null false
}
}
$saveconstraints show modal
if {[$saveconstraints getStatus] == "apply"} {
if {[$filename getCurrentValue] != ""} {
set arguments "[subst {filename = [$filename getCurrentValue]}]"
set row 0
for {set row_idx 0} {$row_idx < [$cons getRowCount]} {incr row_idx} {
if {[$field getCurrentValue $row_idx] > ""} {
append arguments " [subst {field($row) = [$field getCurrentValue $row_idx]}]"
append arguments " [subst {operator($row) = [$operator getCurrentValue $row_idx]}]"
append arguments " [subst {value($row) = [$value getCurrentValue $row_idx]}]"
incr row
}
}
append arguments " [subst {num_rows = $row}]"
GuidoExecServer "SaveDatabaseConstraintsFile" $arguments
}
}
$saveconstraints destroy
}
proc updateAssignMultiFieldList { field table } {
$field removeAllItems
set currentTable [$table getCurrentValue]
set buffer [GuidoExecServer UpdateAssignMultiFieldList [subst {CurrentTable = "$currentTable"}]]
set size [GuidoGetParamBufferValue $buffer size]
for {set idx 0} {$idx < $size} {incr idx} {
$field addItem "[GuidoGetParamBufferValue $buffer field($idx)]"
}
}
proc get_triobject_trisolation_details_for_multipleDTMs1 {location object_num trisolation_num domainType} {
if { [string length $location] > 0 } {
set currentObjectId [$object_num getCurrentValue]
set currentTrisolId [$trisolation_num getCurrentValue]
$object_num removeAllItems
$object_num setValues ""
$object_num setCurrentValue ""
$trisolation_num removeAllItems
$trisolation_num setValues ""
$trisolation_num setCurrentValue ""
set buffer [GuidoExecServer GetObjectsTrisolationsForMultipleDTMS [subst {FileName = "$location" CurrentObjectId = "$currentObjectId" CurrentTrisolId = "$currentTrisolId" DomainType = "$domainType"}]]
set status [GuidoGetParamBufferValue $buffer status]
if {$status >= 0} {
set num_triobject [GuidoGetParamBufferValue $buffer "num_triobject"]
set num_trisolation [GuidoGetParamBufferValue $buffer "num_trisolation"]
set formRedisplayed [GuidoGetParamBufferValue $buffer "form_redisplayed"]
set objvalues ""
set trisolvalues ""
$object_num removeAllItems
$trisolation_num removeAllItems
if {"$formRedisplayed" == "false"} {
set triobject_id [GuidoGetParamBufferValue $buffer "triobject_id"]
set trisolation_id [GuidoGetParamBufferValue $buffer "trisolation_id"]
for {set i 0} {$i < $num_triobject} {incr i} {
set objid [lindex $triobject_id $i]
lappend objvalues $objid
}
$object_num setNullAllowed false
$object_num setExclusive true
eval [concat {$object_num} {setValues} $objvalues ]
$object_num setCurrentValue [$object_num getItemAt 0]
for {set i 0} {$i < $num_trisolation} {incr i} {
set trisolid [lindex $trisolation_id $i]
lappend trisolvalues $trisolid
}
$trisolation_num setNullAllowed true
eval [concat {$trisolation_num} {setValues} $trisolvalues ]
$trisolation_num setCurrentValue [$trisolation_num getItemAt 0]
$trisolation_num setExclusive false
} else {
set old_triobject_id [GuidoGetParamBufferValue $buffer "old_triobject_id"]
set old_trisolation_id [GuidoGetParamBufferValue $buffer "old_trisolation_id"]
for {set i 0} {$i < $num_triobject} {incr i} {
set objid [lindex $old_triobject_id $i]
lappend objvalues $objid
}
$object_num setNullAllowed false
$object_num setExclusive true
eval [concat {$object_num} {setValues} $objvalues ]
$object_num setCurrentValue $currentObjectId
for {set i 0} {$i < $num_trisolation} {incr i} {
set trisolid [lindex $old_trisolation_id $i]
lappend trisolvalues $trisolid
}
$trisolation_num setNullAllowed true
eval [concat {$trisolation_num} {setValues} $trisolvalues ]
$trisolation_num setCurrentValue $currentTrisolId
$trisolation_num setExclusive false
}
}
} else {
$object_num removeAllItems
$trisolation_num removeAllItems
$object_num setExclusive false
$object_num setCurrentValue ""
$trisolation_num setExclusive false
$trisolation_num setCurrentValue ""
}
}
proc getObjectsTrisolationsForMultipleDTMS {dtm_loc object_num trisolation_num saveToDatabase type} {
set fileloc "[$dtm_loc getCurrentValue]"
set convfileloc "[string tolower $fileloc]"
set domainType "[$type getCurrentValue]"
set location ""
if { [string first ".dtm" $convfileloc ] == -1 } {
append location $fileloc ".dtm"
} else {
set location $fileloc
}
if {[string length $location] > 4} {
get_triobject_trisolation_details_for_multipleDTMs1 $location $object_num $trisolation_num $domainType
}
$saveToDatabase requestFocus
}
proc triobjectChanged { dtm_loc objectId trisolationId type} {
set location [ $dtm_loc getCurrentValue ]
set convfileloc "[string tolower $location]"
set domainType "[$type getCurrentValue]"
if { [string first ".dtm" $convfileloc ] == -1 } {
append filename $location ".dtm"
} else {
set filename $location
}
if { [string length $filename] > 4 } {
getTriobjectChanged $filename $objectId $trisolationId $domainType
}
}
proc getTriobjectChanged { dtm_loc objectId trisolationId domainType} {
set obj_num [$objectId getCurrentValue]
set filename $dtm_loc
set buffer [GuidoExecServer TriobjectChanged [subst {FileName = "$filename" CurrentTriobject = "$obj_num" DomainType = "$domainType"}]]
set status [GuidoGetParamBufferValue $buffer status]
if {$status >= 0} {
set trisolation_id [GuidoGetParamBufferValue $buffer "trisolation_id"]
set num_trisolation [GuidoGetParamBufferValue $buffer "num_trisolation"]
set trisolvalues ""
$trisolationId removeAllItems
for {set i 0} {$i < $num_trisolation} {incr i} {
set trisolid [lindex $trisolation_id $i]
lappend trisolvalues $trisolid
}
$trisolationId setNullAllowed true
eval [concat {$trisolationId} {setValues} $trisolvalues ]
if {"[$trisolationId getCurrentValue]" == ""} {
$trisolationId setCurrentValue [$trisolationId getItemAt 0]
}
$trisolationId setExclusive false
$objectId setNullAllowed false
}
}
GuidoScript scripts/geologyutilities.tcl
set buffer [GuidoExecServer LegacyGetCurrentDatabaseHandle [subst {sessionType = "GeologyDatabase"}]]
set dbHandle [GuidoGetParamBufferValue $buffer DatabaseHandle]
GuidoForm AssignMultiDomains {
-layout BoxLayout Y_AXIS
-default_buttons
-help_id 1746
-label "Assign multiple geology domains"
-tip ASSIGNMULTIDOMAINS_FORM_HELP
GuidoPanel topPanel {
-layout BoxLayout X_AXIS
GuidoPanel optionsPanel {
-layout CentreLineLayout
GuidoCheckBox saveToDatabase {
-default false
-label "Save domains to database"
-selected_value Yes
-unselected_value No
-tip ASSIGNMULTIDOMAINS_TIP_0
}
GuidoComboBox domainTable {
-exclusive true
-label "Domain table"
-display_length 10
-dependency {"[ $saveToDatabase getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_2
-null false
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoComboBox domainField {
-exclusive true
-label "Domain field"
-display_length 10
-dependency {"[ $saveToDatabase getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_2
-dependency {"[$domainTable getCurrentValue]" > ""}
-null false
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoCheckBox removePreviousIntervals {
-default false
-label "Remove all previous intervals"
-selected_value Yes
-unselected_value No
-tip ASSIGNMULTIDOMAINS_TIP_1
-dependency {"[ $saveToDatabase getCurrentValue]" == "Yes"}
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoField defaultDomainCode {
-label "Default domain code"
-display_length 12.6
-dependency {"[ $saveToDatabase getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_4
}
GuidoField minimumInterval {
-label "Minimum interval"
-display_length 12.6
-format real_8
-low_bound 0.0
-decimals 5
-default 0.05
-dependency {"[ $saveToDatabase getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_16
}
}
}
GuidoFiller prefixFill1 {
-height 0.25
}
GuidoSeparator sep0 {
}
GuidoFiller prefixFill1 {
-height 0.25
}
GuidoLabel d_label {
-label "Define domain surfaces in bottom up priority and then solids in priority order"
}
GuidoPanel middlePanel {
-layout BorderLayout
GuidoScrollPane domainScroll {
-height 10
GuidoTable domains {
-instances 1 1 100
-interactive true
-position center
GuidoField domainCode {
-label "Domain code"
-display_length 8
-null false
-tip ASSIGNMULTIDOMAINS_TIP_5
}
GuidoComboBox type {
-label "Domain type"
-display_length 8
-exclusive true
-default "surface"
-value_in "solid" "surface"
-null false
-tip ASSIGNMULTIDOMAINS_TIP_14
}
GuidoFileBrowserField fileName {
-display_length 16
-file_mask "*.dtm"
-label "Filename"
-format none
-max_length 252
-translate none
-tip ASSIGNMULTIDOMAINS_TIP_6
}
GuidoComboBox triobject {
-label "Object ID"
-display_length 7
-null false
-tip ASSIGNMULTIDOMAINS_TIP_7
-exclusive false
}
GuidoComboBox trisolation {
-label "Trisolation"
-display_length 7
-tip ASSIGNMULTIDOMAINS_TIP_8
-exclusive false
-format range
}
}
}
}
GuidoFiller filler {
-height 0.25
}
GuidoSeparator sep0 {
}
GuidoPanel add_constraint_panel {
-layout CentreLineLayout
GuidoCheckBox add_constraint {
-label "Add constraint to drillholes"
-default false
-selected_value Yes
-unselected_value No
-tip ASSIGNMULTIDOMAINS_TIP_9
}
}
GuidoPanel constraint_query {
-layout BoxLayout X_Axis
GuidoScrollPane constraintsPane {
-height 5
GuidoTable cons {
-instances 1 1 17
-interactive true
-dependency {"[ $add_constraint getCurrentValue]" == "Yes"}
GuidoTableFieldBrowser field {
-exclusive true
-display_length 13
-label "Field Name"
-max_length 10
-database_handle $dbHandle
-table_handle collar
-tip DB_QUERY_CONSTRAINTS
}
$field updateBrowserList
GuidoComboBox relation {
-default =
-display_length 5
-format none
-label Operand
-max_length 2
-no_mlt
-null false
-value_in < <= > >= <> =
-tip DB_QUERY_CONSTRAINTS
}
GuidoField value {
-display_length 18
-format none
-label "Constraint Value"
-max_length 32
-translate none
-tip DB_QUERY_CONSTRAINTS
}
}
}
GuidoFiller frm00012_31 {
-width 1
}
GuidoPanel load_save_panel {
-layout BoxLayout Y_AXIS
GuidoButton load_button {
-caption Load
-visible true
-width 10
-dependency {"[ $add_constraint getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_13
-action valueChanged {[loadConstraint $cons $field $relation $value]}
}
GuidoButton save_button {
-caption Save
-visible true
-width 10
-dependency {"[ $add_constraint getCurrentValue]" == "Yes"}
-tip ASSIGNMULTIDOMAINS_TIP_15
-action valueChanged {[saveConstraint $cons $field $relation $value]}
}
}
}
GuidoFiller prefixFill1 {
-height 0.25
}
GuidoPanel bottomPanel {
-layout BoxLayout
-border etched true
-label "Save Report to a file (optional)"
GuidoPanel save_report_panel {
-layout CentreLineLayout
GuidoFileBrowserField reportName {
-display_length 18.6
-file_mask "*.not *.csv *.htm *.html *.rtf *.pdf *.ps"
-label "Report filename"
-format none
-max_length 252
-translate none
-tip REPORT_FILE_NAME_TIP
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoFiller prefixFill1 {
-height 0.1
}
GuidoComboBox reportFormat {
-format string
-label "Format"
-display_length 16
-exclusive true
-value_in ".not - Surpac Note File" ".csv - Comma Separated (Spreadsheet)" ".htm - Hypertext Markup Language (Web)" ".html - Hypertext Markup Language (Web)" ".rtf - Rich Text Format (Microsoft Word)" ".pdf - Adobe Acrobat" ".ps - Postscript"
-null false
-tip REPORT_WRITER_OPTIONS_TIP
}
}
}
$domainTable setActionCallback valueChanged {[updateAssignMultiFieldList $domainField $domainTable]}
$domainField setActionCallback valueChanged {[setFieldValidation $domainTable $domainField $defaultDomainCode $domains $domainCode]}
$fileName setActionCallback valueChanged {[getObjectsTrisolationsForMultipleDTMS $fileName $triobject $trisolation $saveToDatabase $type]}
$triobject setActionCallback valueChanged {[triobjectChanged $fileName $triobject $trisolation $type]}
-action initial {[getObjectsTrisolationsForMultipleDTMS $fileName $triobject $trisolation $saveToDatabase $type]}
}
