[Supermax]

Стал писать функцию, которая вычисляет сумму всех площадей и за основу взял GeomProps Александра Ривилиса, но, оказалось, что 3Dface изогнутая по оси этой прогой не считается (пока).
Вот я и призадумался. Посмотрел сам объект и заметил, что 2 и 4 точки (а их всего четыре) всегда составляют грань изогнутого 3Dface. И эта грань острая, без сплайновых заморочек. Значит 3Dface не что иное как склеенных два треугольника (1-2-4) и (2-3-4). Все координаты точек есть в dxf коде объекта, значит, даже без применения всяких изощрений можно тригонометрически посчитать площадь этих треугольников.


Объект "AcDbSubDMesh" как мне сказал Александр Ривилис имеет свойство area и я надеюсь на скорое его появление в GeomProps.

(defun 3Dfase-area (obj / l p r s)
;|
Функция сделана на основе функции Елпанова Евгения
http://elpanov.com/index.php?id=36
3-я версия

Проверку на соответствие типу объекта намеренно не вставлял, так как планирую использовать при обработке наборов
созданных с такой фильтрацией.

Пример использования:
(3Dfase-area (car (entsel)))

|;
(setq l (cons 0 (mapcar (function distance)
(list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj))) (cdr (assoc 13 (entget obj))))
(list (cdr (assoc 11 (entget obj))) (cdr (assoc 13 (entget obj))) (cdr (assoc 10 (entget obj))))
))
p (/ (apply (function +) l) 2.)
) ;_ setq

(setq r (cons 0 (mapcar (function distance)
(list (cdr (assoc 11 (entget obj))) (cdr (assoc 12 (entget obj))) (cdr (assoc 13 (entget obj))))
(list (cdr (assoc 12 (entget obj))) (cdr (assoc 13 (entget obj))) (cdr (assoc 11 (entget obj))))
))
s (/ (apply (function +) r) 2.)
) ;_ setq

(+
(sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p)))))
(sqrt (abs (apply (function *) (mapcar (function -) r (list s s s s)))))
)
) ;_ defun

(vl-load-com)
;|
;;; Функция вычисления площади объекта "AcDbPolygonMesh"
;;; функция возвращает список площадей основной поверхности,
;;; поверхности замкнтых M столбцов,
;;; поверности замкнутых N строк
;;; и поверхности образованной точками краев полигона.
;;;
;;; Автор : Андрей Лазебный (Supermax)
;;; Параметры:
;;; obj1 - указатель на объект типа ename
;;;
;;; Примеры вызова:
;;;
;;; (apply '+ (polimesh-area (car (entsel))))
;;; получаем сумму всех поверхностей
;;;
;;; (car (polimesh-area (car (entsel))))
;;; получаем площадь основной поверхности
;;;
;;;
;;; Проверку на соответствие типу объекта намеренно не вставлял, так как планирую использовать при обработке наборов
;;; созданных с такой фильтрацией.
;;;
|;

(defun polimesh-area (obj1 / listpoint pl listpoint2 m n facemesh startbit listpoint3 listpoint4 listpoint5 listpoint6 rez1 rez2 rez3 rez4)

;=========================================================================
;Загружаем служебную функцию вычисления площади 3Dface по четырем точкам

(defun 3Dface-area-2 ( listpoint / l p r s rez1 p1 p2 p3 p4)

;|
Функция сделана на основе функции Елпанова Евгения
http://elpanov.com/index.php?id=36
3-я версия

Пример использования:
(3Dface-area-2 (list point1 point2 point4 point3))
point1-4 списки из координат точек
|;
(setq p1 (nth 0 listpoint))
(setq p2 (nth 1 listpoint))
(setq p3 (nth 3 listpoint))
(setq p4 (nth 2 listpoint))


(setq l (cons 0 (mapcar (function distance)
(list p1 p2 p4)
(list p2 p4 p1)
))
p (/ (apply (function +) l) 2.)
) ;_ setq

(setq r (cons 0 (mapcar (function distance)
(list p2 p3 p4)
(list p3 p4 p2)
))
s (/ (apply (function +) r) 2.)
) ;_ setq

(setq rez1 (+
(sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p)))))
(sqrt (abs (apply (function *) (mapcar (function -) r (list s s s s)))))
))

) ;_ defun

;===========================================================
;Вычисляем площадь основной поверхности

(setq obj (vlax-ename->vla-object obj1))

