This Visual Basic Code was used to translate the ARC_Info
polygons for state and county boundaries into BNA format.
It is offered here without support.

'declarations
Dim poly_part(1 To 4000)  As Integer
Dim poly_num(1 To 4000) As String, polynumu(1 To 4000) As String
Dim fcpu(1 To 4000)  As String
Dim ctru(1 To 4000) As Integer
Dim penup As Integer, id_seq_n As Long, seq_n As Long
Dim object_id As String, object_nam As String
Dim num_points As Long, object_typ As String
Dim lngd As Double, latd As Double
Dim maxlng As Double, minlng As Double
Dim maxlat As Double, minlat As Double


Sub ARC_BNA_Click ()
  'NOTE: limitation. This translator can handle complex
  'polys with one lake or island, but not more complex
  'polys. See notes at '++++'.

  'for virginia 3 counties have two lakes
    'Rockbridge, Allegheny, and Augusta
  
  ' This is a simple translation of ARC polys
  ' in the form rec1 = seq#, intpoint, recs2-(n-1)=point
  ' rec n="END" for each poly
  'file is terminated with a final "END" Record
  'Problem:
  ' Input polys are not grouped by state but wander
  ' over several states.
  'must either preprocess the input, complicate the
  'thruput or postprocess the output
  'developed Arc_preproc to distribute tangled counties
  'into respective states.
  Dim poly As Integer, lng As Double, lat As Double, ctr As Integer
  Dim ctrus As Integer, newpoly As Integer, i As Integer
  Dim ctrpart As Integer, lake As Integer, ercode As Integer
  Dim db As Database, tb As table
  Set db = OpenDatabase("d:\lvset1", False, False, "dbase III;")
  Set tb = db.OpenTable("coname")
  tb.Index = "coname"
  '--- disable indiv. state entry
  'f$ = "d:\lvset1\" + InputBox$("Enter path\file (.dat in, .bna out assumed)")
  '--- inset auto driver from file stlist.txt
  ' put one or more state codes in following file, then start
  Open "d:\lvset1\stlist.txt" For Input As #5
  Do While Not EOF(5)
    Input #5, st$
    text1.Text = st$
    f$ = "d:\lvset1\" + st$
  '--- etc  put loop at end
  Table_Prep f$, ctrpart, ctrus' sub prepares lookup table
  Open f$ + ".dat" For Input As #1
  Line Input #1, a$ ' this program requires look ahead for
       ' lakes, arc info uses -99999 on line following END
       ' to indicate
  outerflag = -1
  '--------------------------------
  Do While outerflag
    parse_line_1 a$, poly, lng, lat
    'Debug.Print a$, poly, lng, lat
    Unique_Poly_Lookup poly, ctrpart, ctrus, i, ercode'sub returns the unique poly index i
    'Debug.Print poly, i, polynumu(i)
    ctr = 0: lake = False
    If ctru(i) = 0 Then
      Open "d:\temp\" + polynumu(i) For Output As #2
    Else
      Open "d:\temp\" + polynumu(i) For Append As #2
    End If
    innerflag = -1
    '--------------------------------------
    Do While innerflag
      Line Input #1, a$
      If InStr(a$, "END") = 0 Then  'not END
        parse_lines a$, lng, lat
        Print #2, lng, lat: ctr = ctr + 1
        If ctr = 1 And ctru(i) = 0 Then fcpu(i) = a$
        h$ = a$
      Else                         ' END
        If EOF(1) Then
          outerflag = 0
          innerflag = 0
        Else
          Line Input #1, a$
          If InStr(a$, "-99999") Then
            '++++ to correct this program to overcome
            'limitation stated at top of listing,
            'run out all recs until 'END' followed by
            'an fcp. See further note below at '++++

            'fcp$ = h$
            lake = True
          Else
            If InStr(a$, "END") Then '2d END
              outerflag = 0
              innerflag = 0
            Else
              innerflag = 0 'this a$ will be new first rec
            End If
          End If
        End If
      End If
    Loop
    ' -----------------------------------------
    ' when the changes indicated at '++++ above are made
    ' the following if block can be deleted (?)
    If ctru(i) > 0 Or lake Then   ' repeat first coordinate pair
      fcp$ = fcpu(i)
      parse_lines fcp$, lng, lat
      Print #2, lng, lat: ctr = ctr + 1
      'fcp$ = ""
    End If
    ctru(i) = ctru(i) + ctr
    Close #2
    '-------------------------------------- END temp file write
  Loop
  Close #1
  '------------ collect multiple files into one.
  Open f$ + ".bna" For Output As #2
  For i = 1 To ctrus
    x$ = "d:\temp\" + polynumu(i)
    Open x$ For Input As #1
    st$ = Mid$(polynumu(i), 1, 2): co$ = Mid$(polynumu(i), 3, 3)
    tb.Seek "=", st$, co$
    If nomatch Then Stop Else nam$ = tb("areaname")
    
    Write #2, st$, co$, nam$, ctru(i)
    Debug.Print polynumu(i), ctru(i)
    Do While Not EOF(1)
      Line Input #1, a$
      Print #2, a$
      'Debug.Print a$
      'Stop
    Loop
    Close #1
    polynumu(i) = ""
    ctru(i) = 0
  Next i
  Close #2
  For i = 1 To ctrpart
    poly_part(i) = 0
    poly_num(i) = ""
  Next i
  'Open "d:\temp\" + polynumu(ctrus + 1) For Input As #1
  'Open "c:\temp\bad_polys" For Output As #2
  'Do While Not EOF(1)
   ' Line Input #1, a$
    'Print #2, a$
  'Loop
  'Close #1: Close #2
    '-----------------
