[Pave1]

Как сделать так чтобы в таблице (см. приложенный файл) появлялась только одна строчка с суммой всех отрезков?
[ATTACH]1149250604.dwg[/ATTACH]

[fixo]

Сообщение от Pave1 Как сделать так чтобы в таблице (см. приложенный файл) появлялась только одна строчка с суммой всех отрезков? [ATTACH]1149250604.dwg[/ATTACH]

Пробуй

Код:

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

;; #51.  Группировка одинаковыx одинаковых элементов
;; с подсчетом их сумм итерационным методом
;; аргументы - любые простые элементы (не списки и не NIL)
;; результат - список в виде субсписков, где первым
;; стоит элемент, вторым - сумма этого элемента в
;; в общем списке

  (defun group-by-value (lst / ret tmp)
  (while (car lst)
  (setq tmp (list (vl-remove-if-not (function (lambda (a)
			(equal a (car lst) 1e-12))) lst)))
  (setq ret (cons (car tmp) ret))
  (setq lst (vl-remove-if (function (lambda (a)
			(equal a (car lst) 1e-12))) lst))
  (setq tmp nil))
  (setq ret (mapcar (function (lambda (x)
		(list (car x) (length x)))) (reverse ret)))
    )

;=========================================================;

(defun C:tdl  (/ acm acsp adoc app_head	atable atts axss cnt
	       count_list data_list len_data row sub_head total wid_list)

  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	       )
	)
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
	)
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
    )
  (vla-zoomextents (vlax-get-acad-object))
  (and (ssget "_X" (list (cons 0 "INSERT")))
       (setq axss (vla-get-activeselectionset adoc)))
  (vlax-for obj	 axss
    (if
      (and
	(vlax-property-available-p obj 'Hasattributes)
	(eq :vlax-true (vla-get-hasattributes obj))
	)
       (progn
	 (setq atts (vlax-invoke obj 'Getattributes))
	 (foreach att  atts
	   (if (eq (strcase "ДлинаОтрезка")
		   (strcase (vla-get-tagstring att)))
	     (setq len_data (cons (vla-get-textstring att) len_data)))))))
  (setq count_list (group-by-value (acad_strlsort len_data)))
  (setq total (apply '+ (mapcar 'cadr count_list)))
  (setq	count_list
	 (mapcar (function (lambda (x)
			     (mapcar 'vl-princ-to-string x)))
		 count_list))


  (setq	atable (vla-addtable
		 acsp
		 (vlax-3d-point
		   (getpoint "\nSpecify top left corner of a table \n"))
		 (+ (length count_list) 3) ;rows
		 7 ;columns
		 13.4533
		 30.

		 )
	)
  (vla-settextstyle atable acTitleRow "Gost A")
  (vla-settextstyle atable acHeaderRow "Gost A")
  (vla-settextstyle atable acDataRow "Gost A")
  (vla-settextheight atable acDataRow 12.5)
  (vla-settextheight atable acHeaderRow 10.)
  (vla-settextheight atable acDataRow 10.)
  (setq wid_list '(181.0143 21.7286 53.1571 60.3 15.3 79.5857 62.))
  (setq cnt 0)
  (foreach item	 wid_list
    (vla-setcolumnwidth atable cnt item)
    (setq cnt (1+ cnt)))
  (vla-settext atable 0 0 "SECTIONS SPECIFICATION")
  (vla-setcellalignment atable 0 0 acmiddlecenter)
  (vla-setcelltextheight atable 0 0 12.5)
  (setq	sub_head
	 (list "НАИМЕНОВАНИЕ" "ТИП" "КОД" "ЗАВОД" "ЕД."	"ДЛИНА"	"КОЛИЧЕСТВО"))
  (setq	app_head
	 (list "КОРОБ ПЕРФОРИРОВАННЫЙ, 25Х60" "" "36202" "LEGRAND" "М"))
  (setq	data_list (mapcar (function (lambda (x) (append app_head x)))
			  count_list))
  (setq cnt 0)
  (foreach item	 sub_head
    (vla-settext atable 1 cnt item)
    (vla-setcellalignment atable 1 cnt acmiddlecenter)
;;;              (vla-setcelltextheight atable 1 cnt 10.)
    (setq cnt (1+ cnt))
    )
  (setq row 2) ;2
  (setq cnt 0)
  (foreach cel	data_list
    (foreach item  cel
      (vla-settext atable row cnt item)
      (vla-setcellalignment
	atable
	row
	cnt
	acmiddlecenter)
;;;              (vla-setcelltextheight atable row cnt 10.)
      (setq cnt (1+ cnt))
      )
    (setq row (1+ row))
    (setq cnt 0)
    )
  (vla-settext atable row 0 "ОБЩЕЕ КОЛИЧЕСТВО")
  (vla-setcellalignment
    atable
    row
    0
    acmiddlecenter)
  (vla-settext atable row 6 (itoa total))
  (vla-setcellalignment
    atable
    row
    6
    acmiddlecenter)
  (setq	acm (vla-GetInterfaceObject
	      (vlax-get-acad-object)
	      "AutoCAD.AcCmColor.16"))
  (vla-setrgb acm 0 255 0)
  (vla-put-truecolor atable acm)
  (vla-setrgb acm 255 0 255)
  (vla-setgridcolor atable acHorzTop acDataRow acm)
  (vla-setgridcolor atable acHorzBottom acDataRow acm)
  (vla-setgridcolor atable acHorzInside acDataRow acm)
  (vla-setgridcolor atable acVertLeft acDataRow acm)
  (vla-setgridcolor atable acVertRight acDataRow acm)
  (vla-setgridcolor atable acHorzInside acDataRow acm)
  (vla-setgridcolor atable acVertInside acDataRow acm)

  (vl-catch-all-apply
    (function
      (lambda ()
	(progn
	  (vla-clear axss)
	  (vla-delete axss)
	  (mapcar 'vlax-release-object (list axss acm atable))
	  )
	)
      )
    )
  (princ)
  )
; TesT : (C:tdl)

~'J'~

[Pave1]

Fatty
Немного не то.
Надо чтобы не общее число считалось, а общая длина (т.е. длина первого блока + длина второго блока + . . . ). И в итоге получалась одна лишь строчка с таблице

[fixo]

Сообщение от Pave1 Fatty Немного не то. Надо чтобы не общее число считалось, а общая длина (т.е. длина первого блока + длина второго блока + . . . ). И в итоге получалась одна лишь строчка с таблице

Это я для примера а уж одну строчку сам сообразишь как из этой программы оставить
Успехов

~'J'~