Convert STL files from ascii to binary

# -----------------------------------------------------------------------------
# (c) 2018, Johann Oberdorfer - Engineering Support | CAD | Software
#     johann.oberdorfer [at] gmail.com
#     www.johann-oberdorfer.eu
# -----------------------------------------------------------------------------
# This source file is distributed under the BSD license.
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#   See the BSD License for more details.
# -----------------------------------------------------------------------------
#
# Purpose:
#
#	Since the introduction of the 3D-Printing technology, the STL file format
#   has become very popular.
#   There are 2 formats available: ascii and binary STL files, although most
#   CAD programs only allow to export the geometry as an ascii STL file.
#
#   As the file size tends to be very big, I wrote this conversation function.
#
# Revision history:
#   18-01-11: Johann, Initial release
#   18-02-18: Johann, convert binary to ascii is now supported as well
#
# -----------------------------------------------------------------------------
# STL File format (as described in Wikipedia):
#   https://de.wikipedia.org/wiki/STL-Schnittstelle
# -----------------------------------------------------------------------------
#
# ASCII STL format:                # Binary STL format (from Wikipedia):
# solid name(optional) 			   # UINT8[80] – Header
# 	[foreach triangle]             # UINT32 – Number of triangles
# 		facet normal ni nj nk      #
# 		outer loop                 # foreach triangle
# 			vertex v1x v1y v1z     #	REAL32[3] – Normal vector
# 			vertex v2x v2y v2z     #	REAL32[3] – Vertex 1
# 			vertex v3x v3y v3z     #	REAL32[3] – Vertex 2
# 		endloop                    #	REAL32[3] – Vertex 3
# 	endfacet                       #	UINT16 – Attribute byte count
# endsolid name(optional)          # end         (... or color code)
#		
# -----------------------------------------------------------------------------
# -----------------------------------------------------------------------------

package provide stlutil 0.1

namespace eval ::stlutil {
	namespace export convert_stl_file

	variable banner
	
	set banner \
		"STL file created by stlutil 0.1 - http://www.Johann-Oberdorfer.eu"
	
	proc ConvertVertexToBinary {x y z} {
		
		set x [expr {double($x)}]
		set y [expr {double($y)}]
		set z [expr {double($z)}]
		
		# REAL32
		# the tcl documentation says:
		# r: This form stores the single-precision floating point numbers
		# in little-endian order. This conversion only produces meaningful output
		# when used on machines which use the IEEE floating point representation
		# (very common, but not universal.)
		#
		return [binary format r3 [list $x $y $z]]
	}
	
	proc ConvertIntToBinary {type num} {
		
		switch -- $type {
			"UINT8"  { return [eval binary format c $num] }
			"UINT16" { return [eval binary format s $num] }
			"UINT32" { return [eval binary format i $num] }
		}
	}

	proc CheckMachineByteOrder {} {
		if { $::tcl_platform(byteOrder) != "littleEndian" } {
			return -code error "your platform's byteOrder does not support \"littleEndian\""
		}
		return 1
	}
	
	proc GetByteLength {type} {
		switch -- $type {
			"UINT8"  { return [string length [binary format c 0]] }
			"UINT16" { return [string length [binary format s 0]] }
			"UINT32" { return [string length [binary format i 0]] }
			"REAL"   { return [string length [binary format r 0.000000E+00]] }
		}
	}


