| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > вставка таблицы из MS Excell

вставка таблицы из MS Excell

Ответ
Поиск в этой теме
Непрочитано 18.06.2012, 20:46 #1
вставка таблицы из MS Excell
baaba
 
архитектор
 
Москва
Регистрация: 07.07.2007
Сообщений: 644

Лично мне удобнее работать с таблицами в табличном процессоре, например Excel, Calc и прочее и только потом вставлять таблицу в чертёж. Может быть я плохо искал, но я не смог подобрать готового решения для вставки таблиц в чертёж из существующих программ для AutoCAD, в общем доступе и до сего момента вставлял таблицы через 'paste special', что имеет свои недостатки. В частности меня не устраивало то что нужно всякий раз подгонять таблицу по ширине и высоте, поправлять артефакты, возникающие при вставки и прочее. Возникла идея написать маленький лисп для автоматизации этого процесса. Из существующих наработок мне больше всего подошла библиотека Елпанова Евгения, http://elpanov.com/index.php?id=42#01, позволяющая читать напрямую файлы *.xls. Я написал небольшую обёртку для этой функции, надеюсь это кому-нибудь пригодиться, кроме меня. В архиве исходники и скомпилированный *.fas, можно пользоваться и тем и тем.
Таблица вставляется текущим текстовым стилем, в текущем слое. Масштаб 1:1, т. е. в единицах листа.

Код:
[Выделить все]
 ;|
