Тема: Объём земляных работ

Здравствуйте!
Помогите пожалуйста!
Нужна программулина для подсчета объема земляных работ
Есть:
Треугольник, прямоугольник или пятиугольник, в каждом углу которого стоят две отметки (145.340 147.560), одна до выемки, другая после выемки грунта.
Нужно:
1. Кликаем на две отметки, получаем их разницу , которая висит на курсоре и ждет указание места куда ее поудобнее вставить рядом с этими двумя отметка (тем же шрифтом, тем же размером, но в скобках и синим цветом).
2. Кликаем на получившиеся разницы в скобках, и на фигуру к которой эти разницы относятся, вычисляется среднее значение из цифр в скобках и умножается на площадь фигуры, получаем объем в м3, который снова висит на курсоре и ждёт указания своего места (тем же шрифтом, тем же размером, но полужирным и синим цветом).
Пытался что-то сделать сам по учебнику Николая Полещук и Петра Лоскутова. До сотой страницы вроде было всё понятно, а вот чем дальше, тем меньше понимаю.
Буду очень благодарин.

Re: Объём земляных работ

Вот для вычисления разницы накатал без всяких проверок и тд.:

(DEFUN c:raz  (/ TEXT TEXT_1 TEXT_2)
  (IF
    (AND
      (SETQ text_1 (ENTSEL "\nПроектная отметка: "))
      (SETQ text_2 (ENTSEL "\nОтметка земли: "))
      (SETQ text_1 (CDR (ASSOC 1 (ENTGET (SETQ text (CAR text_1))))))
      (SETQ text_2 (CDR (ASSOC 1 (ENTGET (CAR text_2)))))
      (SETQ text_1 (ATOF text_1))
      (SETQ text_2 (ATOF text_2))
      )
     (PROGN
       (VL-CMDF "_.copy" text "" "_none" '(0 0 0) "_none" '(0 0 0))
       (SETQ text (ENTGET (ENTLAST)))
       (ENTMOD
     (SUBST    (CONS 1 (STRCAT "(" (RTOS (- text_1 text_2) 2 2) ")"))
        (ASSOC 1 text)
        text))
       (VL-CMDF "_.change" "_l" "" "_p" "_co" 5 "")
       (VL-CMDF    "_.move"
        "_l"
        ""
        "_none"
        (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        pause)
       )
     )
  )

тестим и если что пишем. Продолжение следует, чуть попозжее.

Re: Объём земляных работ

> Геодезист
Занимаясь подсчетом земляных работ нужно всё таки приличную программу иметь. Civil Геоникс или что либо подобное.
Лисп хорошее дело но нужны и чертежи под это.

Re: Объём земляных работ

Во родил и для подсчета объема:

(DEFUN c:ob  (/ I NABOR NN PLO SUMA TEXT)
  (IF
    (AND
      (SETQ nabor (SSGET '((0 . "*text") (1 . "(*)") (62 . 5))))
      (SETQ plo (ENTSEL "\nУчасток: "))
      (SETQ plo (CAR plo))
      (SETQ plo (VLA-GET-AREA (VLAX-ENAME->VLA-OBJECT plo)))
      )
     (PROGN
       (SETQ nn      (SSLENGTH nabor)
         i      -1
         suma 0.0)
       (REPEAT nn
     (SETQ suma
        (+
          suma
          (ATOF
            (VL-STRING-TRIM
              "()"
              (CDR
            (ASSOC
              1
              (ENTGET (SSNAME nabor (SETQ i (1+ i))))))))))
     )
       (SETQ suma (* (/ suma nn) plo))
       (VL-CMDF    "_.copy"
        (SSNAME nabor 0)
        ""
        "_none"
        '(0 0 0)
        "_none"
        '(0 0 0))
       (SETQ text (ENTGET (ENTLAST)))
       (ENTMOD
     (SUBST    (CONS 1 (STRCAT (RTOS suma 2 2) " м\\U+00B3"))
        (ASSOC 1 text)
        text))
       (VL-CMDF "_.change" "_l" "" "_p" "_co" 5 "")
       (VL-CMDF    "_.move"
        "_l"
        ""
        "_none"
        (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        )
       )
     )
  )

Конечно нужно специализированую программу но селяви. Я и сам сижу в голом акаде, хоть лисп чуть-чуть помогает в трудовых буднях.

Re: Объём земляных работ

З.Ы. Сделать последний текст жирным я не забыл!!! Я просто не знаю как)))
Фигура - я так понимаю замкнутая полилиния или регион (может быть и штриховка но лучше не надо).

Re: Объём земляных работ

To Valery Brelovsky
Наверное, ты прав, но я просто геодезист, и работаю больше в поле, а AutoCAD использую лишь для оформления исполнительных схем, тем более что универсальных программ не бывает, в чём то помогает Land Desktop. Конечно, существуют госты, но, как правило, заказчик часто предъявляет свои требования к оформлению.
To mr_Runa
Огромное спасибо!

Re: Объём земляных работ

To mr_Runa
Как убрать (м3) в значении объёма, и поменять цвет на красный, я догадался, а вот как сделать, чтобы в разници отметок и объёме всегда после запятой было два значения, пускай и нули, я не знаю.
Может подскажете, если не сложно?

Re: Объём земляных работ

Каюсь! Не могу никак вспомнить системную переменую, которая за это отвечает. Нужно в текущем размерном стиле убрать галочку на подавление хвостовых нулей. Автокад у меня русский поэтому: Размеры-> Размерные стили...-> Изменить...-> Основные единицы и там внизу убрать самую нижнюю слева галочку

Re: Объём земляных работ

опять забыл добавить очень важное замечание: отметки должны быть через точку (102.73 а не 102,73) иначе будет в расчет братся только целая часть (102.00).

Re: Объём земляных работ

Чуток подправил, теперь всегда будет с нулями:

(DEFUN c:raz  (/ TEXT TEXT_1 TEXT_2 OLD_DIM)
;|
вычисляет разницу между проектными и существующими отметками
|;
  (setq OLD_DIM (getvar "dimzin"))
  (IF
    (AND
      (SETQ text_1 (ENTSEL "\nПроектная отметка: "))
      (SETQ text_2 (ENTSEL "\nОтметка земли: "))
      (SETQ text_1 (CDR (ASSOC 1 (ENTGET (SETQ text (CAR text_1))))))
      (SETQ text_2 (CDR (ASSOC 1 (ENTGET (CAR text_2)))))
      (SETQ text_1 (ATOF text_1))
      (SETQ text_2 (ATOF text_2))
      )
     (PROGN
       (VL-CMDF "_.copy" text "" "_none" '(0 0 0) "_none" '(0 0 0))
       (SETQ text (ENTGET (ENTLAST)))
       (setvar "dimzin" 4)
       (ENTMOD
     (SUBST    (CONS 1 (STRCAT "(" (RTOS (- text_1 text_2) 2 2) ")"))
        (ASSOC 1 text)
        text))
       (setvar "dimzin" OLD_DIM)
       (VL-CMDF "_.change" "_l" "" "_p" "_co" 5 "")
       (VL-CMDF    "_.move"
        "_l"
        ""
        "_none"
        (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        )
       )
     )
  )
(DEFUN c:ob  (/ I NABOR NN PLO SUMA TEXT OLD_DIM)
;|
вычисляет объем срезки\насыпи по разнице отметок и площаде фигуры
|;
  (setq OLD_DIM (getvar "dimzin"))
  (IF
    (AND
      (SETQ nabor (SSGET '((0 . "*text") (1 . "(*)") (62 . 5))))
      (SETQ plo (ENTSEL "\nУчасток: "))
      (SETQ plo (CAR plo))
      (SETQ plo (VLA-GET-AREA (VLAX-ENAME->VLA-OBJECT plo)))
      )
     (PROGN
       (SETQ nn      (SSLENGTH nabor)
         i      -1
         suma 0.0)
       (REPEAT nn
     (SETQ suma
        (+
          suma
          (ATOF
            (VL-STRING-TRIM
              "()"
              (CDR
            (ASSOC
              1
              (ENTGET (SSNAME nabor (SETQ i (1+ i))))))))))
     )
       (SETQ suma (* (/ suma nn) plo))
       (VL-CMDF    "_.copy"
        (SSNAME nabor 0)
        ""
        "_none"
        '(0 0 0)
        "_none"
        '(0 0 0))
       (SETQ text (ENTGET (ENTLAST)))
       (setvar "dimzin" 4)
       (ENTMOD
     (SUBST    (CONS 1 (RTOS suma 2 2))
        (ASSOC 1 text)
        text))
       (setvar "dimzin" OLD_DIM)
       (VL-CMDF "_.change" "_l" "" "_p" "_co" 1 "")
       (VL-CMDF    "_.move"
        "_l"
        ""
        "_none"
        (CDR (ASSOC 10 (ENTGET (ENTLAST))))
        )
       )
     )
  )

Re: Объём земляных работ

Спасибо,
Всё чётко работает. Хочу сам попробовать заменить move на cutclip и pasteclip, думаю так будет немного красивее.

Re: Объём земляных работ

Да не за что, сам себе взял на заметку может пригодится.
Насчет cutclip и pasteclip хорошая идея)

Re: Объём земляных работ

Давно искал такую програмку!
mr_Runa - супер.
А то раньше засыпал за картограммой.

Re: Объём земляных работ

mr_Runa
а можно подкректировать её, немного.
чтобы вовод данных был
- разница показывалась в формате Х.ХХ(со знаком любым т.е. +654.654 или -6545.54)
- а обьем выводился(результат)
S=ХХХ.ХХ - площадь выбранного контура
V=ХХХ.ХХ

Re: Объём земляных работ

я там погоричился +654.65 - 2-ва знака после запятой

Re: Объём земляных работ

Насчет cutclip/pasteclip + парочку проверок для надежности

(defun c:raz  (/ text text_1 text_2 old_dim etext)
;|
вычисляет разницу между проектными и существующими отметками
|;
(defun *error*(msg)(princ msg)(setvar "dimzin" old_dim)(princ))
(setq old_dim (getvar "dimzin"))
(setvar "dimzin" 4)
(and
 (setq text_1 (car(entsel "\nПроектная отметка: ")))
 (wcmatch (cdr(assoc 0 (entget text_1))) "*TEXT")
 (setq text_2 (car(entsel "\nОтметка земли: ")))
 (wcmatch (cdr(assoc 0 (entget text_2))) "*TEXT")
 (setq text_1 (cdr (assoc 1 (entget (setq text text_1)))))
 (setq text_2 (cdr (assoc 1 (entget text_2))))
 (setq text_1 (atof text_1))
 (setq text_2 (atof text_2))
 (setq etext (entget text))
 (setq etext (entmakex (subst  (cons 1 (strcat "("
                           (rtos (- text_1 text_2) 2 2) ;_здесь происходит округление
                           ")"))
                   (assoc 1 etext)
                   etext)
           )
        )
      (princ "\nТочка вставки разности отметок: ")
      (vl-cmdf "_.copybase" (trans (cdr (assoc 10 (entget etext))) 0 1) etext "" "_.erase" etext "" "_.pasteclip" "_none" pause)
      )
  (setvar "dimzin" old_dim)
  )

Re: Объём земляных работ

Хотя блокировка слоя не проверяется

Re: Объём земляных работ

*error* надобы локальным сделать

(defun c:raz  (/ text text_1 text_2 old_dim etext *error*)
;|
вычисляет разницу между проектными и существующими отметками
|;
(defun *error*(msg)(princ msg)(setvar "dimzin" old_dim)(princ))
(setq old_dim (getvar "dimzin"))
(setvar "dimzin" 4)
(and
 (setq text_1 (car(entsel "\nПроектная отметка: ")))
 (wcmatch (cdr(assoc 0 (entget text_1))) "*TEXT")
 (setq text_2 (car(entsel "\nОтметка земли: ")))
 (wcmatch (cdr(assoc 0 (entget text_2))) "*TEXT")
 (setq text_1 (cdr (assoc 1 (entget (setq text text_1)))))
 (setq text_2 (cdr (assoc 1 (entget text_2))))
 (setq text_1 (atof text_1))
 (setq text_2 (atof text_2))
 (setq etext (entget text))
 (setq etext (entmakex (subst  (cons 1 (strcat "("
                           (rtos (- text_1 text_2) 2 2) ;_здесь происходит округление
                           ")"))
                   (assoc 1 etext)
                   etext)
           )
        )
      (princ "\nТочка втавки разности отметок: ")
      (vl-cmdf "_.copybase" (trans (cdr (assoc 10 (entget etext))) 0 1) etext "" "_.erase" etext "" "_.pasteclip" "_none" pause)
      )
  (setvar "dimzin" old_dim)
  )

Re: Объём земляных работ

Re: maksimys к сожалению у меня нет сейчас времени совсем, может VVA поможет?

Re: Объём земляных работ

С + и -

(defun c:raz1  (/ text text_1 text_2 old_dim etext *error* delta)
;|
вычисляет разницу между проектными и существующими отметками
|;
(defun *error*(msg)(princ msg)(setvar "dimzin" old_dim)(princ))
(setq old_dim (getvar "dimzin"))
(setvar "dimzin" 0)
(and
 (setq text_1 (car(entsel "\nПроектная отметка: ")))
 (wcmatch (cdr(assoc 0 (entget text_1))) "*TEXT")
 (setq text_2 (car(entsel "\nОтметка земли: ")))
 (wcmatch (cdr(assoc 0 (entget text_2))) "*TEXT")
 (setq text_1 (cdr (assoc 1 (entget (setq text text_1)))))
 (setq text_2 (cdr (assoc 1 (entget text_2))))
 (setq text_1 (atof text_1))
 (setq text_2 (atof text_2))
 (setq delta (- text_1 text_2))
 (setq etext (entget text))
 (setq etext (entmakex (subst  (cons 1 (strcat
                           (if (> delta 0) "(+" "(")
                           (rtos delta  2 2) ;_здесь происходит округление
                           ")"))
                   (assoc 1 etext)
                   etext)
           )
        )
      (princ "\nТочка втавки разности отметок: ")
      (vl-cmdf "_.copybase" (trans (cdr (assoc 10 (entget etext))) 0 1) etext "" "_.erase" etext "" "_.pasteclip" "_none" pause)
      )
  (setvar "dimzin" old_dim)
  )

Re: Объём земляных работ

To VVA
А, нельзя ли, сделать так, чтобы подсчитывая 547 разниц, не преходилось каждый раз нажимать Enter, для возобновления функции raz, а наоборот нажимать Enter после 547-ой разницы для выхода из цикла и завершения функции?

Re: Объём земляных работ

Разность в цикле с контролем промахнулся/нет и текст/ не текст

(defun c:razM  (/ text text_1 text_2 old_dim etext *error* delta Flag)
;|
вычисляет разницу между проектными и существующими отметками
|;
(defun *error*(msg)(princ msg)(setvar "dimzin" old_dim)(princ))
(setq old_dim (getvar "dimzin"))
(setvar "dimzin" 0)
(while
    (and
      (setvar "ERRNO" 0)
      (setq Flag t)
      (while Flag
        (cond ((and (setq text_1 (car(entsel "\nПроектная отметка <выход>: ")))
                    (wcmatch (cdr(assoc 0 (entget text_1))) "*TEXT")
                   )
               (setq Flag nil text_1 text_1)
               )
              ((= (getvar "ERRNO") 52)(setq Flag nil text_1 nil))
              (t (princ "\nМимо или не текст"))
              )
       )
      text_1
      (setq Flag t)
      (while Flag
        (cond ((and (setq text_2 (car(entsel "\nОтметка земли:  <выход>: ")))
                    (wcmatch (cdr(assoc 0 (entget text_2))) "*TEXT")
                   )
               (setq Flag nil text_2 text_2)
               )
              ((= (getvar "ERRNO") 52)(setq Flag nil text_2 nil))
              (t (princ "\nМимо или не текст"))
              )
       )
      text_2
 (setq text_1 (cdr (assoc 1 (entget (setq text text_1)))))
 (setq text_2 (cdr (assoc 1 (entget text_2))))
 (setq text_1 (atof text_1))
 (setq text_2 (atof text_2))
 (setq delta (- text_1 text_2))
 (setq etext (entget text))
 (setq etext (entmakex (subst  (cons 1 (strcat
                           (if (> delta 0) "(+" "(")
                           (rtos delta  2 2) ;_здесь происходит округление
                           ")"))
                   (assoc 1 etext)
                   etext)
           )
        )
      (princ "\nТочка втавки разности отметок: ")
      (vl-cmdf "_.copybase" (trans (cdr (assoc 10 (entget etext))) 0 1) etext "" "_.erase" etext "" "_.pasteclip" "_none" pause)
      )
  )
  (setvar "dimzin" old_dim)(princ)
  )

Re: Объём земляных работ

To VVA
Спасибо большое.
1. Всётаки цвет я хотел синий
2. Знак + и - мне как раз не нужны
3. Ну и вдруг кому-то нужны 3 или 4 значения после запятой.

(defun c:razM  (/ text text_1 text_2 old_dim etext *error* delta Flag znac)
;|
вычисляет разницу между проектными и существующими отметками
|;
(defun *error*(msg)(princ msg)(setvar "dimzin" old_dim)(princ))
(setq old_dim (getvar "dimzin"))
(setvar "dimzin" 0)
(setq znac(getint   "\n Число знаков после запятой"   ))
(while
    (and
      (setvar "ERRNO" 0)
      (setq Flag t)
      (while Flag
        (cond ((and (setq text_1 (car(entsel "\nПроектная отметка <выход>: ")))
                    (wcmatch (cdr(assoc 0 (entget text_1))) "*TEXT")
                   )
               (setq Flag nil text_1 text_1)
               )
              ((= (getvar "ERRNO") 52)(setq Flag nil text_1 nil))
              (t (princ "\nМимо или не текст"))
              )
       )
      text_1
      (setq Flag t)
      (while Flag
        (cond ((and (setq text_2 (car(entsel "\nОтметка земли:  <выход>:")))
                    (wcmatch (cdr(assoc 0 (entget text_2))) "*TEXT")
                   )
               (setq Flag nil text_2 text_2)
               )
              ((= (getvar "ERRNO") 52)(setq Flag nil text_2 nil))
              (t (princ "\nМимо или не текст"))
              )
       )
      text_2
 (setq text_1 (cdr (assoc 1 (entget (setq text text_1)))))
 (setq text_2 (cdr (assoc 1 (entget text_2))))
 (setq text_1 (atof text_1))
 (setq text_2 (atof text_2))
 (setq delta (if (> text_1 text_2) (- text_1 text_2) (- text_2 text_1)))
 (setq etext (entget text))
 (setq etext (entmakex (subst  (cons 1 (strcat "("
                           (rtos delta  2 znac)
                           ")"))
                   (assoc 1 etext)
                   etext)
           )
        )
      (princ "\nТочка втавки разности отметок: ")
      (VL-CMDF "_.change" "_l" "" "_p" "_co" 5 "")
      (vl-cmdf "_.copybase" (trans (cdr (assoc 10 (entget etext))) 0 1) etext "" "_.erase" etext "" "_.pasteclip" "_none" pause)
      )
  )
  (setvar "dimzin" old_dim)(princ)
  )

Ещё раз всем спасибо!

Re: Объём земляных работ

Чтобы считать разницу отметок, нужны отметки: по тахеометрической съёмке в Land Desktop рисуем горизонтали с шагом по высоте 1 см и используя программу подписываем отметки в нужном месте

(DEFUN C:otm (/ t1 t2 sl p1 p2 osm cla dmz)
  (defun *error* (msg)
    (princ msg)
    (setvar "OSMODE" osm)
    (setvar "CLAYER" cla)
    (setvar "DIMZIN" dmz)
    (princ)
  )
  (setq dmz (getvar "dimzin"))
  (setq osm (getvar "OSMODE"))
  (setq cla (getvar "CLAYER"))
  (setvar "dimzin" 0)
  (initget "Д П")
  (setq sl (getkword "\n Отметка (До,После) зем. работ? <Д>:"))
  (If (or (= sl "Д") (= sl "д") (= sl nil))
    (setq sl "Отметка до зем работ")
    (setq sl "Отметка после зем работ")
  )
  (VL-CMDF "_-LAYER" "_M" sl "")
  (setq t1 (entsel "\nУкажите образец текста:"))
  (while
    (and
      (setvar "ERRNO" 0)
      (setq Flag t)
      (while Flag
    (cond
      ((and    (setq p1 (entsel "\n\nПолилиния с отметкой <выход>: "))
        (wcmatch (cdr (assoc 0 (entget (car p1)))) "LWPOLYLINE")
       )
       (setq Flag nil p1 p1)
      )
      ((= (getvar "ERRNO") 52) (setq Flag nil))
      (t (princ "\n\nМимо или не Полилиния"))
    )
      )
      p1
      (setq P2 (rtos (cdr (assoc 38 (entget (car P1)))) 2 2)
      )
      (VL-CMDF "_.copy"
           (car t1)
           ""
           "_none"
           (cadr t1)
           "_none"
           (cadr P1)
      )
      (SETQ t2 (ENTGET (entlast))
      )
      (setq t2 (SUBST (CONS 1 p2) (ASSOC 1 t2) t2)
        t2 (SUBST (CONS 8 sl) (ASSOC 8 t2) t2)
      )
      (entmod t2)
      (entupd (entlast))
      (VL-CMDF "_.cutclip" "_1" "_l" "")
      (setvar "osmode" 41)
      (VL-CMDF "_pasteclip" pause)
    )
  )
  (setvar "OSMODE" osm)
  (setvar "CLAYER" cla)
  (setvar "DIMZIN" dmz)
  (princ)
)

Весь мозг себе вылюбил, до 3 ночи работать не хотела.

Re: Объём земляных работ

Нашёл программу Евгения Елпанова
программа триангуляции облака точек
Она строит поверхность из треугольников примитивами 3dFace.
Так вот, чтоб автоматизировать подсчёт и оформления объёмов земляных работ, есть идеи по написанию программы которая сама будет строит сетку, и в каждом пересечении определять отметку.
:?: как можно найти координату пересечения полилинии с 3Dface-ом, т.е. предполагается из каждого пресечения сетки опускать нормаль на поверхность и находить отметку Z (Н) поверхности. :?: