'========================================================================== '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