Архитектору и проектировщику|Тепло- и звукоизоляция URSA.RU
Показать сообщение отдельно
Непрочитано 18.06.2012, 20:46 #1
вставка таблицы из MS Excell
baaba
 
архитектор
 
Москва
Регистрация: 07.07.2007
Сообщений: 622

Лично мне удобнее работать с таблицами в табличном процессоре, например 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 Кб, 322 просмотров)

Просмотров: 12306
 
Размещение рекламы