(setq listpoint (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates obj))))
;делим список на подсписки по 3 элемента в каждом
(setq pl (/ (length listpoint) 3))
(setq listpoint2 nil)
(repeat pl (setq listpoint2 (append listpoint2 (list (list (nth 0 listpoint) (nth 1 listpoint) (nth 2 listpoint))))) (setq listpoint (cdddr listpoint)))
;смотрим столбцы и строки
(setq m (vla-get-MVertexCount obj))
(setq n (vla-get-NVertexCount obj))
;количество поверхностей основной плоскости
(setq facemesh (* (- m 1) (- n 1)))
;получаем список плоскостей
(setq startbit 0)
(setq startstring 1)
(setq listpoint3 nil)
(repeat facemesh (setq listpoint3 (append listpoint3 (list (list
(nth startbit listpoint2)
(nth (+ 1 startbit) listpoint2)
(nth (+ n startbit) listpoint2)
(nth (+ n 1 startbit) listpoint2)))))
(if (< startstring (- n 1)) (progn (setq startbit (+ 1 startbit)) (setq startstring (+ 1 startstring)))
(progn (setq startstring 1) (setq startbit (+ 2 startbit))))

)

;получаем площадь
(setq rez1 (apply '+ (mapcar (function (lambda (x) (3dface-area-2 x))) listpoint3)))

;-------------------------------------------------------------------------------------
;Вычисляем площадь поверхностей, образованных замыканием M столбцов

(if (= (vla-get-MClose obj) :vlax-true)
(progn
(setq startbit (- (* n m) n))
(setq listpoint3 nil)
(repeat n (setq listpoint3 (append listpoint3 (list (nth startbit listpoint2)))) (setq startbit (+ 1 startbit)))

(setq startbit 0)
(setq listpoint4 nil)
(repeat n (setq listpoint4 (append listpoint4 (list (nth startbit listpoint2)))) (setq startbit (+ 1 startbit)))

(setq listpoint5 (append listpoint3 listpoint4))
(setq startbit 0)
(setq listpoint3 nil)
(setq startstring 1)
(setq facemesh (- m 1))
(repeat facemesh (setq listpoint3 (append listpoint3 (list (list
(nth startbit listpoint5)
(nth (+ 1 startbit) listpoint5)
(nth (+ n startbit) listpoint5)
(nth (+ n 1 startbit) listpoint5)))))
(if (< startstring (- n 1)) (progn (setq startbit (+ 1 startbit)) (setq startstring (+ 1 startstring)))
(progn (setq startstring 1) (setq startbit (+ 2 startbit))))
)

(setq rez2 (apply '+ (mapcar (function (lambda (x) (3dface-area-2 x))) listpoint3)))
))
(if (null rez2) (setq rez2 0))

;---------------------------------------------------------------------------------------------
;Вычисляем площадь поверхности образованной замыканием N строк

(if (= (vla-get-NClose obj) :vlax-true)
(progn

(setq startbit (- n 1))
(setq listpoint6 nil)
(repeat (- n 1) (setq listpoint6 (append listpoint6 (list (list
(nth startbit listpoint2)
(nth (- startbit (- n 1)) listpoint2)
(nth (+ n startbit) listpoint2)
(nth (+ 1 startbit) listpoint2)))))
(setq startbit (+ n startbit))
)
(setq rez3 (apply '+ (mapcar (function (lambda (x) (3dface-area-2 x))) listpoint6)))

))
(if (null rez3) (setq rez3 0))

;------------------------------------------------------------------------------------------------
;Вычисляем площадь поверхности, образованной краями полигона

(if (and (= (vla-get-NClose obj) :vlax-true) (= (vla-get-MClose obj) :vlax-true))
(progn
(setq listpoint7 (list
(nth (- (* n m) 1) listpoint2)
(nth (- (* n m) n) listpoint2)
(nth (- n 1) listpoint2)
(nth 0 listpoint2)
))

(setq rez4 (3dface-area-2 listpoint7))
))
(if (null rez4) (setq rez4 0))

;---------------------------------------------------------------------------------------------------
;Распечатываем результат

(princ (list rez1 rez2 rez3 rez4))
);end defun polimesh-area

[VVA]

Сообщение от Supermax или самому напрячься?

Если захочешь второе, вот тебе 3 готовые ф-ции подсчета площади треугольника

[Александр Ривилис]

Сообщение от Supermax Посмотрел сам объект и заметил, что 2 и 4 точки (а их всего четыре) всегда составляют грань изогнутого 3Dface.

Почему именно 2 и 4, а не 1 и 3? Это как на него смотреть. И соответственно разбить 3DFACE можно на два плоских треугольника по-разному, и площади (в общем случае) тоже будут разные.

[Supermax]

Не, не, не! Именно 2 и 4. Почему? - А фиг его знает!
Берем 3Dface, изгибаем и включаем раскраску. Крутим и видим грань на 2-ой и 4-ой точках.
Я ставлю 4 точки в разных z-ах и по ним строю 3Dface, и он, зараза, сам разворачивается и 2 и 4 точки образуют острую грань.

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

[Александр Ривилис]

Сообщение от Supermax Берем 3Dface, изгибаем и включаем раскраску. Крутим и видим грань на 2-ой и 4-ой точках.

Не смеши меня. Какое имеет отношение визуализация к реальному положению дел? А может в этой ситуации нужно считать, что перелома вообще нет, а есть изогнутость?

[Disney]

Александр Ривилис, смех смехом, но мне вот тоже стало интересно, и я строил по четырём точкам в разной последовательности 3DГРАНи, и всегда излом проходил через 2 и 4 вершины.

[Supermax]

А вот и результат:

Код:

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

(defun 3Dfase-area (obj / l p r s)
;|
Функция сделана на основе функции Елпанова Евгения
http://elpanov.com/index.php?id=36
3-я версия

Проверку на соответствие типу объекта намеренно не вставлял, так как планирую использовать при обработке наборов
созданных с такой фильтрацией.

Пример использования:
(3Dfase-area (car (entsel)))

|;
(setq l (cons 0 (mapcar (function distance) 
                           (list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj))) (cdr (assoc 13 (entget obj))))
                           (list (cdr (assoc 11 (entget obj))) (cdr (assoc 13 (entget obj))) (cdr (assoc 10 (entget obj))))
           ))
       p (/ (apply (function +) l) 2.)
 ) ;_  setq

(setq r (cons 0 (mapcar (function distance) 
                           (list (cdr (assoc 11 (entget obj))) (cdr (assoc 12 (entget obj))) (cdr (assoc 13 (entget obj))))
                           (list (cdr (assoc 12 (entget obj))) (cdr (assoc 13 (entget obj))) (cdr (assoc 11 (entget obj))))
           ))
       s (/ (apply (function +) r) 2.)
 ) ;_  setq

(+
(sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p)))))
(sqrt (abs (apply (function *) (mapcar (function -) r (list s s s s)))))
)
) ;_  defun

