Copyright (c) 1998-2025 Александр Ривилис

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

ДАННОЕ ПРОГРАММНОЕ ОБЕСПЕЧЕНИЕ ПРЕДОСТАВЛЯЕТСЯ <КАК ЕСТЬ>, БЕЗ ЛЮБОГО ВИДА
ГАРАНТИЙ, ЯВНО ВЫРАЖЕННЫХ ИЛИ ПОДРАЗУМЕВАЕМЫХ, ВКЛЮЧАЯ, НО НЕ
ОГРАНИЧИВАЯСЬ ГАРАНТИЯМИ ТОВАРНОЙ ПРИГОДНОСТИ, СООТВЕТСТВИЯ ПО ЕГО
КОНКРЕТНОМУ НАЗНАЧЕНИЮ И НЕНАРУШЕНИЯ ПРАВ. НИ В КАКОМ СЛУЧАЕ АВТОРЫ ИЛИ
ПРАВООБЛАДАТЕЛИ НЕ НЕСУТ ОТВЕТСТВЕННОСТИ ПО ИСКАМ О ВОЗМЕЩЕНИИ УЩЕРБА,
УБЫТКОВ ИЛИ ДРУГИХ ТРЕБОВАНИЙ ПО ДЕЙСТВУЮЩИМ КОНТРАКТАМ, ДЕЛИКТАМ ИЛИ
ИНОМУ, ВОЗНИКШИМ ИЗ, ИМЕЮЩИМ ПРИЧИНОЙ ИЛИ СВЯЗАННЫМ С ПРОГРАММНЫМ
ОБЕСПЕЧЕНИЕМ ИЛИ ИСПОЛЬЗОВАНИЕМ ПРОГРАММНОГО ОБЕСПЕЧЕНИЯ ИЛИ ИНЫМИ
ДЕЙСТВИЯМИ С ПРОГРАММНЫМ ОБЕСПЕЧЕНИЕМ.
============================================================================


Площадь, длина и объем выбранных примитивов в панели
свойств. Добавляется новая группа свойств Геометрические
свойства с полями Площадь(сумма), Длина(сумма),
Объем(сумма) и группа Геометрические свойства (настройка)
Необходимо однократно загрузить arx-файл
(который можно взять здесь) при помощи команды _APPLOAD
(или _ARX)

GeomProps2006.arx     - для AutoCAD 2006
GeomProps2007.arx     - для AutoCAD 2007...2009 (только x86 - 32-битный)
GeomProps2009x32.arx  - для AutoCAD 2009 (только x86 - 32-битный)
GeomProps2009x64.arx  - для AutoCAD 2009 (только x64 - 64-битный)
GeomProps2010x32.arx  - для AutoCAD 2010...2012 (только x86 - 32-битный)
GeomProps2010x64.arx  - для AutoCAD 2010...2012 (только x64 - 64-битный)
GeomProps2013x32.arx  - для AutoCAD 2013...2014 (только x86 - 32-битный)
GeomProps2013x64.arx  - для AutoCAD 2013...2014 (только x64 - 64-битный)
GeomProps2015x32.arx  - для AutoCAD 2015...2016 (только x86 - 32-битный)
GeomProps2015x64.arx  - для AutoCAD 2015...2016 (только x64 - 64-битный)
GeomProps2017x32.arx  - для AutoCAD 2017        (только x86 - 32-битный)
GeomProps2017x64.arx  - для AutoCAD 2017        (только x64 - 64-битный)
GeomProps2018x32.arx  - для AutoCAD 2018        (только x86 - 32-битный)
GeomProps2018x64.arx  - для AutoCAD 2018        (только x64 - 64-битный)
GeomProps2019x32.arx  - для AutoCAD 2019        (только x86 - 32-битный)
GeomProps2019x64.arx  - для AutoCAD 2019...2020 (только x64 - 64-битный)
GeomProps2021x64.arx  - для AutoCAD 2021...2024 (только x64 - 64-битный)
GeomProps2025x64.arx  - для AutoCAD 2025...2026 (только x64 - 64-битный)
GeomProps2027x64.arx  - для AutoCAD 2027...     (только x64 - 64-битный)


