Настройки поиска (Страница 1 из 54)

(setq ss (ssget )  ; указываем источник света
      en (ssname ss 0)
      el (entget el))

(DEFUN c:ob (/          I           NABOR    NN     PLO      spmr
         SUMA     TEXT     OLD_DIM    OLD_DIM     old_angb nnu
         pln      nnu1     seqend    att_name att_value
        )
        ;| 
вычисляет объем срезки\насыпи по разнице отметок и площаде фигуры 
|;
  (setq    OLD_DIM     (getvar "dimzin")
;;;    angbase - в данном чертеже он повернут на 270град, делаем 0
    old_angb (getvar "angbase")
  ) ;_ конец setq
  (setvar "angbase" 0)
;;;  рабочие обнуления
  (SETQ    nnu1 T
  ) ;_ конец SETQ

  (while nnu1
    (progn
    (prompt "\nУкажите номер участка ---> или ВВОД <Выход>")
    (setq nnu1 (nz_vybor1)        ;(ssget "_:S")
    ) ;_ конец setq
    )
    (if    nnu1 
;;;      -----------------  цикл выбора участков ------------------------------------------------------
      (progn
    (setq nnu (entget (ssname nnu1 0))
    ) ;_ конец setq


;;;  ===========; считывание указанных атрибутов OTM01 в список nabor ======================
    (prompt "\nУкажите блоки отметок ---> ")
    (setq nabor (ssget
              '((0 . "INSERT")
            (2 . "OTM01")
               )
            ) ;_ конец ssget
    ) ;_ конец setq ((sslength nabor)




    (if (and nabor nnu)
      (progn
        (setq i 0
          suma 0
        ) ;_ конец setq
        (while (setq el (ssname nabor i)) ; el -   примитив

          (setq att (entnext el))
          (setq seqend (cdr (assoc 0 (entget att))))
;;;      Цикл чтение АТРИБУТОВ
;;;                    ; пока есть атрибуты в блоке
          (while (not (eq seqend "SEQEND"))
;;;                    ; имя атрибута
        (setq att_name    (cdr (assoc 2 (entget att)))
              att_value    (cdr (assoc 1 (entget att))) ; значение
              att_value    (if att_value
                  att_value
                  " "
                ) ;_ if
        ) ;_ setq
        (If (= att_name "DELTA")
          (setq spmr (cons (atof att_value) spmr))
        ) ;_ конец If
        (setq att (entnext att)
              att_value    nil
        ) ;_ setq
        (setq seqend (cdr (assoc 0 (entget att))))
          )                ; end    while (not (eq seqend "SEQEND"))
          (setq i (1+ i)
          ) ;_ конец setq
        ) ;_ while

;;; Найдем среднее в nabor

        (setq i 0)
        (repeat (sslength nabor)
          (setq suma (+ suma (nth i spmr))
            i     (1+ i)
          ) ;_ конец setq
        ) ;_ конец repeat
;;; среднее значение отметки
        (setq suma (/ suma (sslength nabor)))

        (prompt "\nВыберите полилинию участка ---> ")
        (SETQ pln (entsel)
;;;        edata (entget (car pln))
          plo (* suma
             (VLA-GET-AREA (VLAX-ENAME->VLA-OBJECT (car pln)))
              ) ;_ конец *
        ) ;_ конец SETQ



        (command "_.TEXT"
             (polar (cdr (assoc 10 nnu))
                (/ pi -2)
                (* 1.2 (cdr (assoc 40 nnu)))
             ) ;_ конец polar
             (cdr (assoc 40 nnu))
             0
             (strcat "%%u" (rtos plo 2 1))
        ) ;_ конец command
      ) ;_ конец progn
    ) ;_ конец if (and nabor nnu)
      ) ;_ конец progn




;;;      -----------------  цикл выбора участков ------------------------------------------------------

      (progn
    (prompt "\nВы закончили работу")
      ) ;_ конец progn
    ) ;_ конец if - nnu

  )                    ; - while
  (setvar "dimzin" OLD_DIM)
  (setvar "angbase" old_angb)
  (princ)
) ;_ конец DEFUN
;;; -----------------    подпрограмма выбора TEXT примитива , если Esc - возврат nil --------------------------------
(defun nz_vybor1 (/ r)
  (vl-catch-all-apply
    '(lambda ()
       (setq r (ssget '((0 . "TEXT"))))
     ) ;_ end of lambda
  ) ;_ end of vl-catch-all-apply
  (setq    r (if r
        r
        nil
      ) ;_ конец if
  ) ;_ конец setq
) ;_ конец defun
;;; вызов