[REDS]

Товарищи знатоки Lisp.
Очень нужен Лисп для передачи таблицы из Exel в Автокад.
Принцип работы (я думаю понятен):
Выделяем в Exel область (таблицу)
В Автокаде запускаем Лисп... он отрезками отрисовывает таблицу и заполняет её ячейки однострочным текстом ...
Возможно ли такое провернуть вообще?
Или может уже есть что-то подобное? Я не нашёл
Помогите плз... :cry:

[fixo]

Сообщение от REDS для Fatty Не работает что-то. Пишет - ошибка - неверный тип аргумента ???

Добавил игнорирование типа данных
Пустые ячейки будут заполняться прочерком
См. комментарии, меняй по вкусу
Проверил в 2007 только, работает:

Код:

[Выделить все]

;;;;; written by Fatty (based on routine written by VK)
;;;;; http://www.autocad.ru/cgi-bin/f1/board.cgi?p=44
(alert "Открыть книгу Эксель,\nвыделить диапазон для копирования,\nзатем закрыть книгу")
(defun draw-tablo (tbl_list header point / atable cnt col_names header row tbl_list)
  (vl-load-com)
  (setq	atable (vla-addtable
		 (vla-get-modelspace
		   (vla-get-activedocument
		     (vlax-get-acad-object)
		   )
		 )
		 (vlax-3d-point point)
		 (1+ (length tbl_list))
		 (length (car tbl_list))
		 500.0
		 3000.0
	       )
  )
  (vla-zoomextents (vlax-get-acad-object))
  (vla-put-HeaderSuppressed atable :vlax-false)
  (vla-RecomputeTableBlock atable :vlax-false)
  (vla-settext
    atable
    0
    0
    header
  )
  (vla-setcellalignment atable 0 0 acmiddlecenter) 
  (vla-setcelltextheight atable 0 0 400.);<-- высота текста заголовка
  (setq col_names (car tbl_list))
  (setq cnt 0)
  (foreach item	col_names
    (vla-settext atable 1 cnt item)
    (vla-setcellalignment atable 1 cnt acmiddlecenter)
    (vla-setcelltextheight atable 1 cnt 300.);<-- высота текста подзаголовков
    (setq cnt (1+ cnt))
  )
  (setq row 2)	
  (setq cnt 0)
  (setq tbl_list (cdr tbl_list))
  (foreach cel tbl_list
    (foreach item cel
      (vla-settext atable row cnt item)
      (vla-setcellalignment
	atable
	row
	cnt
	acmiddlecenter
      )
      (vla-setcelltextheight atable row cnt 250.);<-- высота текста остальных строк
      (setq cnt (1+ cnt))
    )
    (setq row (1+ row))
    (setq cnt 0)
  )
  (vla-RecomputeTableBlock atable :vlax-true)
  (vl-catch-all-apply
    (function (lambda () (vlax-release-object atable)))
  )
  (princ)
)

  (defun C:TEX (/ col	  data	   heads    point    row      x
		 xlapp	  xlbook   xlbooks  xlcell   xlcells  xlrange
		 xlsheet
		)
  (vl-load-com)
    ;; получение полного пути к файлу
  (setq path (getfiled "Открыть файл Эксель" (getvar "dwgprefix") "xls" 4))
    ;; поучение ссылки на приложение Эксель
  (setq 
     xlapp (vlax-get-or-create-object "Excel.Application.11"));<-- версия Эксель (можно удалить .11)
    (vlax-put-property xlapp 'Visible :vlax-true)
    ;; ссылка на рабочие книги
     (setq xlbooks 
         (vlax-get xlapp 'WorkBooks))
          (setq xlBook ;<--ссылка на книгу
	     (vl-catch-all-apply
	       (function (lambda()
	       (vla-open xlbooks ;<-- открываем книгу
			 path ;<-- полный путь к файлу 
			 )))))

      ;; ссылка на первую страницу
      (setq xlsheet (vl-catch-all-apply
	          (function (lambda()
		    (vlax-get-property (vlax-get-property xlbook 'Sheets)
			  'Item
			  1 ;<-- номер страницы 
		    )
		  )
      )
    )
  )
  ;; делаем активными книгу и страницу
  (vlax-invoke-method xlbook 'Activate)	  
  (vlax-invoke-method xlsheet 'Activate)
   ;; ссылка на выделенный диапазон (объект Selection)   
  (setq xlrange (vlax-get-property xlapp 'Selection))
  ;; номер строки с подзаголовками таблицы, объект Selection
  ;; его не включает
  (setq row (vlax-get-property xlrange 'Row))
  (setq xlcells (vlax-get-property xlrange 'Cells))
  ;; получение всего диапазона значений  
  (setq data (vlax-get-property xlrange 'Value2)
  )
 ;; перевод данных вида вариант в текстовый формат 
(setq data
       (mapcar (function (lambda(x)
(mapcar (function (lambda(y)
	(if (not (zerop (variant-type y)))	    
	(vl-princ-to-string (vlax-variant-value y))
	  "---")))
	x)))
        (vlax-safearray->list
	(vlax-variant-value data)))
      )

    ;; закрываем книгу
(vlax-invoke xlbook 'Close)
    ;; отключаем приложение Эксель
(vlax-invoke xlapp 'Quit)
    ;; освобождение объектов из памяти в порядке
    ;; обратной иерархии
(mapcar (function (lambda(x)
	(vl-catch-all-apply
	  (function (lambda()
		      (progn
			(vlax-release-object x)
			(setq x nil)))))))
	(list xlrange xlsheet xlbook xlbooks xlapp)
	)
;; сборка мусора
    (gc)(gc)
    ;; указание точки вставки таблицы
    (setq point (getpoint "\n\t>>\t Точка вставки таблицы >> : "
	     )
      )
    ;; непосредственно рисование таблицы, название таблицы изменить
    (draw-tablo data "НАЗВАНИЕ ТАБЛИЦЫ" point)
    (princ)
    )
;;; TesT : (C:TEX)
(princ "\n\t***\t В командной строке набери TEX (англ.) \t***")
(princ)

~'J'~

[fixo]

Сообщение от Mitek Специальная вставка нормально катит в 2006 акаде... Вставляется таблица автокада. Единственное неудобство - в тексте в каждой ячейке сохраняется информация о шрифте, который стоял в экселе, поэтому текст в ячейке таблицы акада выглядит примерно так: {\fRomanS|b0|i0|c204|p0;\H1.176x;Проверка} Вот если бы кто-нибудь придумал лиспик для уборки этого мусора (этой инфы) из текста ячейки, чтобы оставался только голый текст (в данном примере слово Проверка), я был бы очень благодарен Да и не только я

Поищи удаление форматов мтехта или что-то вроде
Посмотри последний код здесь

http://www.autocad.ru/cgi-bin/f1/boa...22786yk&page=2

~'J'~

[baaba]

А можно объяснить, почему Вам не годиться "Edit>PasteSpecial"? Я настроил её на Ctrl+Shift+V, что очень удобно. Там, в появляющемся меню, есть несколько вариантов. Один из них как раз - вставка чисто их прямых отрезков и singlline simpl text. Таким образом оформление длинных спецификаций мне не представляет большого труда. Масштабирование по высоте строки (я делаю 5 мм), а затем перенос свойств текста.

ЗЫ. Если моявится Лисп программа, кинте ссылку, пожалуйста.

Иван.