Интеграция приложений

(vlax-dump-object (vlax-get-or-create-object "Excel.Application") T)

;===================================================
; Программа COM-связи AutoCAD - Microsoft Excel 2003
;===================================================
; Вычерчивание таблицы по данным из книги Excel
; Используются текущий слой, текущий цвет и создаваемый стиль таблиц
;
; Аргументы:
;   tb_xls - имя файла книги Excel;
;   sheetname - имя листа;
;   hcell - высота ячейки таблицы;
;   hlet - высота букв текста таблицы;
;   show - признак показа Excel во время работы (T или nil)
;
; Глобальные переменные:
;   g_oex - VLA-объект приложения Excel;
;   g_wkbs - VLA-объект семейства Workbooks;
;   g_awb - VLA-объект активной книги;
;   g_shs - VLA-объект семейства Sheets;
;   g_mainsh - VLA-объект нужного листа книги;
;   g_cell - VLA-объект ячейки.
;
; Примеры обращения к программе:
; (readex11_com "d:\\r 16\\readex11.xls" "Спецификация" 8.0 5.0 T)
; (readex11_com "d:\\r 16\\readex11.xls" "Спецификация" 5.0 3.0 nil)
;
(defun readex11_com (tb_xls sheetname hcell hlet show / nlines ncolumns 
  table_items i j row pt0 widths types headers val msp tbl old_echo)
; Подгрузка библиотек, обеспечивающих работу с ActiveX
(vl-load-com)
; Отключение эхо-вывода
(setq old_echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
; 
; Установление связи c Excel
(ex11_set_connect show)
; Указатель семейства Workbooks
(setq g_wkbs (vlax-get-property g_oex "Workbooks"))
; Открытие файла (книги) и получение указателя книги
(setq g_awb (vlax-invoke-method g_wkbs "Open" tb_xls))
; Проверка открытия файла
(if (not g_awb)
  (progn
    (alert (strcat "Не обнаружен файл " tb_xls))
    (ex_break_connect)
    (exit)
  )
)
; Чтение списка листов; не обязательно активизировать нужный
(setq g_shs (vlax-get-property g_awb "Worksheets"))
; Указатель на лист с нужным именем  
(vlax-for s g_shs (if (= sheetname (vlax-get-property s "Name"))(setq g_mainsh s)))
(if (not g_mainsh)
  (progn
    (alert (strcat "Не обнаружен лист " sheetname))
    (ex_break_connect)
    (exit)
  )
)
;
; Чтение количества строк в будущей таблице спецификации
;  (из ячейки A1 листа Excel), без учета строки заголовков
(setq g_cell
  (vlax-variant-value (vlax-invoke-method g_mainsh "Evaluate" "A1")))
(setq nlines
  (fix (vlax-variant-value (vlax-get-property g_cell "Value"))))
(vlax-release-object g_cell)
; Чтение количества столбцов в будущей таблице спецификации
;  (из ячейки B1 листа Excel)
(setq g_cell
  (vlax-variant-value (vlax-invoke-method g_mainsh "Evaluate" "B1")))
(setq ncolumns
  (fix (vlax-variant-value (vlax-get-property g_cell "Value"))))
(vlax-release-object g_cell)
;
; Получение списка элементов таблицы (ряды 2,3,4, ... Excel)
; Ряд 2 - ширины столбцов в мм
; Ряд 3 - заголовки столбцов
(setq table_items nil j 1)
(repeat (+ nlines 3)
  (setq row nil j (1+ j) i -1)
  (repeat ncolumns
    (setq i (1+ i))
    (setq g_cell
      (vlax-variant-value
        (vlax-invoke-method
          g_mainsh
          "Evaluate"
          (strcat (chr (+ i (ascii "A"))) (itoa j))
        )
      )
    )
    (setq row
      (append
        row
        (list
          (vlax-variant-value
            (vlax-get-property g_cell "Value")
          )
        )
      )
    )
    (vlax-release-object g_cell)
  );repeat ncolumns
  (setq table_items (append table_items (list row)))
);repeat nlines
;
; Закрытие и выгрузка Excel
(ex_break_connect)
;
; Запрос точки левого верхнего угла таблицы
(setq pt0 nil)
(while (null pt0)
  (setq pt0 (getpoint "\nТочка левого верхнего угла таблицы: "))
);while
;
; Список ширин колонок и список типов данных
(setq widths (nth 0 table_items) types (nth 1 table_items))
;
(setq msp (vla-get-ModelSpace (vla-get-activeDocument (vlax-get-acad-object))))
; Создание стандартной таблицы с колонками равной ширины
(setq tbl (vla-AddTable msp (vlax-3d-point pt0) (+ 2 nlines) ncolumns hcell (car widths)))
; Корректировка ширин столбцов
(setq i -1)
(repeat ncolumns
  (setq i (1+ i))
  (vla-SetColumnWidth tbl i (nth i widths))
)

; Заголовок таблицы
; Высота букв
(vla-SetTextHeight tbl acTitleRow hlet)
; Текст
(vla-SetText tbl 0 0 "Спецификация")
;
; Заголовки колонок
; Высота букв
(vla-SetTextHeight tbl acHeaderRow hlet)
(setq headers (nth 2 table_items) i -1)
(repeat ncolumns
  (setq i (1+ i))
  (vla-SetText tbl 1 i (nth i headers))
);
;
; Вписывание элементов таблицы
; Высота букв
(vla-SetTextHeight tbl acDataRow hlet)
(setq j 2)
(repeat nlines
  (setq j (1+ j) i -1)
  (repeat ncolumns
    (setq i (1+ i) val (nth i (nth j table_items)))
    (if (= "str" (nth i types))
      (progn
	(vla-SetText tbl (1- j) i val)
        ; Выравнивание в ячейке
        (vla-SetCellAlignment tbl (1- j) i acBottomLeft)
      )
      (progn
	(vla-SetText tbl (1- j) i (rtos val 2 1))
        ; Выравнивание в ячейке
        (vla-SetCellAlignment tbl (1- j) i acBottomRight)
      )
    )
  );repeat ncolumns
);repeat nlines
;
; Восстановление режима эхо-вывода
(setvar "CMDECHO" old_echo)
;
(redraw)
(princ)
)

; Установка связи с Excel
; Аргумент:
;   vis = T - сделать Excel видимым;
;   vis = nil - сделать Excel невидимым.
;
(defun ex11_set_connect (vis / )
  (setq g_oex (vlax-get-or-create-object "Excel.Application "))
; Если связь не установлена, то аварийно завершить работу
  (if (null g_oex)
    (progn
      (alert "Невозможно запустить Microsoft Excel")
      (exit)
    )
  );if
; Сделать Excel видимым в зхаисимости от параметра vis
 (if vis (vlax-put-property g_oex "Visible" :vlax-true))
)

; Разрыв связи с Excel и выгрузка из памяти
(defun ex_break_connect ( / )
  (vlax-invoke-method g_oex "Quit")
  ; Освобождаем объекты, связанные с Excel,
; для корректной выгрузки Excel из памяти
  (mapcar
    (function (lambda (x)
      (if
        (and x (not (vlax-object-released-p x)))
        (vlax-release-object x)
      )
    ))
    (list g_cell g_mainsh g_shs g_awb g_wkbs g_oex)
  )
; Сборка мусора
  (setq g_cell nil g_mainsh nil g_shs nil g_awb nil g_wkbs nil g_oex nil)
  (gc)
)

(readex11_com "d:\\r 16\\readex11.xls" "Спецификация" 8.0 5.0 T) и
(readex11_com "d:\\r 16\\readex11.xls" "Спецификация" 5.0 3.0 nil).