Загружать в AutoCAD можно при помощи команд _APPLOAD или _ARX
Выгружать и повторно загружать НЕЛЬЗЯ! Это приведет к
аварийному завершению AutoCAD.
Если открыт Design Center (команда _adcenter) и загружен
GeomProps при выходе из AutoCAD возникает ошибка
(необрабатываемое исключение в AcObjClassImp.arx). При этом
нет потери данных в dwg-файлах, которые были открыты, т.к.
к этому моменту они уже сохранены. Аналогичная ошибка может
происходить при открытых палитрах инструментов.


Команда GeomPropsScale позволяет задать масштабный
коэффицент.


Вызов из AutoLISP:

(GeomPropsGetArea <имя примитива>) ;; Площадь примитива
(GeomPropsGetVolume <имя примитива>) ;; Объем примитива
(GeomPropsGetPerimiter <имя примитива>) ;; Периметр/длина примитива

Вызов из VBA:

' Для AutoCAD 2006
' Private Declare Function GeomPropsGetArea Lib "GeomProps2006.arx" (ByVal id As Long) As Double
' Private Declare Function GeomPropsGetVolume Lib "GeomProps2006.arx" (ByVal id As Long) As Double
' Private Declare Function GeomPropsGetPerimiter Lib "GeomProps2006.arx" (ByVal id As Long) As Double
' Для AutoCAD 2007 и выше
' Private Declare Function GeomPropsGetArea Lib "GeomProps2007.arx" (ByVal id As Long) As Double
' Private Declare Function GeomPropsGetVolume Lib "GeomProps2007.arx" (ByVal id As Long) As Double
' Private Declare Function GeomPropsGetPerimiter Lib "GeomProps2007.arx" (ByVal id As Long) As Double

Для AutoCAD 2019 и 2020:
Private Declare PtrSafe Function GeomPropsGetArea Lib "GeomProps2019x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetVolume Lib "GeomProps2019x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetPerimiter Lib "GeomProps2019x64.arx" (ByVal id As LongPtr) As Double
Для AutoCAD 2021:
Private Declare PtrSafe Function GeomPropsGetArea Lib "GeomProps2021x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetVolume Lib "GeomProps2021x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetPerimiter Lib "GeomProps2021x64.arx" (ByVal id As LongPtr) As Double
Для AutoCAD 2025-2026:
Private Declare PtrSafe Function GeomPropsGetArea Lib "GeomProps2025x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetVolume Lib "GeomProps2025x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetPerimiter Lib "GeomProps2025x64.arx" (ByVal id As LongPtr) As Double
Для AutoCAD 2027:
Private Declare PtrSafe Function GeomPropsGetArea Lib "GeomProps2027x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetVolume Lib "GeomProps2027x64.arx" (ByVal id As LongPtr) As Double
Private Declare PtrSafe Function GeomPropsGetPerimiter Lib "GeomProps2027x64.arx" (ByVal id As LongPtr) As Double


' Пример получения площади
Public Sub TestArea()
Dim o As AcadObject
Dim p As Variant
ThisDrawing.Utility.GetEntity o, p, "Выберите примитив: "
Dim id As LongPtr
id = o.ObjectID
Dim ar As Double
ar = GeomPropsGetArea(id)
MsgBox "Area=" + CStr(ar), , "GetArea Example"
End Sub


========================================================================
P.S.: Если Вам понравилась созданная мной программа и у Вас появилось
желание отблагодарить меня или же простимулировать написание новых
версий этой программы или же каких-то других программ,  то вы можете
перечислить некоторые средства в следующих платежных системах:

MasterCard: 5169-3600-2782-1770
Visa:       4731-1856-6165-3904
PayPal: Alexander.Rivilis@gmail.com

Это будет хорошим стимулом для продолжения моей работы.
========================================================================
e-mail: rivilis@ukr.net
Skype:  rivilis
GTalk:  Alexander.Rivilis@gmail.com
MSN:    rivilis@hotmail.com
тел.:   +380(50)332-21-26