Подсчет площадей выбранных контуром с фильтром по слою

Lumpy · 05.08.2021, 16:34

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

Код:

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

 (defun C:SUM_AR ( /  ssp sspn n k ssk pp pl_ar)
(vl-load-com)
(setq item (ssget))
(setq ssp (ssget "_P" '((0 . "*POLYLINE")(8 . "_РД_Выемка"))))
(if ssp
	
     (progn
     (setq sspn (sslength ssp) n 0 k 0 ssk 0)
     (repeat sspn
                   (setq pp (ssname ssp n))
                   (if (= (vlax-get-property (vlax-ename->vla-object pp) 'Closed) :vlax-true)
                            (progn 
  ;                          (command "_-LAYER" "_M" "tmp" "_C" 31 "tmp" "")
  ;                          (command "_-BHATCH" "_s" pp "" "_P" "Solid" "") 
                            (setq pl_ar (vlax-get-property (vlax-ename->vla-object pp) 'Area))
                            (setq ssk (+ ssk pl_ar))
                            (setq k (1+ k))
                             )
                     )
                     (setq n (1+ n))
       )
	
       )
)
(setq item (ssget))
(setq ssp1 (ssget "_P" '((0 . "*POLYLINE")(8 . "_РД_Основание"))))
(if ssp1
	
     (progn
     (setq sspn1 (sslength ssp1) n1 0 k1 0 ssk1 0)
     (repeat sspn1
                   (setq pp1 (ssname ssp1 n1))
                   (if (= (vlax-get-property (vlax-ename->vla-object pp1) 'Closed) :vlax-true)
                            (progn 
  ;                          (command "_-LAYER" "_M" "tmp" "_C" 31 "tmp" "")
  ;                          (command "_-BHATCH" "_s" pp1 "" "_P" "Solid" "") 
                            (setq pl_ar (vlax-get-property (vlax-ename->vla-object pp1) 'Area))
                            (setq ssk1 (+ ssk1 pl_ar))
                            (setq k1 (1+ k1))
                             )
                     )
                     (setq n1 (1+ n1))
       )
	
       )
)
(setq pt (getpoint "\Укажите место вставки результата: "))
(VL-cmdf "_mtext" pt pause  (strcat "_РД_Выемка = " (rtos ssk 2 2) " кв.м \n" "_РД_Основание = " (rtos ssk1 2 2) " кв.м \n"))


(princ)
)

Приложение считает площади, но есть следующие проблемы:
1. Многочисленный выбор объектов(для каждого слоя приходиться заново выбирать объекты) слоев в дальнейшем планируется больше. Возможно ли как-то запросить выбор объектов у пользователя однократно?
2. Если среди выбранных объектов нет объектов в слое по которому идет фильтр то выпадает ошибка " ошибка: неверный тип аргумента: numberp: nil"
3. Интересует вопрос о принципиально другом алгоритме работы. Возможно ли получить список слоев выбранных контуров и если слои совпадают то происходит сложение их площадей?

Alan · 05.08.2021, 16:54

Цитата:

Сообщение от Lumpy

1. Многочисленный выбор объектов(для каждого слоя приходиться заново выбирать объекты) слоев в дальнейшем планируется больше. Возможно ли как-то запросить выбор объектов у пользователя однократно?

Что мешает сделать фильтр на все полилинии слоя?

Код:

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

 (setq ssp1 (ssget "_X" '((0 . "*POLYLINE")(8 . "_РД_Выемка"))))

Цитата:

2. Если среди выбранных объектов нет объектов в слое по которому идет фильтр то выпадает ошибка " ошибка: неверный тип аргумента: numberp: nil"

Что мешает сделать проверку

Код:

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

 (if ssp1  ...

Кулик Алексей aka kpblc · 05.08.2021, 16:56

По-быстрому получение списка вида (("Слой" . ОбщаяПлощадь) ("Слой" . ОбщаяПлощадь) ...)

Код:

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

 (defun t1 (/ selset res layer)
  (if (setq selset (ssget '((0 . "*POLYLINE"))))
    (progn
      (foreach ent (mapcar (function vlax-ename->vla-object)
                           ((lambda (/ item tab)
                              (repeat (setq tab  nil
                                            item (sslength selset)
                                      ) ;_ end setq
                                (setq tab (cons (ssname selset (setq item (1- item))) tab))
                              ) ;_ end of repeat
                            ) ;_ end of lambda
                           )
                   ) ;_ end of mapcar
        (if (and (vlax-property-available-p ent 'area)
                 (vlax-property-available-p ent 'closed)
                 (equal (vla-get-closed ent) :vlax-true)
            ) ;_ end of and
          (progn (setq layer (vla-get-layer ent))
                 (if (cdr (assoc layer res))
                   (setq res (subst (cons layer (+ (cdr (assoc layer res)) (vla-get-area ent))) (assoc layer res) res))
                   (setq res (cons (cons layer (vla-get-area ent)) res))
                 ) ;_ end of if
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  res
) ;_ end of defun

Alan · 05.08.2021, 16:58

сократил пост

Кулик Алексей aka kpblc · 05.08.2021, 17:03

Если будет использоваться мой код, то получение строки (как пример):

Код:

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

 (if (setq str (t1)
          str (mapcar (function (lambda (x) (strcat (car x) " : " (rtos (cdr x) 2 14)))) str)
    ) ;_ end of setq
  (strcat (car str)
          (apply (function strcat) (mapcar (function (lambda (x) (strcat "\n" x))) (cdr str)))
  ) ;_ end of strcat
)

Lumpy · 23.09.2021, 10:36

добавил строку чтоб обрабатывались еще и не замкнутые полилинии и также суммировались по слоям.

Код:

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

 (defun t1 (/ selset res layer)
  (if (setq selset (ssget '((0 . "*POLYLINE"))))
    (progn
      (foreach ent (mapcar (function vlax-ename->vla-object)
                           ((lambda (/ item tab)
                              (repeat (setq tab  nil
                                            item (sslength selset)
                                      ) ;_ end setq
                                (setq tab (cons (ssname selset (setq item (1- item))) tab))
                              ) ;_ end of repeat
                            ) ;_ end of lambda
                           )
                   ) ;_ end of mapcar
        (if (and (vlax-property-available-p ent 'area)
                 (vlax-property-available-p ent 'closed)
                 (equal (vla-get-closed ent) :vlax-true)
            ) ;_ end of and
          (progn (setq layer (vla-get-layer ent))
                 (if (cdr (assoc layer res))
                   (setq res (subst (cons layer (+ (cdr (assoc layer res)) (vla-get-area ent))) (assoc layer res) res))
                   (setq res (cons (cons layer (vla-get-area ent)) res))	    
                 ) ;_ end of if			 
          ) ;_ end of progn
        ) ;_ end of if
		(if (and (vlax-property-available-p ent 'length)
                 (vlax-property-available-p ent 'closed)
                 (equal (vla-get-closed ent) :vlax-false)
            ) ;_ end of and
          (progn (setq layer (vla-get-layer ent))
                 (if (cdr (assoc layer res))
                   (setq res (subst (cons layer (+ (cdr (assoc layer res)) (vla-get-length ent))) (assoc layer res) res))
                   (setq res (cons (cons layer (vla-get-length ent)) res))	    
                 ) ;_ end of if			 
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  

  res

) ;_ end of defun

(defun C:SUM_AR ( /  )
(setq text (entget (car (entsel"\nВыберите текст: "))))
 (if (setq str (t1)
          str (mapcar (function (lambda (x) (strcat (car x) " = " (rtos (/(cdr x)100) 2 2)" м2"))) str)
    ) ;_ end of setq
 
  (VL-cmdf "_mtext" pause pause (strcat (cdr(assoc 1 text)) " \\P" (car str)
          (apply (function strcat) (mapcar (function (lambda (x) (strcat "\\P" x))) (cdr str))))
  ) ;_ end of strcat
)
)

и возник вопрос а возможно ли сделать вывод в зависимости от того что я выбрал (если я выбрал замкнутый контур то будет м2, а если не замкнутый то просто м) ?

kp+ · 23.09.2021, 21:57

Цитата:

Сообщение от Lumpy

и возник вопрос а возможно ли сделать вывод в зависимости от того что я выбрал (если я выбрал замкнутый контур то будет м2, а если не замкнутый то просто м) ?

Надо доработать функцию t1, где эта проверка уже делается, чтобы она, например, возвращала сразу готовый результат - не число, а строку "3,5 м" или "2,5 м2". И сразу использовать в функции C:SUM_AR, без дополнительной обработки.
Или чтобы t1 возвращала список вроде (res nil) для незамкнутой полилинии, (res T) для замкнутой, и обрабатывать его в функции C:SUM_AR.
Ваш код править не берусь, уж очень мудрено на ровном месте он написан, по моим простецким меркам.
Еще интересный момент - было бы неплохо проверять такой клинический случай, как визуально замкнутые, но формально разомкнутые полилинии. Т.е. такие, у которых первая и последняя точка совпадают, но флаг замкнутости (closed) не выставлен.

Offtop: Я для подобных задач использовал бы связку Geomprops и стандартную команду выбора с опцией 'filter

Lumpy · 27.09.2021, 18:34

а возможно ли как-то пройтись по всему списку целиком, а не сначала по хвосту, а потом по голове?
конкретнее на примере строчку 31 и 32 схлопнуть в 1.
Просто у меня вроде получается в 31 строчке добавить необходимые преобразования с делением на 100 и постановки М в конец, но тогда у меня не происходит суммирования с 32 строчкой и выдает ошибку(либо возможно я так и не смог понять как это работает).

Кулик Алексей aka kpblc · 27.09.2021, 19:48

Если разговор про мой код, то:
"Схлопнуть" не получится - там действия разные выполняются.
Ты в одну кучу видаешь и длину, и площадь, да еще и суммируешь потом. И что ты получишь, складывая километры и попугаев?
Сначала надо все сложить / умножить / вычесть / поделить, и только потом уже преобразовывать в строки.

----- добавлено через ~20 мин. -----
P.S. И никто не мешает сделать после выбора любую сортировку.

----- добавлено через ~47 мин. -----
В ту же степь - ты в чем чертишь, что для получения площади в кв.м. делишь на 100? В дециметрах?

----- добавлено через ~1 ч. -----
Код на C# чего-то писаться отказывается, так вот тебе вариант:

Код:

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

 (defun t2 (/ selset areas layer lengths pt mtext res)
  (if (and (setq selset (ssget '((0 . "*POLYLINE"))))
           (setq pt (getpoint "\nТочка вставки результата <Отмена> : "))
      ) ;_ end of and
    (progn (foreach ent (mapcar (function vlax-ename->vla-object)
                                ((lambda (/ item tab)
                                   (repeat (setq tab  nil
                                                 item (sslength selset)
                                           ) ;_ end setq
                                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                   ) ;_ end of repeat
                                 ) ;_ end of lambda
                                )
                        ) ;_ end of mapcar
             (setq layer (vla-get-layer ent))
             (if (and (vlax-property-available-p ent 'area)
                      (vlax-property-available-p ent 'closed)
                      (equal (vla-get-closed ent) :vlax-true)
                 ) ;_ end of and
               (if (cdr (assoc layer areas))
                 (setq areas (subst (cons layer (+ (cdr (assoc layer areas)) (vla-get-area ent))) (assoc layer areas) areas))
                 (setq areas (cons (cons layer (vla-get-area ent)) areas))
               ) ;_ end of if
             ) ;_ end of if
             (if (vlax-property-available-p ent 'length)
               (if (cdr (assoc layer lengths))
                 (setq lengths (subst (cons layer (+ (cdr (assoc layer lengths)) (vla-get-length ent)))
                                      (assoc layer lengths)
                                      lengths
                               ) ;_ end of subst
                 ) ;_ end of setq
                 (setq lengths (cons (cons layer (vla-get-length ent)) lengths))
               ) ;_ end of if
             ) ;_ end of if
           ) ;_ end of foreach
           (setq res (list (cons "areas" (vl-sort areas (function (lambda (a b) (< (car a) (car b))))))
                           (cons "lengths" (vl-sort lengths (function (lambda (a b) (< (car a) (car b))))))
                     ) ;_ end of list
           ) ;_ end of setq
           (setq mtext (vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                                     (vlax-3d-point pt)
                                     0.
                                     (strcat "Площади : "
                                             (apply (function strcat)
                                                    (mapcar (function (lambda (x) (strcat "\\PСлой \"" (car x) "\" : " (rtos (* (cdr x) 1e-6) 2 14) " м2")))
                                                            (cdr (assoc "areas" res))
                                                    ) ;_ end of mapcar
                                             ) ;_ end of apply
                                             "\\P\\PДлины : "
                                             (apply (function strcat)
                                                    (mapcar (function (lambda (x) (strcat "\\PСлой \"" (car x) "\" : " (rtos (* (cdr x) 1e-3) 2 14) " м")))
                                                            (cdr (assoc "lengths" res))
                                                    ) ;_ end of mapcar
                                             ) ;_ end of apply
                                     ) ;_ end of strcat
                       ) ;_ end of vla-addmtext
           ) ;_ end of setq
           res
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

----- добавлено через ~1 ч. -----
Интересно, найдешь подставу или нет

Lumpy · 28.09.2021, 15:20

Цитата:

Сообщение от Кулик Алексей aka kpblc

Ты в одну кучу видаешь и длину, и площадь, да еще и суммируешь потом. И что ты получишь, складывая километры и попугаев?
Сначала надо все сложить / умножить / вычесть / поделить, и только потом уже преобразовывать в строки.

Тут все просто по задумке как разделение необходимости складывания тех или иных полилиний как раз и служит свойство их замкнутости.
Получается что если контур полилинии замкнут то я хочу получить с этого объекта площадь, а если не замкнут то хочу получить длину.

Цитата:

Сообщение от Кулик Алексей aka kpblc

В ту же степь - ты в чем чертишь, что для получения площади в кв.м. делишь на 100? В дециметрах?

это приложение необходимо для подписи площадей и длин на поперечных профилях автомобильной дороги выполненных в масштабе 1:100, а получить мне нужно метры и метры квадратные.

Цитата:

Сообщение от Кулик Алексей aka kpblc

Интересно, найдешь подставу или нет

ну я не знаю что считается подставой, но умножение поменял на деление и все же вернул проверку на замкнутость контура в подписи длин =)
ну и чутка все же вывод под себя придется допилить но с этим я уже справлюсь=)
Огромнейшее спасибо =)
к сожалению не понял как картинку подгрузить чтоб скрин прикрепить того что в итоге должно получиться поэтому просто текстом напишу.
"ПК 1+41.21
Выемка = 0.56 м2
Планировка верха земляного полотна=2.00 м
Планировка откосов и обочин=0.52 м"

Offtop: и небольшой вопрос для создания лисп приложений есть ли какое то IDE?

Кулик Алексей aka kpblc · 28.09.2021, 15:40

М-да, черчение в масштабе... Тяжелый случай.

Цитата:

Сообщение от Lumpy

но умножение поменял на деление

Выполни код - чисто для приколу

Код:

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

 (princ (rtos (/ 5 2) 2 14))

К вопросу о делении.

Цитата:

Сообщение от Lumpy

вернул проверку на замкнутость контура в подписи длин

Ты сам себе противоречишь:

Цитата:

Сообщение от Lumpy

если контур полилинии замкнут то я хочу получить с этого объекта площадь, а если не замкнут то хочу получить длину.

Ну да дело твое.

Цитата:

Сообщение от Lumpy

для создания лисп приложений есть ли какое то IDE?

VLIDE, VSCode + AutoCAD Extension, есть люди, которые вообще в Notepad++ пишут.

kp+ · 28.09.2021, 15:42

Lumpy · 28.09.2021, 16:10

Цитата:

Сообщение от Кулик Алексей aka kpblc

Ты сам себе противоречишь:

возможно я просто немного не корректно доношу свою мысль.

Цитата:

Сообщение от Кулик Алексей aka kpblc

Выполни код - чисто для приколу

по поводу количества знаков после запятой естественно поменял.

Цитата:

Сообщение от Кулик Алексей aka kpblc

VLIDE, VSCode + AutoCAD Extension, есть люди, которые вообще в Notepad++ пишут.

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

----- добавлено через ~18 мин. -----
Ну и на всякий случай вдруг кому пригодиться.

Код:

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

 (defun c:sum_ar (/ selset areas layer lengths pt mtext res)
	(setq text (entget (car (entsel"\nВыберите пикет: "))))
  (if (and (setq selset (ssget '((0 . "*POLYLINE"))))
           (setq pt (getpoint "\nТочка вставки результата <Отмена> : "))
      ) ;_ end of and
    (progn (foreach ent (mapcar (function vlax-ename->vla-object)
                                ((lambda (/ item tab)
                                   (repeat (setq tab  nil
                                                 item (sslength selset)
                                           ) ;_ end setq
                                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                   ) ;_ end of repeat
                                 ) ;_ end of lambda
                                )
                        ) ;_ end of mapcar
             (setq layer (vla-get-layer ent))
             (if (and (vlax-property-available-p ent 'area)
                      (vlax-property-available-p ent 'closed)
                      (equal (vla-get-closed ent) :vlax-true)
                 ) ;_ end of and
               (if (cdr (assoc layer areas))
                 (setq areas (subst (cons layer (+ (cdr (assoc layer areas)) (vla-get-area ent))) (assoc layer areas) areas))
                 (setq areas (cons (cons layer (vla-get-area ent)) areas))
               ) ;_ end of if
             ) ;_ end of if
             (if (and(vlax-property-available-p ent 'length)
					  (vlax-property-available-p ent 'closed)
                      (equal (vla-get-closed ent) :vlax-false)
					) ;_ end of and 
               (if (cdr (assoc layer lengths))
                 (setq lengths (subst (cons layer (+ (cdr (assoc layer lengths)) (vla-get-length ent)))
                                      (assoc layer lengths)
                                      lengths
                               ) ;_ end of subst
                 ) ;_ end of setq
                 (setq lengths (cons (cons layer (vla-get-length ent)) lengths))
               ) ;_ end of if
             ) ;_ end of if
           ) ;_ end of foreach
           (setq res (list (cons "areas" (vl-sort areas (function (lambda (a b) (< (car a) (car b))))))
                           (cons "lengths" (vl-sort lengths (function (lambda (a b) (< (car a) (car b))))))
                     ) ;_ end of list
           ) ;_ end of setq
		   (setq mtext (vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
                                     (vlax-3d-point pt)
                                     0.
                                     (strcat (cdr(assoc 1 text))
                                             (apply (function strcat)
                                                    (mapcar (function (lambda (x) (strcat "\\P" (car x) " = " (rtos (/ (cdr x) 100) 2 2) " м2")))
                                                            (cdr (assoc "areas" res))
                                                    ) ;_ end of mapcar
                                             ) ;_ end of apply
                                             (apply (function strcat)
                                                    (mapcar (function (lambda (x) (strcat "\\P"  (car x) " = " (rtos (/ (cdr x) 100) 2 2) " м")))
                                                            (cdr (assoc "lengths" res))
                                                    ) ;_ end of mapcar
                                             ) ;_ end of apply
                                     ) ;_ end of strcat
                       ) ;_ end of vla-addmtext
           ) ;_ end of setq
           res
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Подсчет площадей квартиры и составление квартирографии в Autocad Architecture?	Pavel_hoz	Вертикальные решения на базе AutoCAD	19	28.12.2018 15:04
Автоматический подсчет общей, жилой и приведенной площадей квартир	s_get	Вертикальные решения на базе AutoCAD	27	27.06.2013 15:04
Автоматический нумерация и подсчет площадей по размерам. Реально?	Yur.OK_SPb	AutoCAD	13	18.06.2013 11:57
Автоматизировать подсчет суммы длин отрезков по определенному слою? Возможно ли?	nikolakrg	Программирование	11	26.10.2012 17:20
ADT2007 подсчет площадей.	favorite	Прочее. Программное обеспечение	7	07.07.2006 17:16