proc selectpoint {message Pthandlet xt yt zt} {
global SCL_OK
upvar $Pthandlet Pthandle
upvar $xt x
upvar $yt y
upvar $zt z
SclGetActiveViewport Viewport
$Viewport SclGetActiveLayer Swahandle
$Swahandle SclGetStrings Strings
if {[$Strings SclCountItems] < 1} {
puts "The active layer does not contain any points: Function cancelled."
return 1
}
set ActiveLayer 0
while {$ActiveLayer != 1} {
if {[SclSelectPoint Pthandle "$message" layer stringid segmentnum pointnum x y z desc] != $SCL_OK} {
puts "$message - cancelled"
return 1
}
if {$layer != [$Swahandle SclGetId]} {
set message "Layer not active: re-select"
} else {
set ActiveLayer 1
}
}
}
proc countswapts {} {
global SCL_TRUE
set pts 0
SclGetActiveViewport ViewportHandle
$ViewportHandle SclGetActiveLayer Swahandle
$Swahandle SclGetStrings Stringshandle
set	strings [$Stringshandle SclCountItems]
$Stringshandle SclIterateFirst swait
while {[$swait SclIterateNext Strhandle] == $SCL_TRUE} {
$Strhandle SclIterateFirst strit
while {[$strit SclIterateNext Seghandle] == $SCL_TRUE} {
set pts [expr $pts + [$Seghandle SclCountItems]]
}
}
return $pts
}
proc line3dlength {x1 y1 z1 x2 y2 z2} {
set xdiff [SclExpr $x1 - $x2]
set ydiff [SclExpr $y1 - $y2]
set zdiff [SclExpr $z1 - $z2]
set tlength3d [SclExpr (sqrt (([SclExpr sqrt (($xdiff * $xdiff) + ($ydiff * $ydiff))]\
* [SclExpr sqrt (($xdiff * $xdiff) + ($ydiff * $ydiff))]) + ($zdiff * $zdiff)))]
return $tlength3d
}
proc line2dlength {x1 y1 x2 y2} {
set tlength2d [SclExpr SQRT((($x2 - $x1) * ($x2 - $x1)) + (($y2 - $y1) * ($y2 - $y1)))]
return $tlength2d
}
proc linetrend {x1 y1 x2 y2 trend} {
upvar $trend ttrend
set dx [SclExpr $x2 - $x1]
set dy [SclExpr $y2 - $y1]
set adx [SclExpr ABS($dx)]
set ady [SclExpr ABS($dy)]
set dist [SclExpr SQRT((($x2 - $x1) * ($x2 - $x1)) + (($y2 - $y1) * ($y2 - $y1)))]
if {$dist == 0} {
set ttrend 0
return
}
if {$adx <= $ady} {
set ang [SclExpr ATAND($adx / $ady)]
} else {
set ang [SclExpr 90 - ATAND($ady / $adx)]
}
if {$dx >= 0} {
if {$dy >= 0} {
set ttrend $ang
return
}
set ttrend [SclExpr 180 - $ang]
return
}
if {$dy >= 0} {
set ttrend [SclExpr 360 - $ang]
return
}
set ttrend [SclExpr 180 + $ang]
}
proc lineplunge {x1 y1 z1 x2 y2 z2 plunge} {
upvar $plunge tplunge
set tplunge [SclExpr ACOSD([line2dlength $x1 $y1 $x2 $y2] / [line3dlength $x1 $y1 $z1 $x2 $y2 $z2])]
if {$z2 > $z1} {
set tplunge [SclExpr -1 * ABS($tplunge)]
}	else {
set tplunge [SclExpr ABS($tplunge)]
}
}
proc segduplicates {DupSeghandle trapdist dupsdeletedt} {
global SCL_TRUE
upvar $dupsdeletedt deleted
set deleted 0
set i 0
$DupSeghandle SclGetItem Pthandle $i
incr i
set x1 [$Pthandle SclGetValueByName x]
set y1 [$Pthandle SclGetValueByName y]
set z1 [$Pthandle SclGetValueByName z]
while {$i < [$DupSeghandle SclCountItems]} {
$DupSeghandle SclGetItem Pthandle $i
set x2 [$Pthandle SclGetValueByName x]
set y2 [$Pthandle SclGetValueByName y]
set z2 [$Pthandle SclGetValueByName z]
if {[line3dlength $x1 $y1 $z1 $x2 $y2 $z2] < $trapdist && [SclExpr [$Pthandle SclGetId]] != 1} {
if {[SclExpr [$Pthandle SclGetId] + 1] == [$DupSeghandle SclCountItems]} {
$DupSeghandle SclGetItem Pthandle [SclExpr $i - 1]
SclDestroy Pthandle
incr deleted
return
}
SclDestroy Pthandle
incr deleted
} else {
set x1 $x2
set y1 $y2
set z1 $z2
incr i
}
}
}
proc raypoint {trend plunge dist1 x1 y1 z1 x2 y2 z2} {
upvar $x2 tx2
upvar $y2 ty2
upvar $z2 tz2
set dist2 [SclExpr (cosd($plunge) * $dist1)]
set tx2 [SclExpr $x1 + (sind($trend) * $dist2)]
set ty2 [SclExpr $y1 + (cosd($trend) * $dist2)]
set tz2 [SclExpr $z1 - (sind($plunge) * $dist1)]
}
proc processseg	{Seghandle mindist trapdist} {
set i 0
$Seghandle SclGetItem Pthandle1 $i
incr i
while {$i < [$Seghandle SclCountItems]} {
set ipts 0
$Seghandle SclGetItem Pthandle2 $i
set x1 [$Pthandle1 SclGetValueByName x]
set y1 [$Pthandle1 SclGetValueByName y]
set z1 [$Pthandle1 SclGetValueByName z]
set x2 [$Pthandle2 SclGetValueByName x]
set y2 [$Pthandle2 SclGetValueByName y]
set z2 [$Pthandle2 SclGetValueByName z]
set length [line3dlength $x1 $y1 $z1 $x2 $y2 $z2]
if {$length > $mindist} {
linetrend $x1 $y1 $x2 $y2 trend
lineplunge $x1 $y1 $z1 $x2 $y2 $z2 plunge
set ipts [SclExpr int ($length / $mindist)]
set ptspacing [SclExpr ($length / ($ipts + 1))]
set n 1
while {$n <= $ipts} {
raypoint $trend $plunge $ptspacing $x1 $y1 $z1 x2 y2 z2
$Seghandle SclCreatePoint Pthandlei [SclExpr [$Pthandle1 SclGetId] + $n]
$Pthandlei SclSetValueByName x $x2
$Pthandlei SclSetValueByName y $y2
$Pthandlei SclSetValueByName z $z2
set x1 $x2
set y1 $y2
set z1 $z2
set $ptspacing [SclExpr $ptspacing + $ptspacing]
incr n
}
}
set i [SclExpr $i + $ipts]
$Seghandle SclGetItem Pthandle1 $i
incr i
}
}
set form {GuidoForm nameform {
-default_buttons
-label "Insert points"
-tip "NORMALISE_SEGMENTS_0"
-help_id 220
GuidoField mindist {
-label "Maximum distance between points"
-format real_8
-translate none
-display_length 15
-max_length 50
-low_bound 0.01
-tip "NORMALISE_SEGMENTS_1"
}
GuidoPanel panel1 {
-label "Operate on"
-layout BoxLayout X_AXIS
GuidoButtonGroupPanel type {
GuidoRadioButton Segment {
-caption Segment
-selected_value g
}
GuidoRadioButton String {
-caption String
-selected_value s
}
GuidoRadioButton Layer {
-caption Layer
-selected_value l
}
}
}
GuidoCheckBox clean {
-label "Remove duplicates"
-selected_value "y"
-unselected_value "n"
-default "y"
-tip "NORMALISE_SEGMENTS_2"
}
GuidoField trapdist {
-dependency {"[$clean getCurrentValue]" == "y"}
-label "Trap distance for removing duplicates"
-format real_8
-translate none
-display_length 15
-max_length 50
-low_bound 0
}
}
}
SclCreateGuidoForm form_handle $form {
set mindist 10
set trapdist 0.05
}
$form_handle SclRun {}
if {$_status == "cancel"} {
return
}
set pts [countswapts]
set dupsdeleted 0
set dupsdel 0
if {$type == "l"} {
set dupsdel 0
SclGetActiveViewport ViewportHandle
$ViewportHandle SclGetActiveLayer Swahandle
$Swahandle SclGetStrings Stringshandle
$Stringshandle SclIterateFirst swait
while {[$swait SclIterateNext Strhandle] == $SCL_TRUE} {
$Strhandle SclIterateFirst strit
while {[$strit SclIterateNext Seghandle] == $SCL_TRUE} {
processseg $Seghandle $mindist $trapdist
if {$clean == "y"} {
segduplicates $Seghandle $trapdist dupsdeleted
set dupsdel [SclExpr $dupsdel + $dupsdeleted]
}
$Seghandle SclErase
$Seghandle SclDraw "style=ssi_method=line|marker"
SclPause 0.1
}
}
if {$clean == "y"} {
puts "$dupsdel duplicate points deleted"
}
set noswapts [countswapts]
puts "[expr $noswapts - $pts + $dupsdel] points inserted"
return
}
while {0 == 0} {
if {$type == "g"} {
set message "Select segment"
} elseif {$type == "s"} {
set message "Select string"
}
if {[selectpoint $message Pthandle x y z] == 1} {
return
}
if {$type == "s"} {
set dupsdel 0
$Pthandle SclGetParent Seghandle
$Seghandle SclGetParent Strhandle
$Strhandle SclIterateFirst segit
while {[$segit SclIterateNext Seghandle] == $SCL_TRUE} {
processseg $Seghandle $mindist $trapdist
if {$clean == "y"} {
segduplicates $Seghandle $trapdist dupsdeleted
set dupsdel [SclExpr $dupsdel + $dupsdeleted]
}
$Seghandle SclErase
$Seghandle SclDraw "style=ssi_method=line|marker"
SclPause 0.1
}
if {$clean == "y"} {
puts "$dupsdel duplicate points deleted"
}
set noswapts [countswapts]
puts "[expr $noswapts - $pts + $dupsdel] points inserted"
set pts $noswapts
}
if {$type == "g"} {
$Pthandle SclGetParent Seghandle
processseg $Seghandle $mindist $trapdist
if {$clean == "y"} {
segduplicates $Seghandle $trapdist dupsdeleted
puts "$dupsdeleted duplicate points deleted"
}
set noswapts [countswapts]
puts "[expr $noswapts - $pts + $dupsdeleted] points inserted"
set pts $noswapts
$Seghandle SclErase
$Seghandle SclDraw "style=ssi_method=line|marker"
SclPause 0.1
}
}