VVA, спасибо за ссылку!

[Елпанов Евгений]

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

[Supermax]

Не согласен.
Есть 4 точки и они определены как 3Dface. Это конечный продукт. Он распадается только на два треугольника. Точнее треугольники конечный продукт, а 3Dface перед ним.
НО!
Конвертация 3Dface в Mesh производится приблизительно так, как ты говоришь.
Если взорвать Mesh (предварительно установив сглаживание в 1-4 позиции), а потом все полученное опять превратить в кучу маленьких Mesh, а потом опять взорвать и т.д. мы шаг за шагом будем улучшать форму поверхности.
Но кончная стадия - треугольники, а перед ними 3Dface.

Вот раз есть 3Dface, так надо его как два треугольника считать, а не конвертировать, взрывать, опять конвертировать... так когда же считать?


Площадь круга тоже не совсем круга.


Я был прав!
Оказывается площадь Mesh меряется командой _.area и я померил ею, а потом разбил Mesh на 3Dface-ы и своей функцией замерил, предварительно установив 6 знаков точности. Все совпало до 6 знака!

А... собственно говоря, почему _.area меряет площадь Mesh, а GeomProps нет?

[Елпанов Евгений]

Сообщение от Supermax Я был прав! Оказывается площадь Mesh меряется командой _.area и я померил ею, а потом разбил Mesh на 3Dface-ы и своей функцией замерил, предварительно установив 6 знаков точности. Все совпало до 6 знака!

Ты действительно проверял на 3Dface не лежащем в одной плоскости и имеющим большой излом?

[Supermax]

Сначала я нарисовал большой 3Dface и потянул за один конец по Z. Покрутил, покрутил и конвертнул в Mesh. Потом много всякого было, а потом я его взорвал. Этот Mesh развалился на 4 меньших 3Dface. Все они изогнутые. Специально сейчас померял в фас на 5 и в профиль на 8 градусов. Это малова-то но я сйчас специальный файлец сюда выложу.
Ждите.

Вот, задрал угол до небес и конвертнул в Mesh (почти стих).
Там все площади проставлены.

Сделал функцию, которая считает два треугольника (1-2-4)+(2-3-4), затем два противоположных (1-2-3)+(3-4-1) и сумму обеих площадей делит пополам. Погрешность вместо того, чтобы уменьшиться - увеличилась и сразу на много.


