'***********************ВНИМАНИЕ*************************'
' Следующий ниже код нужно добавить в стандартный модуль '
'                      MS Excel!!!                       '
'*********************************************************

'//////////////////NOTE/////////////////////////////////
' You will need to add a reference to the AutoCAD 2000
' Type Library to run this example book. Use the "Tools -
' References" menu. If you prefere you can switch to late
' binding by changeing the AutoCAD types to generic objects

'//////////////////ПРИМЕЧАНИЕ///////////////////////////////
' Перед использованием представленных в этом блоке процедур
' Вы должны создать в проекте ссылку на библиотеку AutoCAD 2000
' Type Library (файл acad.tlb, обычно он находится в корневой 
' папке AutoCAD). Для этого выберите пункт меню "Tools -
' References в редакторе VBA от MS Excel

Option Explicit

Public Sub ImportPoints()
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Dim objEnt As AcadEntity
  Dim varPnt As Variant
  Dim strPrmpt As String
  Dim intVCnt As Integer
  Dim varCords As Variant
  Dim varVert As Variant
  Dim varCord As Variant
  Dim varNext As Variant
  Dim intCrdCnt As Integer
  On Error GoTo Err_Control
  Set objApp = GetObject(, "AutoCAD.Application")
  Set objDoc = objApp.ActiveDocument
  AppActivate objApp.Caption
  objDoc.Utility.GetEntity objEnt, varPnt
  If TypeOf objEnt Is AcadLWPolyline Then
    AppActivate Application.Caption
    varCords = objEnt.Coordinates
    For Each varVert In varCords
      intVCnt = intVCnt + 1
    Next
    For intCrdCnt = 0 To intVCnt / 2 - 1
      varCord = objEnt.Coordinate(intCrdCnt)
      Application.Cells(intCrdCnt + 1, 1).Value = varCord(0)
      Application.Cells(intCrdCnt + 1, 2).Value = varCord(1)
    Next intCrdCnt
  Else
    MsgBox "Selected entity was not a LWPolyline"
  End If
Exit_Here:
  If Not objApp Is Nothing Then
    Set objApp = Nothing
    Set objDoc = Nothing
  End If
  Exit Sub
Err_Control:
  MsgBox Err.Description
  Resume Exit_Here
End Sub

Public Sub ExportPoints()
  Dim vertlist() As Double
  Dim objApp As AcadApplication
  Dim objDoc As AcadDocument
  Dim RowCount As Integer
  Dim strPrmpt As String
  Dim intCnt As Integer
  Dim objCell As Object
  Dim objSheet As Worksheet
  On Error GoTo Err_Control
  Set objSheet = ThisWorkbook.Sheets(1)
  Set objApp = GetObject(, "AutoCAD.Application")
  Set objDoc = objApp.ActiveDocument
  RowCount = objSheet.UsedRange.Rows.Count
  ReDim vertlist((RowCount * 2) - 1)
  RowCount = 1
  For intCnt = LBound(vertlist) To UBound(vertlist) Step 2
    vertlist(intCnt) = objSheet.Cells(RowCount, 1).Value
    vertlist(intCnt + 1) = objSheet.Cells(RowCount, 2).Value
    RowCount = RowCount + 1
  Next
  objDoc.ModelSpace.AddLightWeightPolyline vertlist
  objDoc.Regen acActiveViewport
Exit_Here:
  If Not objApp Is Nothing Then
    Set objApp = Nothing
    Set objDoc = Nothing
  End If
  Exit Sub
Err_Control:
  MsgBox Err.Description
  Resume Exit_Here
End Sub