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

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

Групирование строк в таблице

Ответ
Страница 2 из 2 < 1 2
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 20.04.2012, 13:01
Групирование строк в таблице
Positron
 
Регистрация: 25.06.2009
Сообщений: 147
Прошу помощи у программистов, нужен лисп для группировки подобных цифр в столбике таблицы. Во вложении подробное описание.
[IMG]http://s019.***********/i611/1204/be/f84f5d120fc5.jpg[/IMG]


Описание:
Исходные - у нас есть таблица, с несколькими колонками.
1. Требуется сгруппировать строки по заданной колонке.
2. Необходимо суммировать колонки в строк для каждой группы с удалением всех строк групп кроме 1й строки каждой группы.
3. Чистим таблицу от пустых строк.

P.S. И если можно чтоб по умолчанию делся лисп сразу 3 пункта, но можно было и указывать до 1го или до 2го ...
как бы запрос:
-"Делать 3 действия?:3" (только нажать Enter надо)
-"Делать 3 действия?:" ( соотвецтвено вводим другое значение если необходимо)

Вложения
Тип файла: dwg
DWG 2007		 Пример 1.dwg (126.1 Кб, 2249 просмотров)

Последний раз редактировалось Кулик Алексей aka kpblc, 22.04.2012 в 17:29.
Просмотров: 8425
 
Непрочитано 04.05.2013, 00:06
#21
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 811

Попробую завтра что-нибудь придумать,
сегодня занят был другими делами

