[Positron]

Прошу помощи у программистов, нужен лисп для группировки подобных цифр в столбике таблицы. Во вложении подробное описание.

[IMG]http://s019.***********/i611/1204/be/f84f5d120fc5.jpg[/IMG]

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

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

[Олег (jr.)]

Посмотри здесь
http://forums.augi.com/showthread.ph...=1#post1168693

[Positron]

Сообщение от Олег (jr.) Посмотри здесь http://forums.augi.com/showthread.ph...=1#post1168693

там чуток нето, блоки и выкусывание атрибутов блока в таблицу.
Мне над сортировка и суммирование ... я просто хз как программно реализовать сие чудо

[Do$]

Вот взять бы первое сообщение - и в FAQ. В качестве примера того, как надо описывать свои просьбы
Positron,

[Positron]

Сообщение от Do$ Вот взять бы первое сообщение - и в FAQ. В качестве примера того, как надо описывать свои просьбы Positron,

м... исходя из того сколько мне помогли на форуме могу посодействовать если надо

[gomer]

похожая тема

[Олег (jr.)]

Попробуй вот это

Код:

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

;;--------------------------------------------------------------------;;
(defun sum-and-groupby_qty (lst num / count countdata elem match tmp)
  
(while lst
  
(setq tmp (car lst))

(setq match (vl-remove-if-not '(lambda(x)(eq (nth num x)(nth num tmp) ))

					  lst))

(setq count (apply '+ (mapcar 'atoi (mapcar 'last  match))))
  
(setq elem (subst (itoa count) (last tmp)  tmp))
  
(setq countdata (cons elem countdata))

(setq lst (vl-remove-if '(lambda(x)(eq (nth num x)(nth num tmp) ))

					  lst))
  )
(vl-sort countdata '(lambda(a b)(< (nth num a)(nth num b))))
  
  )
;;---------------------------------------------------------------------;;
(defun get-table-content (tbl / col cols data datum row rows start tmp)

  (setq	cols  (vla-get-columns tbl)
	rows  (vla-get-rows tbl)
	start rows
	)
  (if (eq :vlax-true (vla-get-titlesuppressed tbl))
    (setq rows (1- rows))
  )
  (if (eq :vlax-true (vla-get-headersuppressed tbl))
    (setq rows (1- rows))
  )
  (setq row (- start rows))
  (repeat rows
    (setq col 0)
    (repeat cols
      (setq datum (vla-gettext tbl row col))
      (setq tmp (cons datum tmp))
      (setq col (1+ col))
    )
    (setq data (cons (reverse tmp) data))
    (setq tmp  nil)
    (setq row  (1+ row))
    )

  (reverse data)
)
;;----------------------------   main part   --------------------------------;;


(defun C:GRPT  (/ cnt col cols data ent idx n num row rows tabledata tbl tmp)
  
(setq ent (entsel "\nSelect table :"))

(setq idx (getint "\nEnter a column number :"))

(setq idx (1- idx))

(setq tbl (vlax-ename->vla-object (car ent)))
  
 (setq tabledata (cddr (get-table-content tbl)))

(setq rows (vla-get-rows tbl))

(setq cols (vla-get-columns tbl))

(setq row 2)

(vla-put-regeneratetablesuppressed tbl :vlax-true)

(setq tabledata (sum-and-groupby_qty tabledata idx))

(setq n 0)

(setq data nil)

(foreach x  tabledata

  (setq x (append (list (itoa (+ n 1))) (cdr x)))

  (setq data (cons x data))

  (setq n (1+ n))
  )

(setq data (reverse data))

(setq row 2)

  (setq num (length data))
  
(setq cnt (+ rows num))
  
(repeat num

  (setq tmp (car data))
  
(vla-InsertRowsAndInherit tbl row (- row 1) 1)

  (setq col 0)

  (while (< col cols)

    (vla-settext tbl row col (nth col tmp))

    (setq col (1+ col))
    )
  (setq row (1+ row))

  (setq data (cdr data))
  )
   
  (setq rows (vla-get-rows tbl))
  
  (vla-deleterows tbl (+ num 2)(- rows num))
  
(vla-put-regeneratetablesuppressed tbl :vlax-false)

(princ)
  
  )

(prompt "\n\t---\tStart command with GRPT\t---\n")
(prin1)
 (or (vl-load-com))
(princ)

~'o'~

[Positron]

Сообщение от Олег (jr.) Попробуй вот это Код: [Выделить все] ;;--------------------------------------------------------------------;; (defun sum-and-groupby_qty (lst num / count countdata elem match tmp) (while lst (setq tmp (car lst)) (setq match (vl-remove-if-not '(lambda(x)(eq (nth num x)(nth num tmp) )) lst)) (setq count (apply '+ (mapcar 'atoi (mapcar 'last match)))) (setq elem (subst (itoa count) (last tmp) tmp)) (setq countdata (cons elem countdata)) (setq lst (vl-remove-if '(lambda(x)(eq (nth num x)(nth num tmp) )) lst)) ) (vl-sort countdata '(lambda(a b)(< (nth num a)(nth num b)))) ) ;;---------------------------------------------------------------------;; (defun get-table-content (tbl / col cols data datum row rows start tmp) (setq cols (vla-get-columns tbl) rows (vla-get-rows tbl) start rows ) (if (eq :vlax-true (vla-get-titlesuppressed tbl)) (setq rows (1- rows)) ) (if (eq :vlax-true (vla-get-headersuppressed tbl)) (setq rows (1- rows)) ) (setq row (- start rows)) (repeat rows (setq col 0) (repeat cols (setq datum (vla-gettext tbl row col)) (setq tmp (cons datum tmp)) (setq col (1+ col)) ) (setq data (cons (reverse tmp) data)) (setq tmp nil) (setq row (1+ row)) ) (reverse data) ) ;;---------------------------- main part --------------------------------;; (defun C:GRPT (/ cnt col cols data ent idx n num row rows tabledata tbl tmp) (setq ent (entsel "\nSelect table :")) (setq idx (getint "\nEnter a column number :")) (setq idx (1- idx)) (setq tbl (vlax-ename->vla-object (car ent))) (setq tabledata (cddr (get-table-content tbl))) (setq rows (vla-get-rows tbl)) (setq cols (vla-get-columns tbl)) (setq row 2) (vla-put-regeneratetablesuppressed tbl :vlax-true) (setq tabledata (sum-and-groupby_qty tabledata idx)) (setq n 0) (setq data nil) (foreach x tabledata (setq x (append (list (itoa (+ n 1))) (cdr x))) (setq data (cons x data)) (setq n (1+ n)) ) (setq data (reverse data)) (setq row 2) (setq num (length data)) (setq cnt (+ rows num)) (repeat num (setq tmp (car data)) (vla-InsertRowsAndInherit tbl row (- row 1) 1) (setq col 0) (while (< col cols) (vla-settext tbl row col (nth col tmp)) (setq col (1+ col)) ) (setq row (1+ row)) (setq data (cdr data)) ) (setq rows (vla-get-rows tbl)) (vla-deleterows tbl (+ num 2)(- rows num)) (vla-put-regeneratetablesuppressed tbl :vlax-false) (princ) ) (prompt "\n\t---\tStart command with GRPT\t---\n") (prin1) (or (vl-load-com)) (princ) ~'o'~

Огромное спасибо!
А можно ещё чуток усложнить, добавив в колонке цифры со значением типа "1000 x 500" и т.п. их по аналогии свисти в группы, а количество считать...
Во вложении пример

[Олег (jr.)]

Попробуй заменить основную комманду:

Код:

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

;;------------------------------------------------------------------;;
(defun sum-and-groupby_qty (lst num / count countdata elem match tmp)
  
(while lst
  
(setq tmp (car lst))

(setq match (vl-remove-if-not '(lambda(x)(equal x tmp 0.001) )

					  lst))
(setq count (apply '+ (mapcar 'atoi (mapcar 'last  match))))
  
(setq elem (subst (itoa count) (last tmp)  tmp))
  
(setq countdata (cons elem countdata))

  (setq lst (vl-remove-if '(lambda(x)(equal  x tmp 0.001) )

					  lst))
  )
(vl-sort countdata '(lambda(a b)(< (nth 0 a)(nth 0 b))))
  
  )
;;---------------------------------------------------------------------;;
(defun get-table-content (tbl / col cols data datum row rows start tmp)

  (setq	cols  (vla-get-columns tbl)
	rows  (vla-get-rows tbl)
	start rows
	)
;;;  (if (eq :vlax-true (vla-get-titlesuppressed tbl))
;;;    (setq rows (1- rows))
;;;  )
;;;  (if (eq :vlax-true (vla-get-headersuppressed tbl))
;;;    (setq rows (1- rows))
;;;  )
  (setq row (- start rows))
  (repeat rows
    (setq col 0)
    (repeat cols
      (setq datum (vla-gettext tbl row col))
      (setq tmp (cons datum tmp))
      (setq col (1+ col))
    )
    (setq data (cons (reverse tmp) data))
    (setq tmp  nil)
    (setq row  (1+ row))
    )

  (reverse data)
)
;;----------------------------   main part   --------------------------------;;


(defun C:GRPT  (/   cnt col cols ent idx num row rows tabledata tbl tmp)
  
(setq ent (entsel "\nSelect table :"))

  (initget 6)
  
(setq idx (getint "\nEnter a column number <1>:"))

  (cond ((not idx)(setq idx 1)))

(setq idx (1- idx))

(setq tbl (vlax-ename->vla-object (car ent)))
  
 (setq tabledata (get-table-content tbl))

(setq rows (vla-get-rows tbl))

(setq cols (vla-get-columns tbl))

(setq cnt rows)

(vla-put-regeneratetablesuppressed tbl :vlax-true)

(setq tabledata (sum-and-groupby_qty tabledata idx))

(setq row 0)

(setq num (length tabledata))
  
  (vla-InsertRowsAndInherit tbl 0 0 num)
(repeat num

  (setq tmp (car tabledata))

  (setq col 0)

  (while (< col cols)

    (vla-settext tbl row col (nth col tmp))

    (setq col (1+ col))
    )
  (setq row (1+ row))

  (setq tabledata (cdr tabledata))
  )
   
  (setq rows (vla-get-rows tbl))
  
  (vla-deleterows tbl num cnt)

(vla-put-regeneratetablesuppressed tbl :vlax-false)

(princ)
  
  )

(prompt "\n\t---\tStart command with GRPT\t---\n")
(prin1)
 (or (vl-load-com))
(princ)

~'o'~

[Positron]

- выбрал таблицу
- 1 Enter по умолчанию 1 стоит,
- результат:

Command: GRPT
Select table :
Enter a column number <1>:
; error: no function definition: GET-TABLE-CONTENT

м... мож чо не так делаю?

[Олег (jr.)]

Сообщение от Positron м... мож чо не так делаю?

Я же сказал - замени только основную команду GRPT,
остальные субрутины оставь как есть
Что непонятно?

[Positron]

Сообщение от Олег (jr.) Я же сказал - замени только основную команду GRPT, остальные субрутины оставь как есть Что непонятно?

Сори, упустил... работает ток не все пощитало, вот пример до и после.

[Олег (jr.)]

Сообщение от Positron Сори, упустил... работает ток не все пощитало, вот пример до и после.

Смотри код в посте #9
(У тебя изменяются условия в таблице, поэтому сделал для рисунка Пример-3.dwg,
если опять будешь чего менять, тогда переделывай сам)

~'o'~

[ashas-]

Здраствуйте, прошу прощения, если задаю вопрос не в той теме. Но мои поиски наиболее подходящей потерпели фиаско .
Вопрос. Где находится информация о том какие ячейки(столбцы) в таблице объединины, и как достать эту информацию с помощью автолиспа?

[Олег (jr.)]

Смотри функцию:

Код:

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

(vla-IsMergedCell tableobj row col 'minRow 'maxRow 'minCol 'maxCol)

не забудь про одиночные кавычки

~'o'~

[Дима_]

Сообщение от Олег (jr.) не забудь про одиночные кавычки

только они нужны у последних 4 аргументов (у row и col - не надо).

[ashas-]

Олег (jr.), Дима_. Благодарю .

[Positron]

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

[Олег (jr.)]

Извини даже смотреть не буду,
не показал что должно получиться в результате
или ты думаешь остальные будут это делать за тебя?

[Positron]

Прошу помощи в решении задачи.
Простите меня за неправильно заданный вопрос, постарался исправить, (грамматику не проверял), но суть задачи постарался написать максимально понятно (как себе представляю алгоритм). Пример во вложении.
Благодарю за поправку, буду расти над собой и не ленится.

P.S. Подскажите пожалуйста еще по поводу подачи вопроса, как лучше его оформлять кратко дабы не перегружать вопрос или описывать по каждому шагу чтоб было подробней?