• На форуме с 21 марта 2011г.
  • Сообщений: 13
  • Спасибо: 0

Тема: Помогите связать AutoCAD и Excel

Доброго всем дня. Помогите пожалуйста связать AutoCAD и Excel. Нужно что б открывался документ Excel из определенного места и используя два столбца(один координаты Х другой Y) вводя значения в  AutoCADе строилась полиния(вопрос может ли строиться в реальном времени?). Пожалуйста если можно обьясните поподробней какие библиотеки подключить. Буду очень благодарен все. Заранее огромное спасибо!!!

  • Boxa
  • Активный участник
  • Откуда: С-Пб
  • На форуме с 25 июля 2009г.
  • Сообщений: 135
  • Спасибо: 11

Re: Помогите связать AutoCAD и Excel

А не проще необходимые данные из xls документа сохранять в csv файл
и считывать данные штатными средствами VBA?

Ответ от AnatolyN (изменено: Anatoly, 28 апреля 2011г. 10:57:08)

  • AnatolyN
  • Активный участник
  • Откуда: Москва
  • На форуме с 14 мая 2009г.
  • Сообщений: 178
  • Спасибо: 4

Re: Помогите связать AutoCAD и Excel

Правильный вызов Excel из AutoCAD, чтобы дальше можно было работать с Excel

запуск Ecxel

Как работать с электронной таблицей Excel?

  • На форуме с 21 марта 2011г.
  • Сообщений: 13
  • Спасибо: 0

Re: Помогите связать AutoCAD и Excel

Помогите пожалуйста остановить цикл. Мне нужно что б линия строилась пока в столбцах А и В были цифры а как только ячейка стала пустой перестала строиться. Как это можно прописать в цикле Do Loop

Sub prog()


Dim AppExcel As Excel.Application
Dim AppBook As Excel.Workbook
Dim AppSheet As Excel.Worksheet


Set AppExcel = Excel.Application
AppExcel.Visible = True
Set AppBook = AppExcel.Workbooks.Open("D:\RLP\poperechnic.xlsx")
Set AppSheet = AppBook.Sheets(1)

Dim Line As AcadLWPolyline
Dim pnt(0 To 3) As Double
Dim i As Integer

i = 0

Do Until

i = i + 1

pnt(0) = Cells(1 + i, 1): pnt(1) = Cells(1 + i, 2)
pnt(2) = Cells(2 + i, 1): pnt(3) = Cells(2 + i, 2)
Set Line = ThisDrawing.ModelSpace.AddLightWeightPolyline(pnt)
Loop

End Sub

  • AnatolyN
  • Активный участник
  • Откуда: Москва
  • На форуме с 14 мая 2009г.
  • Сообщений: 178
  • Спасибо: 4

Re: Помогите связать AutoCAD и Excel

1. Я бы в одном модуле:
прочел данные с листа Excel,
записал в двумерный массив (запись пока ячейки непустые),
закрыл Excel
2. Передал массив как параметр в другой модуль,
там в цикле построил бы линии по данным из массива.
3. А зачем  делать Excel видимым?

  • Boxa
  • Активный участник
  • Откуда: С-Пб
  • На форуме с 25 июля 2009г.
  • Сообщений: 135
  • Спасибо: 11

Re: Помогите связать AutoCAD и Excel

Дима Сибилев пишет:

Как это можно прописать в цикле Do Loop

Посмотрите справку, Do Loop позволяет использовать условия.

  • На форуме с 21 марта 2011г.
  • Сообщений: 13
  • Спасибо: 0

Re: Помогите связать AutoCAD и Excel

Ув. Anatoly если не сложно можете рассказать по подробней или если есть какие примеры буду очень благодарен Вам

  • AnatolyN
  • Активный участник
  • Откуда: Москва
  • На форуме с 14 мая 2009г.
  • Сообщений: 178
  • Спасибо: 4

Re: Помогите связать AutoCAD и Excel

Предполагается, что на листе Лист1 расположена таблица координат из 4х колонок (X1/Y1/X2/Y2).
Обработка массива (удаление пустых значений и т.д.) опущена.

Sub main()
 Dim arrCoords() As Double
 read_xls arrCoords
 draw_lines arrCoords
End Sub

Sub read_xls(arrCoords() As Double)
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")

If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo errhandler
    Set xlApp = CreateObject("Excel.Application")
Else
    On Error GoTo errhandler
End If

dirnam = "D:/"
fnam = "a.xls"
shtnam = "Лист1"

xlApp.DisplayAlerts = False
xlApp.Workbooks.Open dirnam & fnam
  
For Each wrksht In xlApp.Worksheets
     If wrksht.Name = shtnam Then
        arrUsed = wrksht.UsedRange.Cells.Value
        If IsEmpty(arrUsed) = False Then
                 
        ReDim arrCoords(1 To UBound(arrUsed, 2), 1 To UBound(arrUsed, 1)) As Double
        '1-ое измерение - колонки таблицы, 2-ое измерение - строки
        
        For ii = 1 To UBound(arrUsed, 1)
        For jj = 1 To UBound(arrUsed, 2)
          arrCoords(jj, ii) = arrUsed(ii, jj)
        Next jj
        Next ii
                
        End If
       Exit For
     End If
Next
   
xlApp.DisplayAlerts = True
xlApp.Workbooks(fnam).Close
Set xlApp = Nothing

Exit Sub

errhandler:
MsgBox "Программа будет закрыта из-за  возникновения ошибки" & _
vbCr & Err.Number & "  " & Err.Description
xlApp.DisplayAlerts = True
Set xlApp = Nothing

End Sub

Sub draw_lines(arrCoords() As Double)
 Dim lineObj As AcadLine
 Dim startPoint(0 To 2) As Double
 Dim endPoint(0 To 2) As Double
    
 For i = 1 To UBound(arrCoords, 2)
    startPoint(0) = arrCoords(1, i): startPoint(1) = arrCoords(2, i): startPoint(2) = 0#
    endPoint(0) = arrCoords(3, i): endPoint(1) = arrCoords(4, i): endPoint(2) = 0#
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
 Next i
End Sub