	proc SientificNotation { value } {
		set val [format "%- 1.6E" $value]
		
		# -not required-
		# workaround for sientific notation which has 3 digits,
		# maybe this has changed in tcl8.6 ?...
		# set val [regsub -all "E\\+0" $val "E+"]
		# set val [regsub -all "E-0" $val "E-"]

		return $val
	}

	
	proc convert_stl_file {fname} {
		variable banner

		# k.o. criteria ?
		if { ![CheckMachineByteOrder] } { return }
	
		set fp [open $fname "r"]
		
		# read first line & check if binary or ASCII
		#
		set row [string tolower [gets $fp]]
		
		if { [string first "solid" $row] != -1 } {
			
			# -----------------------
			# convert ascii to binary
			# -----------------------

			set t0 [clock milliseconds]
			set output_filename "[file rootname $fname]-binary.stl"
			
			puts "Writing BINARY STL-file:"
			puts "   $output_filename"
			
			set ofp [open $output_filename "w"]
			fconfigure $ofp -translation binary
			
			# UINT8 / write an empty header block 80 bit long...
			puts -nonewline $ofp $banner
			
			set i 0
			while {$i < [expr {80 - [string length $banner]}]} {
				puts -nonewline $ofp [ConvertIntToBinary "UINT8" 0]
				incr i
			}
			
			# UINT32 / integer represents the number of triangles,
			# which is going to be filled later on...
			#
			puts -nonewline $ofp [ConvertIntToBinary "UINT32" 0]
			
			set triangle_cnt 0
			
			while {![eof $fp]} {
				
				# ignore whitespaces and empty lines (if any) ...
				if { [set row [string tolower [string trim [gets $fp]]]] == "" } {
					continue
				}
				
				# ... end of endsolid data stream reached ?
				if { [string first "endsolid" $row] != -1 } {
					break
				}
				
				# -------------------------------------------
				# data starts here - within the data block,
				# we hope there will be no empty line (!) ...
				# -------------------------------------------
				set keystr "facet normal"
				
				if { [set idx [string first $keystr $row]] != -1} {
					
					incr triangle_cnt
					
					set idx1 [expr { $idx + [string length $keystr] }]
					set normal [string range $row $idx1 end]
					
					set normalX [string trim [lindex $normal 0]]
					set normalY [string trim [lindex $normal 1]]
					set normalZ [string trim [lindex $normal 2]]
					# puts ">>> $normalX : $normalY : $normalZ"
					
					puts -nonewline $ofp [ConvertVertexToBinary $normalX $normalY $normalZ]
					
					# 'outer loop'
					gets $fp
					
					# we expect to have 3 vertexes here:
					# ------------------------------------
					set keystr "vertex"
					
					for {set i 0} {$i < 3} {incr i} {
						set row [string tolower [string trim [gets $fp]]]
						
						if { [set idx [string first $keystr $row]] != -1} {
							
							set idx1 [expr { $idx + [string length $keystr] }]
							set vertex [string range $row $idx1 end]
							
							set vertexX [string trim [lindex $vertex 0]]
							set vertexY [string trim [lindex $vertex 1]]
							set vertexZ [string trim [lindex $vertex 2]]
							# puts "--> $i: $vertexX : $vertexY : $vertexZ"
							
							puts -nonewline $ofp [ConvertVertexToBinary $vertexX $vertexY $vertexZ]
						} else {
							return -code error "mismatch in STL file format"
						}
					}
					
					# "endloop" + "endfacet"
					gets $fp
					gets $fp
					
					# UINT16: after each "data block", write (attribute byte count)
					#
					puts -nonewline $ofp [ConvertIntToBinary "UINT16" 0]
				}
				# -only for development-
				# if {$triangle_cnt > 40} {break}
			}
			
			# UINT32 / and finally, write the number of triangles...
			#
			seek $ofp [expr {[GetByteLength "UINT8"] * 80}] start
			puts -nonewline $ofp [ConvertIntToBinary "UINT32" $triangle_cnt]
			
			close $ofp
			
			puts ""
			puts "Conversion finished:"
			puts "  - The file contains $triangle_cnt triangles."
			puts "  - Elapsed time: [expr ( [clock milliseconds] - $t0 ) / 1000.0] sec."
			puts ""
			
		} else {

			# -----------------------
			# convert binary to ascii
			# -----------------------
			
			set t0 [clock milliseconds]
			set output_filename "[file rootname $fname]-ascii.stl"
			
			puts "Writing ASCII STL-file:"
			puts "   $output_filename"

			set ilen [GetByteLength "UINT32"]
			set rlen [expr {[GetByteLength "REAL"] * 3}]

			set ofp [open $output_filename "w"]

			fconfigure $fp -translation binary
			seek $fp [expr {[GetByteLength "UINT8"] * 80}] start
			
			# "UINT32", get the number of triangles:
			binary scan [read $fp $ilen] i triangle_cnt
			
			puts $ofp "solid STL"
			for {set cnt 0} {$cnt < $triangle_cnt} {incr cnt} {

				binary scan [read $fp $rlen] rrr normalX normalY normalZ
				binary scan [read $fp $rlen] rrr vertexAX vertexAY vertexAZ
				binary scan [read $fp $rlen] rrr vertexBX vertexBY vertexBZ
				binary scan [read $fp $rlen] rrr vertexCX vertexCY vertexCZ

				seek $fp [GetByteLength "UINT16"] current
				
				set normalX [SientificNotation $normalX]
				set normalY [SientificNotation $normalY]
				set normalZ [SientificNotation $normalZ]
				
				set vertexAX [SientificNotation $vertexAX]
				set vertexAY [SientificNotation $vertexAY]
				set vertexAZ [SientificNotation $vertexAZ]
				
				set vertexBX [SientificNotation $vertexBX]
				set vertexBY [SientificNotation $vertexBY]
				set vertexBZ [SientificNotation $vertexBZ]
				
				set vertexCX [SientificNotation $vertexCX]
				set vertexCY [SientificNotation $vertexCY]
				set vertexCZ [SientificNotation $vertexCZ]
				
			    puts $ofp "facet normal $normalX $normalY $normalZ"
				puts $ofp " outer loop"
				puts $ofp "  vertex $vertexAX $vertexAY $vertexAZ"
				puts $ofp "  vertex $vertexBX $vertexBY $vertexBZ"
				puts $ofp "  vertex $vertexCX $vertexCY $vertexCZ"
				puts $ofp " endloop"
				puts $ofp "endfacet"
			}
			puts $ofp "endsolid STL"

			close $ofp
			
			puts ""
			puts "Conversion finished:"
			puts "  - The file contains $triangle_cnt triangles."
			puts "  - Elapsed time: [expr ( [clock milliseconds] - $t0 ) / 1000.0] sec."
			puts ""
		}
		
		close $fp
	}
}

Test:

set dir [file dirname [info script]]
lappend auto_path [file join "." $dir]

package require Tk
package require stlutil

# -during development-
set TESTMODE 1

if {$TESTMODE == 1} {
	catch {
		console show
		console eval {wm protocol . WM_DELETE_WINDOW {exit 0}}
	}
}

set fname [file join $dir "teapot.stl" ]
stlutil::convertascii2binary $fname