Каждая возьня с таблицами сугубо индивидуальная,
поэтому трудно написать общую функцию, я сделал проще
выделяй нужный диапазон рамкой напимер А4:Е14 для данной таблицы
и удаляй ненужные строки
Пробуй
Код:
[Выделить все] 
(defun C:SUMT (/ colmax colmin celltxt col data interes en getcell marks maxcell mincell osm pmax pmin
	         rowmax rowmin row same sset sumlst tblobj tcnt temp tmp txtline )
  
  (vl-load-com)
;; local defun
;; based on code written by Lee Ambrosius
;; date: 3/24/04
;; edited 11/21/10
(defun getcell(tblobj pt / col lwrleft pick row uprright vector vheight  vwidth)
 
 (setq vheight (getvar "viewsize"))
 (setq vwidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vheight))

 (setq lwrleft (list (- (nth 0 (getvar "viewctr")) (/ vwidth 2)) (- (nth 1 (getvar "viewctr")) (/ vheight 2)) 0))
 (setq uprright (list (+ (nth 0 (getvar "viewctr")) (/ vwidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vheight 2)) 0))

 (setq vector (vlax-make-safearray vlax-vbdouble '(0 . 2)))
 (vlax-safearray-fill vector '(1 1 1))
 (setq vector (vlax-make-variant vector))

 (setq pick (vlax-3d-point pt))

 (if pick 
   (if (= (vla-hittest tblobj pick vector 'row 'col) :vlax-true)
           (list row col)))
  (list row col)
  )

;; 				main part				;;

(princ "\n Выбор bctuj рабочего диапазона значений >> ")
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
 (setq pmin (getpoint "\n\t  >>  Указать левую верхнюю ячейку диапазона таблицы >>" )
	pmax (getcorner pmin "\n\t  >>  Указать правую нижнюю ячейку диапазона таблицы >>" ))
    (setq sset (ssget "_C" pmin pmax '((0 . "ACAD_TABLE"))))
  (setq tblobj (vlax-ename->vla-object (ssname sset 0)))
;;;(setq pmin (getpoint "\n\t >> Specify the left (or top left) cell of the table range >>")
;;;      pmax (getcorner pmin "\n\t >> Specify the right (or bottom right) cell of the table range >>"))
  (setq mincell(getcell tblobj pmin))
  (setq maxcell(getcell tblobj pmax))
  (setq rowmin (car mincell)colmin (cadr mincell)
	rowmax (car maxcell)colmax (cadr maxcell)
	)

;; get contents of selected cell range: 
(setq data nil)
(setq row rowmin)
(while (<= row rowmax)
  (setq col 0)
  (setq txtline nil)
  (while (<= col colmax)
    (setq celltxt (vla-gettext tblobj row col))
    (setq txtline (cons celltxt txtline))
    (setq col (1+ col))
  ) ;_ end of while
  (setq data (append data (list (reverse txtline))))
  (setq row (1+ row))
) ;_ end of while
(setq data (reverse data))
(setq sumlst nil)
(while (setq tmp (car data))
  (setq interes (reverse (cdr (reverse (cdr (reverse tmp))))))
  (setq	same (vl-remove-if-not
	       '(lambda	(x)
		  (equal interes
			 (reverse (cdr (reverse (cdr (reverse x)))))
			 0.001
		  ) ;_ end of equal
		) ;_ end of lambda
	       data
	     ) ;_ end of vl-remove-if-not
  ) ;_ end of setq
  (if same
    (setq sumlst (if (= (length same) 1)
		   (cons (car same) sumlst)
		   (progn
		     (setq marks (apply	'strcat
					(mapcar	'(lambda (x)
						   (strcat x ",")
						 ) ;_ end of lambda
						(vl-sort (mapcar 'car same)
							 '(lambda (a b) (< a b))
						) ;_ end of vl-sort
					) ;_ end of mapcar
				 ) ;_ end of apply
			   marks (substr marks 1 (1- (strlen marks)))
		     ) ;_ end of setq
		     (setq temp (subst marks (caar same) (car same)))
		     (setq tcnt
			    (itoa
			      (apply '+ (mapcar 'atoi (mapcar 'last same)))
			    ) ;_ end of itoa
		     ) ;_ end of setq
		     (setq temp	(append	(reverse (cdr (reverse temp)))
					(list tcnt)
				) ;_ end of append
		     ) ;_ end of setq
		     (cons temp sumlst)
		   ) ;_ end of progn
		 ) ;_ end of if
    ) ;_ end of setq
  ) ;_ end of if
  (setq	data (vl-remove-if
	       '(lambda	(x)
		  (equal interes
			 (reverse (cdr (reverse (cdr (reverse x)))))
			 0.001
		  ) ;_ end of equal
		) ;_ end of lambda
	       data
	     ) ;_ end of vl-remove-if
  ) ;_ end of setq
) ;_ end of while
(setq sumlst (vl-sort sumlst '(lambda (a b) (< (car a) (car b)))))
(vlax-put-property
  tblobj
  'regeneratetablesuppressed
  :vlax-true
) ;_ end of vlax-put-property
(vla-deleterows tblobj rowmin (- rowmax rowmin))

(setq row (1+ rowmin))
(foreach item sumlst
  (vla-insertrowsandinherit tblobj row rowmin 1)
  (setq col 0)
  (foreach txt item
    (vla-settext tblobj row col txt)
    (setq col (1+ col))
  ) ;_ end of foreach
  (setq row (1+ row))
) ;_ end of foreach
(vla-deleterows tblobj rowmin 1)
(vlax-put-property
  tblobj
  'regeneratetablesuppressed
  :vlax-false
) ;_ end of vlax-put-property

 (setvar 'osmode osm)
  (princ)
  )
(prompt "\n\t\t---\tСтартуй командой:  SUMT \t---")
(prin1)
(or (vl-load-com)(princ))
Последний раз редактировалось Олег (jr.), 04.05.2013 в 09:22. Причина: добавлен код
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 05.05.2013, 01:21
#22
Positron


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

Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
Попробую завтра что-нибудь придумать,
сегодня занят был другими делами

Каждая возьня с таблицами сугубо индивидуальная,
поэтому трудно написать общую функцию, я сделал проще
выделяй нужный диапазон рамкой напимер А4:Е14 для данной таблицы
и удаляй ненужные строки
Пробуй
Код:
[Выделить все] 
(defun C:SUMT (/ colmax colmin celltxt col data interes en getcell marks maxcell mincell osm pmax pmin
	         rowmax rowmin row same sset sumlst tblobj tcnt temp tmp txtline )
  
  (vl-load-com)
;; local defun
;; based on code written by Lee Ambrosius
;; date: 3/24/04
;; edited 11/21/10
(defun getcell(tblobj pt / col lwrleft pick row uprright vector vheight  vwidth)
 
 (setq vheight (getvar "viewsize"))
 (setq vwidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vheight))

 (setq lwrleft (list (- (nth 0 (getvar "viewctr")) (/ vwidth 2)) (- (nth 1 (getvar "viewctr")) (/ vheight 2)) 0))
 (setq uprright (list (+ (nth 0 (getvar "viewctr")) (/ vwidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vheight 2)) 0))

 (setq vector (vlax-make-safearray vlax-vbdouble '(0 . 2)))
 (vlax-safearray-fill vector '(1 1 1))
 (setq vector (vlax-make-variant vector))

 (setq pick (vlax-3d-point pt))

 (if pick 
   (if (= (vla-hittest tblobj pick vector 'row 'col) :vlax-true)
           (list row col)))
  (list row col)
  )

;; 				main part				;;

(princ "\n Выбор bctuj рабочего диапазона значений >> ")
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
 (setq pmin (getpoint "\n\t  >>  Указать левую верхнюю ячейку диапазона таблицы >>" )
	pmax (getcorner pmin "\n\t  >>  Указать правую нижнюю ячейку диапазона таблицы >>" ))
    (setq sset (ssget "_C" pmin pmax '((0 . "ACAD_TABLE"))))
  (setq tblobj (vlax-ename->vla-object (ssname sset 0)))
;;;(setq pmin (getpoint "\n\t >> Specify the left (or top left) cell of the table range >>")
;;;      pmax (getcorner pmin "\n\t >> Specify the right (or bottom right) cell of the table range >>"))
  (setq mincell(getcell tblobj pmin))
  (setq maxcell(getcell tblobj pmax))
  (setq rowmin (car mincell)colmin (cadr mincell)
	rowmax (car maxcell)colmax (cadr maxcell)
	)

;; get contents of selected cell range: 
(setq data nil)
(setq row rowmin)
(while (<= row rowmax)
  (setq col 0)
  (setq txtline nil)
  (while (<= col colmax)
    (setq celltxt (vla-gettext tblobj row col))
    (setq txtline (cons celltxt txtline))
    (setq col (1+ col))
  ) ;_ end of while
  (setq data (append data (list (reverse txtline))))
  (setq row (1+ row))
) ;_ end of while
(setq data (reverse data))
(setq sumlst nil)
(while (setq tmp (car data))
  (setq interes (reverse (cdr (reverse (cdr (reverse tmp))))))
  (setq	same (vl-remove-if-not
	       '(lambda	(x)
		  (equal interes
			 (reverse (cdr (reverse (cdr (reverse x)))))
			 0.001
		  ) ;_ end of equal
		) ;_ end of lambda
	       data
	     ) ;_ end of vl-remove-if-not
  ) ;_ end of setq
  (if same
    (setq sumlst (if (= (length same) 1)
		   (cons (car same) sumlst)
		   (progn
		     (setq marks (apply	'strcat
					(mapcar	'(lambda (x)
						   (strcat x ",")
						 ) ;_ end of lambda
						(vl-sort (mapcar 'car same)
							 '(lambda (a b) (< a b))
						) ;_ end of vl-sort
					) ;_ end of mapcar
				 ) ;_ end of apply
			   marks (substr marks 1 (1- (strlen marks)))
		     ) ;_ end of setq
		     (setq temp (subst marks (caar same) (car same)))
		     (setq tcnt
			    (itoa
			      (apply '+ (mapcar 'atoi (mapcar 'last same)))
			    ) ;_ end of itoa
		     ) ;_ end of setq
		     (setq temp	(append	(reverse (cdr (reverse temp)))
					(list tcnt)
				) ;_ end of append
		     ) ;_ end of setq
		     (cons temp sumlst)
		   ) ;_ end of progn
		 ) ;_ end of if
    ) ;_ end of setq
  ) ;_ end of if
  (setq	data (vl-remove-if
	       '(lambda	(x)
		  (equal interes
			 (reverse (cdr (reverse (cdr (reverse x)))))
			 0.001
		  ) ;_ end of equal
		) ;_ end of lambda
	       data
	     ) ;_ end of vl-remove-if
  ) ;_ end of setq
) ;_ end of while
(setq sumlst (vl-sort sumlst '(lambda (a b) (< (car a) (car b)))))
(vlax-put-property
  tblobj
  'regeneratetablesuppressed
  :vlax-true
) ;_ end of vlax-put-property
(vla-deleterows tblobj rowmin (- rowmax rowmin))

(setq row (1+ rowmin))
(foreach item sumlst
  (vla-insertrowsandinherit tblobj row rowmin 1)
  (setq col 0)
  (foreach txt item
    (vla-settext tblobj row col txt)
    (setq col (1+ col))
  ) ;_ end of foreach
  (setq row (1+ row))
) ;_ end of foreach
(vla-deleterows tblobj rowmin 1)
(vlax-put-property
  tblobj
  'regeneratetablesuppressed
  :vlax-false
) ;_ end of vlax-put-property

 (setvar 'osmode osm)
  (princ)
  )
(prompt "\n\t\t---\tСтартуй командой:  SUMT \t---")
(prin1)
(or (vl-load-com)(princ))
Огромное спасибо! На порядок меньше рутинной работы стало
Во вложении файлик с пробой команды, работает отлично!
Если можно, еще добавить сортировку по возрастанию для 2го типа колонки, в файле оформил в ручную описание с готовым примером.
Вложения
Тип файла: dwg
DWG 2007		 Пример-7.dwg (131.9 Кб, 650 просмотров)
Последний раз редактировалось Positron, 05.05.2013 в 01:36.
Positron вне форума  
Ответ
Страница 2 из 2 < 1 2
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Групирование строк в таблице



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сортировка строк в таблице автокада Crane AutoCAD 4 02.02.2010 02:12
Размер текста в таблице, связанной с файлом Excel TheMouther AutoCAD 2 09.12.2009 08:19
Как удалять в таблице линии внутри столбцов или внутри строк? Elbrus AutoCAD 8 03.11.2009 10:59
Можно ли править количество строк в таблице? XYZ AutoCAD 5 05.05.2009 21:19

Обратная связь - Вверх