Программа для вставки таблиц, спецификаций из Excel
Особенность данной программы - считывание данных о высоте строки, шапки, высоте текста и прочего из первых четырёх строк конкретного листа файла excell (см. пример, e.xls). Это позволяет работать с данными в Excel, вставлять таблицы в точном соответствии со стандартами Таблица рисуется отрезками и примитивами dtext (mtxt в шапке таблицы)
по данным Excell в текущем слое, текущим текстовым стилем, из указанного файла, указанного пользователем (ввод с клавиатуры) листом от верхней правой точки таблицы. Excel при этом не обязательно должен быть установлен, можно использовать любой табличный процессор, который может сохранять файлы в формате xls
|;
;Функция преобразования списка с чётным количеством элементов в список точечных
;пар
;(ccons '(1 2 3 4 5 6))
(defun ccons (lstin)
	(if (not (= lstin nil))
		(cons (cons (car lstin) (cadr lstin)) (ccons (cddr lstin)))
	)
)

;Текущий стиль
;(getvar "TEXTSTYLE")

;Функция рисования однострочного текста по точке, высоте текста, типу привязки
;и значению текстовой строки
;(drawtxt (getpoint) 3 "br" 3.5 wrnd)
;(drawtxt (getpoint) 3 "center" (nth 2 (nth 4 mlst)))
(defun drawtxt (pt th just txtstr wrnd)
	
	;(setq txtstr (nth 2 (nth 4 mlst)))
	;проверка, не является ли ввод реальным числом или пустым значением
	(cond
		((= (type txtstr) 'REAL) (setq txtstr (rtos txtstr 2 wrnd)))
		((= txtstr nil)			(setq txtstr ""))
	)

	(setq just
		(cond
			((= just "left")	(list 72 0 73 0))
			((= just "center")	(list 72 1 73 0))
			((= just "right")	(list 72 2 73 0))
			((= just "tl")		(list 72 0 73 3))
			((= just "tc")		(list 72 1 73 3))
			((= just "tr")		(list 72 2 73 3))
			((= just "ml")		(list 72 0 73 2))	
			((= just "mc")		(list 72 1 73 2))
			((= just "mr")		(list 72 2 73 2))	
			((= just "bl")		(list 72 0 73 1))
			((= just "bc")		(list 72 1 73 1))
			((= just "br")		(list 72 2 73 1))
		)
	)

	(entmake (append (ccons (list
			0 "TEXT"
			100 "AcDbEntity"
			100 "AcDbText"
			1 txtstr
			40 th
			51 (cdr (assoc 50 (tblsearch "STYLE" (getvar 'textstyle))))
			10 pt
			11 pt
			7 (getvar "TEXTSTYLE")
			)) (ccons just)))
)

;рисование многострочного текста по точке, высоте, типу привязки, ширине
;текстового блока и содержанию текста, ниже следует пример вызова
;(mkmtxt (getpoint) 3 "mc" 0.45 12 "teststring value")
;(mkmtxt (getpoint) 3 "mc" 0.45 12 (nth 2 (nth 4 mlst)))
(defun mkmtxt (pt th just row_space cellw txtstr / base)

	;(setq txtstr (nth 2 (nth 4 mlst)))
	;проверка, не является ли ввод реальным числом или пустым значением
	(cond
		((= (type txtstr) 'REAL) (setq txtstr (rtos txtstr)))
		((= txtstr nil)			(setq txtstr ""))
	)

	(setq base (list
			0 "MTEXT" 100 "AcDbEntity" 100 "AcDbMText" 1 txtstr 40 th 10 pt 11 pt 		
			41 cellw 44 row_space 50 0.0 7 (getvar 'textstyle) 
		))

	(setq just
		(cond
			((= just "tl") '(71 1))
			((= just "tc") '(71 2))
			((= just "tr") '(71 3))
			((= just "ml") '(71 4))	
			((= just "mc") '(71 5))
			((= just "mr") '(71 6))	
			((= just "bl") '(71 7))
			((= just "bc") '(71 8))
			((= just "br") '(71 9))
		)
	)

	(entmake (ccons (append base just)))
)

; Функция возвращает точку с приращением по X от исходной точки
(defun ofstx (pt ofstd)
	(list (+ ofstd (car pt)) (cadr pt))
)

; Функция возвращает точку с приращением по Y от исходной точки вниз 
(defun ofsty (pt ofstd)
	(list (car pt) (- (cadr pt) ofstd))
)

; Формирование списка координат вершин линий вертикальных разделителей таблицы
(defun mkptxlist (pt pts)
	(if pts (cons (setq pt (ofstx pt (car pts))) (mkptxlist pt (cdr pts))))
)
	
; Формирует список координат вершин линий горизонтальных разделителей таблицы
(defun mkptylist (pt ofstd rows)
	(if (>= rows 0)
		(cons pt (mkptylist (ofsty pt ofstd) ofstd (1- rows)))
	)
)

; Функция рисует линии по списку вершин с заданным углом и длиной
(defun draw_line (pts ang lh)
	(mapcar '(lambda (x) (command "_.line" x (polar x ang lh) "")) pts))



; Функция расставляет текст по спискам точек, привязок, значений текста,
; интервалов между вертикальными разделителями таблицы
;(drawtxtptstrlst ptlistx txth justlist (car (ccdr 3 mlst)) interlist wrnd)

;(defun drawtxtptstrlst (ptlistx txth justlst ptstrlst interlist)
;	(mapcar '(lambda (x y z n) (if (not (eq "" z))
;		(drawtxt (if (eq y "bc") (ofstx x (/ n 2)) (ofstx x 1.5)) txth y z)
;		)) ptlistx justlst ptstrlst interlist
;	)
;)

(defun drawtxtptstrlst (ptlistx txth justlst ptstrlst interlist wrnd)
	(mapcar '(lambda (x y z n) (if (not (eq "" z))
		(drawtxt
;			(if (eq y "bc") (ofstx x (/ n 2)) (ofstx x 1.5))
			(cond
				((eq y "bc") (ofstx x (/ n 2)))
				((eq y "br") (ofstx x (- n 1.5)))
				((eq y "bl") (ofstx x 1.5))
			)
			txth y z wrnd)
		)) ptlistx justlst ptstrlst interlist
	)
)

; Функция расставляет текст от исходного списка значений коодинат точек с приращением,
; по вертикали. Значения текстовых полей выбираются из прямоугольного массива
; значений (список списков) 
;(mdrtxt2 ptlistx txth justlist (cdr mlst) interlist theight wrnd)
(defun mdrtxt2 (ptlistx txth justlst str interlist theight wrnd)
	(while str
		(drawtxtptstrlst ptlistx txth justlst (car str) interlist wrnd)
		(setq ptlistx (mapcar '(lambda (x) (ofsty x theight)) ptlistx))
		(setq str (cdr str))
	)
)

; Пробная функция работы с прямоугольным массивом
;(mdrtxt (cdr (gtable)))
(defun mdrtxt (str / adata)
	(while str
		(setq adata (cons (car (car str)) adata))	
		(setq str (cdr str))
	)
	(reverse adata)
)

;Откусывает последний элемент списка
;Поискать готовые функции
(defun ucdr (lst)
	(reverse (cdr (reverse lst)))
)

;Убирает nil в списке
;(unil interlist)
(defun unil (lst)
	(if (eq (car (reverse lst)) nil) (unil (ucdr lst)) lst))
	


;Откусывает хвост начиная с элеметна N
;(setq a '(0 1 2 3 4 5))
;(ccdr 3 a)
(defun ccdr (n lst)
	(if (not (= 0 n)) (ccdr (1- n) (cdr lst)) lst))

;(draw_table (gtable))
(defun draw_table (mlst / justlst interlist theight txth frowh pt1 ptlistx ptlisty wrnd)

;Вычисление переменных разного рода
(setq
	justlist (nth 2 mlst)
	;justlst '("bc" "bl" "bc" "bc" "bc" "bc"); привязки текстовых полей в таблице	
	;interlist (mapcar 'atoi (nth 1 mlst))
	interlist (unil (nth 1 mlst))
	;interlist '(10.0 80.0 15.0 10.0); интервалы таблицы по гост
	theight (nth 1 (nth 0 mlst))
	;theight 5; высота строки (8 мм согласно ГОСТ)
	;txth (atof (vl-string-subst "." "," (nth 2 (nth 0 mlst))))
	txth (nth 2 (nth 0 mlst))
	;txth 3.5; высота строки текста
	wrnd (atoi (rtos (nth 4 (nth 0 mlst)) 2 0))  ; округление до
	frowh (nth 0 (nth 0 mlst))
	;frowh 10; высота первой строки 15 мм согласно ГОСТ
	;row_space 0.9; межстрочный интервал, для многострочного текста
	row_space (nth 3 (nth 0 mlst))
	pt1 (getpoint "\nEnter start point: "); левая верхняя точка таблицы
	ptlistx (cons pt1 (mkptxlist pt1 interlist)); ряд точек для рисования вертикальных линий
	ptlisty (cons pt1 (mkptylist (ofsty pt1 frowh) theight (length (ccdr 4 mlst)))); ряд точек для рисования горизонтальных линий
)

;Рисование вертикальных разделителей таблицы
(draw_line ptlistx (/ pi -2)
	(eval (list '- (cadr (car ptlisty)) (cadr (last ptlisty)))))

;Рисование горизонтальных разделителей таблицы
(draw_line ptlisty 0 (eval (cons '+ interlist))) 

; Заполнение шапки таблицы
;(setq ptlistx2
;	(mapcar '(lambda (x y) (ofsty (ofstx x (/ y 2.0)) (/ frowh 2.0))) ptlistx interlist)
;)
;(mkmtxt (getpoint) 3 "mc" row_space 33 "teststring value")
(mapcar '(lambda (x y z) (mkmtxt
	(ofsty (ofstx x (/ y 2.0)) (/ frowh 2.0))
	txth "mc" row_space (- y 1.0) z))
	ptlistx interlist (nth 3 mlst)
)

; Заполнение таблицы
(mdrtxt2
	(mapcar '(lambda (x) (ofsty x (+ frowh theight))) (ucdr ptlistx))
	txth justlist (ccdr 4 mlst) interlist theight wrnd
)

(princ)
)

(defun c:drawtable ( / old_osnap shlst c_sheet )
;Необходимо догрузить
(vl-load-com)
;Загрузка функции чтения из Excell
;http://elpanov.com/index.php?id=42#01
(load "readxls")
;(load "readcsv")

;http://forum.dwg.ru/archive/index.php/t-31628.html
;Запомнить путь к открытому файлу?
;(if (eq fn nil)
;	(setq fn (getfiled "Select a spreadsheet file" "" "xls" 8))
;	(setq fn (getfiled "Select a spreadsheet file" (strcat (vl-filename-directory (findfile fn)) "\\") "xls" 8))
;)

;(if fn
;	(setq fn (getfiled "Select a spreadsheet file" (strcat (vl-filename-directory (findfile fn)) "\\") "xls" 8))
;	(setq fn (findfile (getfiled "Select a spreadsheet file" "" "xls" 8)))
;)

(setq fn (findfile (getfiled "Select a spreadsheet file" "" "xls" 8)))

;(eea-get_xl (getfiled "Select a spreadsheet file" "c:/work/lisp/test/" "xls" 8))

;(setq fn (getfiled "Select a spreadsheet file" "c:/work/lisp/test/" "xls" 8)) 
(setq
;	xlsdata (eea-get_xl fn)
;	shlst (mapcar '(lambda (x) (vl-string-subst "" "$" x)) (mapcar 'car xlsdata))
;	shlst (mapcar 'car xlsdata)
	c_sheet (getstring "\nEnter sheet name: ") 
)

(command "_.undo" "_begin"); Метка отмены группы комманд
(setq old_osnap (getvar "OSMODE")); Старая привязка
(setvar "OSMODE" 0); Сброс всех привязок

;(draw_table (gtable))
;(draw_table (eea-get_xl_sheet (getfiled "Select a spreadsheet file" "c:/work/lisp/test/" "xls" 8) "sp1"))
(draw_table (eea-get_xl_sheet fn c_sheet))

;Восстановление привязки
(setvar "OSMODE" old_osnap)

;Метка отмены группы комманд
(command "_.undo" "_end")
)
PS Хотелось бы реализовать запоминание места, от куда брал последний раз таблицу и выбор листа из списка, через DCL.

Вложения
Тип файла: zip drawtable.zip (15.6 Кб, 344 просмотров)

Просмотров: 16080
 
Непрочитано 18.06.2012, 23:19
#2
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


вставляется как таблица? или набор примитивов?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Автор темы   Непрочитано 19.06.2012, 09:13
#3
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


как набор примитивов
baaba вне форума  
 
Непрочитано 19.06.2012, 09:24
#4
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


Offtop:
Цитата:
Сообщение от baaba Посмотреть сообщение
как набор примитивов
фтопку
А жаль.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 19.06.2012, 09:28
#5
Alexeipost


 
Регистрация: 07.12.2010
Уфа
Сообщений: 425
<phrase 1=


У меня пишет "ошибка: сбой при выполнении LOAD: readxls
win 7 64, autocad 2011
Alexeipost вне форума  
 
Непрочитано 19.06.2012, 10:50
#6
kserg


 
Регистрация: 22.04.2004
Сообщений: 269


> baaba

А нельзя ли запрос "Enter sheet name:" выдавать в виде диалогового окна (DCL), где в виде списка для выбора предлагается набор этих самых "sheet name" ?
kserg вне форума  
 
Автор темы   Непрочитано 19.06.2012, 12:00
#7
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Цитата:
Сообщение от kserg Посмотреть сообщение
А нельзя ли запрос "Enter sheet name:" выдавать в виде диалогового окна (DCL), где в виде списка для выбора предлагается набор этих самых "sheet name" ?
Сам об этом думал. Пока не получается с ходу реализовать. Если бы кто то помог.. Пока только вводить.
Цитата:
Сообщение от Alexeipost Посмотреть сообщение
У меня пишет "ошибка: сбой при выполнении LOAD: readxls
win 7 64, autocad 2011
Не удивительно, я тестировал в акаде 2010 и 2004, 32 бит. Всё дело в функции чтения *.xls, к которой я написал фронт-энд. Я не знаю как она работает. Если бы подобрать подходящую функцию или связаться с Евгением, можно это обойти. Кстати, в архиве лежит *.fas и исходники, ошибка получается при работе с *.fas?
Цитата:
Сообщение от zenon Посмотреть сообщение
фтопку
Я делал для себя. Мне не нужна редактируемая таблица в Акаде. Под ваш случай наверное есть какие-то наработки.
baaba вне форума  
 
Непрочитано 19.06.2012, 12:53
#8
Alexeipost


 
Регистрация: 07.12.2010
Уфа
Сообщений: 425
<phrase 1=


запускал fas и lsp - одинаково.
Alexeipost вне форума  
 
Автор темы   Непрочитано 19.06.2012, 17:41
#9
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Цитата:
Сообщение от Alexeipost Посмотреть сообщение
запускал fas и lsp - одинаково.
Дело наверное в библиотеке, попробуй:
Код:
[Выделить все]
 
(vl-load-com)
(load "readxls")
(eea-get_xl_sheet (findfile (getfiled "Select a spreadsheet file" "" "xls" 8)) (getstring "\nEnter sheet name :"))
Должно выводить содержимое файла *.xls
baaba вне форума  
 
Непрочитано 19.06.2012, 21:05
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Дело, скорее всего, не в библиотеке, а в том, что в Windows 7 x64 отсутствует соответствующий OLEDB-драйвер. Его можно скачать с официального сайта Microsoft, насколько я помню. И вроде бы он входил в какое-то из обновлений.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.06.2012, 09:01
#11
Alexeipost


 
Регистрация: 07.12.2010
Уфа
Сообщений: 425
<phrase 1=


2 baaba
Цитата:
1 (vl-load-com)
2 (load "readxls")
3 (eea-get_xl_sheet (findfile (getfiled "Select a spreadsheet file" "" "xls" 8)) (getstring "\nEnter sheet name :"))
не работает.
Alexeipost вне форума  
 
Автор темы   Непрочитано 20.06.2012, 11:13
#12
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Цитата:
Сообщение от Alexeipost Посмотреть сообщение
не работает.
Попробуй совет kpblc. Дело наверное в OLEDB
baaba вне форума  
 
Непрочитано 20.06.2012, 12:13
#13
Alexeipost


 
Регистрация: 07.12.2010
Уфа
Сообщений: 425
<phrase 1=


ввод "OLEDB для win 7" в яндекс ни к чему результативному не привел. Отсылает на страницу суппорт.микрософт, но там не то....
Alexeipost вне форума  
 
Непрочитано 20.06.2012, 12:17
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


https://www.google.ru/#hl=ru&gs_nf=1...w=1274&bih=898 ??
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.06.2012, 12:50
#15
Alexeipost


 
Регистрация: 07.12.2010
Уфа
Сообщений: 425
<phrase 1=


Первая ссылка не помогла. Ладно попробую дома там акад 2011 32
Alexeipost вне форума  
 
Автор темы   Непрочитано 22.06.2012, 07:09
#16
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Может быть как то можно прикрутить вот эту утилиту
http://vitus.wagner.pp.ru/software/catdoc/
для представления *.xls в виде *.csv? А дальше уже как по накатанной
baaba вне форума  
 
Непрочитано 20.12.2012, 10:26
#17
Muan


 
Регистрация: 20.12.2012
Москва
Сообщений: 1


не работает эта утилита (
Muan вне форума  
 
Автор темы   Непрочитано 09.01.2013, 17:28
#18
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Цитата:
Сообщение от Muan Посмотреть сообщение
не работает эта утилита (
Какая утилита? catdoc или моя утилита? Если Win7 x64 то см. выше. Что пишет?
baaba вне форума  
 
Автор темы   Непрочитано 19.06.2013, 12:55
1 | #19
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 644
<phrase 1= Отправить сообщение для baaba с помощью Skype™


Перешёл на Windows 7 х64. Функция импорта данных из Excell (библиотека Елпанова Евгения, http://elpanov.com/index.php?id=42#01) перестала работать. По-этому я "откатился" на CSV формат. В принципе меня всё устраивает. Во вложении пример вставки таблицы и LISP исходный код.

Для работы необходимо загрузить: (load "drawtable-csv")
Далее доступна комманда DT-CSV.
Для вставки необходимо сохранить из Excell в csv формате (разделение запятыми).
Вложения
Тип файла: zip readcsv.zip (33.7 Кб, 119 просмотров)
baaba вне форума  
 
Непрочитано 19.06.2013, 15:35
#20
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Цитата:
Сообщение от baaba Посмотреть сообщение
Функция импорта данных из Excell (библиотека Елпанова Евгения, http://elpanov.com/index.php?id=42#01) перестала работать.
А офис у тебя какой? случаем не x86?
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > вставка таблицы из MS Excell

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Полезные таблицы для инженеров (самопальные и не только). Armin Поиск литературы, чертежей, моделей и прочих материалов 148 24.12.2022 12:46
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
как с помощью vba начертить линию vasyavip Программирование 77 09.10.2008 23:17
Вставка фрагментов таблицы из Excel в таблицу Автокада 2006 через буфер обмена - возможно ли? kp+ AutoCAD 3 21.03.2008 10:32
vb6 вставка таблицы AutoCad'a в таблицу Word'a HiddenM Программирование 1 11.01.2007 16:11