dxf2xyz.bas

Surfer是地学中常用的一个软件

'==========================================================================
'DXF2XYZ.BAS
'
'This script extracts X,Y,Z information from a 3D DXF file
'
'	Original from USGS, Z capability added by Juan Carlos Colichon, Lima Peru
'	Port from QBASIC to Surfer 6 Scripter by TB 6/19/95
'
'												SKP 10/99 Surfer 7
'==========================================================================

Sub Main
	'Declare the variable that will reference the application
	'Dim SurferApp As Object

	'Creates an instance of the Surfer Application object 
	' and assigns it to the variable named "SurferApp"
	'Set SurferApp = CreateObject("Surfer.Application")

	'Makes Surfer visible
	'SurferApp.Visible = True
	
	BEGINNING:
	'(JCC changed BLN to DAT)
	Count = 0
	Debug.Print "---- Begin Program: ";Time;" ----------------------------"
	Debug.Print "     This program produces XYZ data from AutoCAD polylines"
	Debug.Print "             It expects the .DXF file for input"
	Debug.Print "             It produces the .DAT file as output"
	Debug.Print
	
	'Get Input and export file names
	FileIn$=InputBox$("Enter path, filename, and extension of the DXF file.")
	If FileIn$= "" Then End
	Open FileIn$ For Input As #1
	FileOut$=InputBox$("Enter path, filename, and extension of the DAT file.")
	If FileOut$="" Then End
	Open "x.Tmp" For Output As #2
	Open FileOut$ For Output As #3
	
	'Begin Section to Skip Header Data
	Polycount = 1
	
	BEGINPOLYLINE:'  LOOK FOR POLYLINE BEGINNING IN THE FILE
		If EOF(1) = -1 Then End
		Line Input #1, LI$
		'PRINTLINE	
		POLYLINE$=Mid$(LI$,1,8)	
		If POLYLINE$<>"POLYLINE" Then GoTo BEGINPOLYLINE ' LOOP UNTIL FIND A POLYLINE
		Debug.Print "WORKING ON POLYLINE NUMBER: ";POLYCOUNT
  	
  	LOOKFORLAYERFLAG:' LOOK FOR THE LAYER FLAG
  		Line Input #1, LI$ ' SKIP THIS LINE (SHOULD BE LAYERFLAG "8")
  		Line Input #1, LI$
  		LAYERNAME$=Left$(LI$,30)
  		Debug.Print "PROCESSING POLYLINE ON LAYER: ";LAYERNAME$
  		
  	BEGINVERTEX:' LOOK FOR BEGINNING VERTEX AFTER FINDING POLYLINE
  		Line Input #1,LI$
  		'PRINTLINE  
  		VERTEX$=Left$(LI$,6)
  		If VERTEX$<>"VERTEX" Then GoTo BEGINVERTEX
  		VERTEXCOUNT=0 	' START COUNTING VERTICES
  		
  	DOCOORDS:			' BEGINNING OF SECTION TO DO X,Y,Z COORDS
  		VERTEXCOUNT=VERTEXCOUNT+1
  		Debug.Print "PROCESSING VERTEX NUMBER: ";VERTEXCOUNT
  		
  	DOXCOORD:			' LOOK FOR X COORD FLAG
  		Line Input #1,LI$
  		'PRINTLINE  
  	LOOKFORXCOORDFLAG: 
  		XCOORDFLAG$=Mid$(LI$,1,3)
  		If XCOORDFLAG$<>" 10" Then GoTo DOXCOORD
  	GETXCOORD:
  		Line Input #1,LI$
  		'PRINTLINE  
  		X$=Mid$(LI$,1,25)
  		
  	DOYCOORD:			' LOOK FOR Y COORD FLAG
  		Line Input #1,LI$
  		'PRINTLINE 
  	LOOKFORYCOORDFLAG:
  		YCOORDFLAG$=Mid$(LI$,1,3)
  		If YCOORDFLAG$<>" 20" Then GoTo DOYCOORD
  	GETYCOORD:
  		Line Input #1,LI$
  		'PRINTLINE  
  		Y$=Mid$(LI$,1,25)
  		
  	DOZCOORD:			' LOOK FOR Z COORD FLAG    (JCC)
  		Line Input #1,LI$
  		'PRINTLINE
  	LOOKFORZCOORDFLAG:
  		ZCOORDFLAG$=Mid$(LI$,1,3)
  		If ZCOORDFLAG$<>" 30" Then GoTo DOZCOORD
  	GETZCOORD:
  		Line Input #1,LI$
  		'PRINTLINE
  		Z$=Mid$(LI$,1,25)
  		
  	WRITEXYCOORDS:                  '(JCC).  Round values - TB1099
  		Print #2, Round(Val(X$),14);", ";Round(Val(Y$),14);", ";Round(Val(Z$),14)
  		Debug.Print "  ";Round(Val(X$),14);", ";Round(Val(Y$),14);", ";Round(Val(Z$),14)

	CHECKFOREND: 'END OF X,Y,Z TRIPLET, GET NEXT OR NEW LINE OR END POLYLINE
  		Line Input #1, LI$
  		SEQEND$=Left$(LI$,6)
  		If SEQEND$="SEQEND" Then GoTo ENDPOLYLINE
  		If SEQEND$="VERTEX" Then GoTo DOCOORDS
  		GoTo CHECKFOREND
  		
  	ENDPOLYLINE: ' SECTION TO END THE POLYLINE INFO
  	'If VERTEXCOUNT=2 Then VERTEXCOUNT=3:Print #2, X$;",";Y$
  	'THE ABOVE FIXES A GLITCH IN SURFER...NO 2 POINT LINES ALLOWED
  	'CORRECTED BY DUPLICATING THE 2ND COORD. FOR THE 3RD COORD.
  	Close #2
  	Open "x.TMP" For Input As #2
  	While Not EOF(2)
  		Line Input #2,LI$
  		'PRINTLINE
  		Print #3, LI$
  	Wend
  	Close #2 ' CLOSE AFTER READING DATA
  	Open "x.TMP" For Output As #2    'OPEN TEMP FILE AGAIN FOR NEXT LINE
  	POLYCOUNT=POLYCOUNT+1
  	GoTo BEGINPOLYLINE			   ' GO BACK AND LOOK FOR NEXT POLYLINE
  	
  	
  	Rem ***             BEGIN ERROR ROUTINES
  	Beep()
  	Beep()
  	Debug.Print "AN ERROR HAS OCCURED TRYING TO OPEN THE FILE: "; FILEIN$;".  PLEASE CHECK THE NAME AND TRY AGAIN..."
  	Ans%=MsgBox("AN ERROR HAS OCCURED TRYING TO OPEN THE FILE.  PLEASE CHECK THE NAME AND TRY AGAIN. Exit the program?",4)
  	If ans%=1 Then 
  		End
  	Else
  		GoTo beginning  
  	End If
  	
  	
  	ENDFILE:' ***     BEGIN ERROR ROUTINE FOR END OF FILE
  	Debug.Print 
  	Debug.Print "END OF FILE HAS BEEN REACHED"
  	Debug.Print "CLOSING INPUT AND OUTPUT FILES"
  	Debug.Print "PROGRAM ENDING WAS NORMAL"
  	Close
End Sub
  
'==============================================================================
'***   BEGIN SUBROUTINES
Sub Printline
	'The next line can be commented out to not show the carets (>) in the Immediate Window
	Debug.Print ">";LI$;"                               "
End Sub