Loop 'added for auto driver
End Sub

Sub Table_Prep (f$, ctrpart, ctru)
  '--this sub has no output. It simply prepares a lookup table.
  '--arrays are global
  Dim newpoly As Integer
  Open f$ + "A.dat" For Input As #1
  ctr = 0: ctru = 0: ctrpart = 0
  Do While Not EOF(1)
    ctr = ctr + 1
    Input #1, poly_part(ctr)
    Input #1, poly_num(ctr) 'area code, string, takes
                            'remainer of line incl blanks
    strip_out_blanks poly_num(ctr)
    i = 1: newpoly = True
    If ctr > 1 Then
      Do While i < ctr
        If poly_num(i) = poly_num(ctr) Then
          newpoly = False
          Exit Do
        End If
        i = i + 1
      Loop
      If newpoly Then
        ctru = ctru + 1
        polynumu(ctru) = poly_num(ctr)
      End If
    Else ' ctr=1
      ctru = ctru + 1
      polynumu(ctru) = poly_num(ctr)
    End If
  Loop
  polynumu(ctru + 1) = "Bad_Poly"' no poly_part number in <>A.dat file.
  ctrpart = ctr
  Close #1
  ' ------------------------------ END of table prep
End Sub

Sub parse_line_1 (a As String, poly As Integer, lng As Double, lat As Double)
dele_blanks a 'delete lead blanks
x = InStr(a, " ")
If x > 0 Then
  poly = Val(Mid$(a, 1, x - 1))
  a = Mid$(a, x)
Else
  Print "Error. No polygon number on line 1"
  Stop
End If
dele_blanks a 'delete lead blanks
x = InStr(a, " ")
If x > 0 Then
  lng = Val(Mid$(a, 1, x - 1))
  a = Mid$(a, x)
Else
  Print "Error. No longitude on line 1"
  Stop
End If
dele_blanks a  'delete lead blanks
x = InStr(a, " ")
If x > 0 Then
  lat = Val(Mid$(a, 1, x - 1))
  a = Mid$(a, x)
Else
  lat = Val(a)
End If
End Sub

Sub parse_lines (ByVal a As String, lng As Double, lat As Double)
dele_blanks a 'delete lead blanks
x = InStr(a, " ")
If x > 0 Then
  lng = Val(Mid$(a, 1, x - 1))
  a = Mid$(a, x)
Else
  Print "Error. No longitude on line 1"
  Stop
End If
dele_blanks a  'delete lead blanks
x = InStr(a, " ")
If x > 0 Then
  lat = Val(Mid$(a, 1, x - 1))
  a = Mid$(a, x)
Else
  lat = Val(a)
End If
End Sub

Sub Unique_Poly_Lookup (poly As Integer, ctrpart As Integer, ctru As Integer, i As Integer, ercode As Integer)
    ercode = 0
    i = 1
    Do While i <= ctrpart
      If poly = poly_part(i) Then
        'oh$ = "c:\temp\" + poly_num(i)
        Exit Do
      End If
      i = i + 1
    Loop
    If poly <> poly_part(i) Then
      'MsgBox "Poly not found in Poly part table"
      i = ctru + 1: ercode = -1
      Exit Sub
    End If
    p$ = poly_num(i) 'no accounting of which are multiples and which are ok as is
    i = 1
    Do While p$ <> polynumu(i) And i < ctru
      i = i + 1
    Loop
    If p$ <> polynumu(i) Then Stop
    If i = 0 Then Stop
    'i now points to polynumu
    '---------------------------------end POLYNUMU LOOKUP
End Sub