Даю файл, правильный!

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

Считаю доказанным, что команда _area именно так и меряет Mesh!

[Елпанов Евгений]

у меня получились другие данные...

[Supermax]

Неправильно конвертирован 3Dface в surface. Излом в 3Dface по 2 и 4 точкам, а в surface по 1 и 3 точке 3Dface-а.
Если обвести твой surface 3Dface-ом, проконтролировав, что излом будет тамже, то площади будут равны.

[Елпанов Евгений]

Сообщение от Supermax Если обвести твой surface 3Dface-ом, проконтролировав, что излом будет тамже, то площади будут равны.

обвел - проверяй!

[Supermax]

Ты бы хоть раскраску включил и посмотрел, что ты обвел. Пишу ведь, Проконтролировать!. Опять у тебя грань не там образовалась!
Измени порядок действий при обведении!

Вот твой файл и внизу правильно обведенный 3Dface.

[Елпанов Евгений]

Действительно, если поменять порядок вершин, то твоя версия правильно считает площадь сплющенного 3dface...

ps. на мой вкус, это не самая верная площадь - правильнее, использовать сглаженную поверхность.

[Supermax]

Не, не, не! Секундочку!
Есть объект Mesh. У него в окне свойств, в закладке Geometry есть такое свойство Smoothness (Гладкость). Там 5 позиций от "нет" до "4".

А теперь, внимание!

В зависимости что выбрано в этом свойстве одна грань Mesh разбивается либо на один 3Dface, либо 4, 16, 64, 256.

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

Что это означает? - Это означает, что площадь меряется не по гипотетическим, математическим представлениям о том как это в идеале должно быть, а по факту существующей апроксимации. Какая апроксимация - такая и площадь поверхности.

Чтобы окончательно "поставить точки над и" я сделал кусок тора типа Mesh и размножил до двух экземляров.
Первому сделал свойство Smoothness "нет" замерял через _.area площадь, скопировал рядом, взорвал и замерял своей функцией (с небольшой надстройкой) общую площадь полученных 3Dface.

Второму экземпляру сделал свойство Smoothness "4" и далее сделал тоже, что и в первом случае.

Вот надстройка для функции, чтобы можно было создать набор и все там перемерять.

Код:

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

(setq nab1 (ssget))
(setq listnab nil)
(if nab1 (repeat  (sslength nab1) (progn (setq listnab 
     (append  listnab (list (setq primnab (ssname nab1 
         (- (sslength nab1) 1)))))) (ssdel primnab nab1))))

(apply '+ (mapcar '3Dfase-area listnab))

А вот что получилось:

;==============================================
29.10.10

Пример с торами не удачный. Там все 3Dface плоские. Даю другой прмер. Там почти все 3Dface изломаны и абсолютное совпадение площади прототипа (Mesh) и общей площади полученной поверхности из 3Dface.

[Александр Ривилис]

Добавил обработку AcDbBody, AcDbSubDMesh, AcDbPolygonMesh, AcDbPolyFaceMesh и подсчет площади AcDbFace по "методу Supermax"
Версии под AutoCAD 2008,2009,2010...? во вложении. На сайт пока выкладывать не буду - тестируйте.

[Supermax]

Протестировано. Мин нет.
Гип, гип, Ура!

[Александр Ривилис]

Выложил версию на сайте. Добавил возможность динамического включения/выключения расчета геометрических свойств (команды GeomPropsStart и GeomPropsStop), т.к. далеко не всегда есть необходимость получать эти свойства по всем выбранным объектам, а их вычисление тормозит и достаточно существенно работу в AutoCAD.

[VVA]

Александр Ривилис, Александр, спасибо. В качестве пожеланий добавить в архив readme про оманды GeomPropsStart и GeomPropsStop.
И еще один вопрос по функционированию. До сих пор, когда собирался выбирать большой объем данных, я закрывал окно свойств. Так вот вопрос: работает ли Geomprops, если окно свойств закрыто?

[Александр Ривилис]

Сообщение от VVA Так вот вопрос: работает ли Geomprops, если окно свойств закрыто?

Нет. AutoCAD не обращается к GeomProps если окно свойств закрыто. Но команды включения/выключения GeomProps я сделал по той причине, что иногда нужно при открытой панели свойств выбрать много примитивов (например, если нужно убедится, что выбранные примитивы на одном слое).
Но вызывать функции, которые из позволяют получить площадь/периметр/объем примитивов из LISP/VBA можно и при закрытом окне свойств.