• sem
  • Восстановленный участник
  • На форуме с 29 июля 2003г.
  • Сообщений: 6
  • Спасибо: 0

Тема: Расчет площади 3d solid

Увыщаемые боги AutoCad и VBA, помогите пожалуйста расчитать площадь 3d solid. Проблемы в институте! Жду ответа! спасибо!

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Расчет площади 3d solid

> sem
Пробуй:

(defun c:3darea (/ en)
(setvar "CMDECHO" 0)
(setq en (car (entsel "\nВыбрать тело >> ")))
(command "_.AREA" "_O" en)
(setvar "CMDECHO" 1)
(alert (strcat (vl-princ-to-string (getvar "AREA")) " куб. единиц рисования"))
(princ)
)
;(c:3darea)

~'J'~

  • sem
  • Восстановленный участник
  • На форуме с 29 июля 2003г.
  • Сообщений: 6
  • Спасибо: 0

Re: Расчет площади 3d solid

Спасибо вам Гуру, ты настоящий бог AutoCad!!! А у вас есть тоже самое на VBA?

  • sem
  • Восстановленный участник
  • На форуме с 29 июля 2003г.
  • Сообщений: 6
  • Спасибо: 0

Re: Расчет площади 3d solid

Протестировал прогу...Работает с погрешностью...Нельзя ли поточнее???

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Расчет площади 3d solid

> sem
Насчет гуру-то я чтой-то шибко засомневавшись...
Погрешность самого АвтоКАДа увы
А на VBA будет тоже самое поскольку кроме как
использовать SendCommand "_AREA" и т.д. иного пути не вижу
Возможно с помощью ObjectARX/C++ можно получить
заветную точность
Пока мне сей плод не по зубам...
~'J'~

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Расчет площади 3d solid

> sem
Кстати, вместо:

(alert (strcat (vl-princ-to-string (getvar "AREA")) " куб. единиц рисования"))

попробуй:

(alert (strcat (rtos (getvar "AREA") 2 16) " куб. единиц рисования"))

Как там будет с точностью?
~'J'~

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Расчет площади 3d solid

> sem
Попробуй где точнее:

Sub Get3dSolidArea()
Dim oEnt As AcadEntity
Dim oSolid As Acad3DSolid
Dim varPt
Dim strHndl As String
Dim dblAr As Double
ThisDrawing.Utility.GetEntity oEnt, varPt, "Select solid"
If TypeOf oEnt Is Acad3DSolid Then
Set oSolid = oEnt
End If
strHndl = oSolid.Handle
ThisDrawing.SendCommand "_AREA" & vbCr & "_O" & vbCr & "(handent  " & vbCr & Chr(34) & strHndl & Chr(34) & ")" & vbCr
dblAr = CDbl(ThisDrawing.GetVariable("AREA"))
MsgBox "Area of solid is: " & ThisDrawing.Utility.RealToString(dblAr, acDecimal, 16)
End Sub

~'J'~