• Sergei
  • Восстановленный участник
  • На форуме с 2 марта 2004г.
  • Сообщений: 6
  • Спасибо: 0

Тема: Подсчет площади множества полилиний

Привет!
Внезапно возник вопрос, как в акаде подсчитать площадь множества замкнутых полилиний?
Нужно для расчета золота при фотолитографии.
Командой area не подходит, приходится вручную указывать все объекты.
Если кто-то знает, просьба ответить....

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: Подсчет площади множества полилиний

Что-то вроде этого:

(defun C:pl-ar()
(vl-load-com)
  (setq plin
     (vl-remove-if 'listp
       (mapcar 'cadr
           (ssnamex
             (ssget '((0 . "lwpolyline,polyline")))
             )
           )
       )
    )
  (apply '+
     (mapcar 'vlax-curve-getarea
         (mapcar 'vlax-ename->vla-object plin)
         )
     )
  )

  • Sergei
  • Восстановленный участник
  • На форуме с 2 марта 2004г.
  • Сообщений: 6
  • Спасибо: 0

Re: Подсчет площади множества полилиний

Эдуард, сенькс... :))) А еще мона вопрос... как сделать чтоб скажем в 1 слое без выбора полилиний по команде их площадь считалась? (В слое только полилинии, других объектов нет... )

  • Arkady
  • Восстановленный участник
  • На форуме с 16 марта 2002г.
  • Сообщений: 221
  • Спасибо: 0

Re: Подсчет площади множества полилиний

Измени
(ssget '((0 . "lwpolyline,polyline")))
на
(ssget '((8 . "1") (0 . "lwpolyline,polyline")))

  • Arkady
  • Восстановленный участник
  • На форуме с 16 марта 2002г.
  • Сообщений: 221
  • Спасибо: 0

Re: Подсчет площади множества полилиний

Извиняюсь - на
(ssget "X"  '((8 . "1") (0 . "lwpolyline,polyline")))

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: Подсчет площади множества полилиний

Уточняю:

(defun C:pl-ar()
  (while
    (not
    (setq lay (car(entsel "\nВыберите объект для определения слоя:")
          )
      )
    )
    )
    (setq lay (cdr
        (assoc 8 (entget lay)
               )
        )
      )
  (if
  (setq plin (ssget "x" (list
                  (cons 8 lay)
                    '(0 . "lwpolyline,polyline")
                  )
             )
    )
  (progn
     (setq plin (vl-remove-if 'listp
       (mapcar 'cadr
           (ssnamex plin)
           )
              )
           )
  (apply '+
     (mapcar 'vlax-curve-getarea
         (mapcar 'vlax-ename->vla-object plin)
         )
     )
  )
  (alert "На слое нет полилиний")
  )
  )