Тема: Посчитать среднюю отметку по точкам?
Как посчитать в куче точек среднюю отметку высоты Z? :D Не используя сторонних приложений, наверняка такое должно быть? Я использую цивил 3D.
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Посчитать среднюю отметку по точкам?
Форумы CADUser → Autodesk → AutoCAD → Посчитать среднюю отметку по точкам?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Сообщения 4
- vdim
- Участник
Re: Посчитать среднюю отметку по точкам?
Я использую цивил 3D
[S]А чего же тогда в ветке AutoCad пишите?[/S]
Постройте поверхность по этим точкам.В Свойствах Поверхности увидите ее max,min и среднюю высоты.
(закладка Статистика).В закладке Анализ можете построить контур по желаемой высоте...
- Ivachenkov
- Участник
Re: Посчитать среднюю отметку по точкам?
Да че то тут посетителей просто больше ))), понятно спасибо!
- Boltrushko
- Участник
Re: Посчитать среднюю отметку по точкам?
Может попробуешь так???
;;================================>TXT-SUM<====================================
;; Команда вычисления суммы и суммы произведений групп чисел
;; TXTSUM.lsp Version 2.01
;; Автор: Протасов Георгий
;;Программа вычисляет сумму групп чисел, заданных в виде простого текста.
;;При выборе парных групп чисел с одинаковым количеством элементов вычисляется
;;сумма произведений /Удобно для подсчета спецификаций/. Группы чисел для
;;определения суммы произведений могут быть организованы вертикально и
;;горизонтально. Десятичный разделитель может быть запятой и точкой.
;;Результат копируется в буфер обмена.
;;============================================================================
(DEFUN TXT-SUM ( / l1 l2 sum1 sum0 msg TXTIPNT MAXY MAXX REMBER SORT STRREPL
GETNUMBERS CPCBD cmdecho-save error-save)
(SETQ error-save *error*
cmdecho-save (GETVAR "CMDECHO")
);SETQ
(DEFUN *error* (msg)
(IF error-save (SETQ *error* error-save))
(IF msg (PRINC "\nВыполнение функции прервано "))
;; Восстановление значений системных переменных
(SETVAR "CMDECHO" cmdecho-save)
(PRINC)
);DEFUN
;Функция копирования числа в буфер обмена
(DEFUN CPCBD (num / convn)
(IF (AND (SETQ convn (FINDFILE "G_StrToCbd.exe")) num)
(STARTAPP convn (RTOS num))
);
);DEFUN
;Функция поиска левой нижней точки текста
(DEFUN TXTIPNT (en / ed ins p p1 p2 wdth hght hght0 ang)
(SETQ ed (ENTGET en));Описание текста
(IF (AND
(AND (NOT (NULL (CDR (ASSOC 72 ed)))) (NOT (NULL (CDR (ASSOC 73 ed)))))
(OR (/= (CDR (ASSOC 72 ed)) 0) (/= (CDR (ASSOC 73 ed)) 0))
);AND
(SETQ ins (CDR (ASSOC 11 ed)))
(SETQ ins (CDR (ASSOC 10 ed)))
);IF
(SETQ ins (TRANS ins en 2) ;Точка вставки
p1 (CAR (TEXTBOX ed))
p2 (CADR (TEXTBOX ed))
wdth (- (CAR p2) (CAR p1)) ;Ширина
hght (- (CADR p2) (CADR p1)) ;Высота
hght0 (CADR p2);Высота
ang (IF (NULL (ASSOC 50 ed)) 0 (CDR (ASSOC 50 ed))) ;Угол наклона
);SETQ
(COND
((AND (= (CDR (ASSOC 72 ed)) 0) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p1 ins)
);Влево
((AND (= (CDR (ASSOC 72 ed)) 1) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p1 (POLAR ins (+ ang PI) (/ wdth 2)))
);По центру
((AND (= (CDR (ASSOC 72 ed)) 2) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p1 (POLAR ins (+ ang PI) wdth))
);Вправо
((AND (= (CDR (ASSOC 72 ed)) 3) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p1 (POLAR ins (+ ang PI) wdth))
);Вписанный
((AND (= (CDR (ASSOC 72 ed)) 4) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p (POLAR ins (- ang PI) (/ wdth 2))
p (POLAR p (+ ang (* PI 0.5)) (/ hght0 2))
p1 (POLAR p (- ang (* PI 0.5)) hght0)
);SETQ
);По середине
((AND (= (CDR (ASSOC 72 ed)) 5) (= (CDR (ASSOC 73 ed)) 0))
(SETQ p1 (POLAR ins (+ ang PI) wdth))
);По ширине
((AND (= (CDR (ASSOC 72 ed)) 0) (= (CDR (ASSOC 73 ed)) 1))
(SETQ p1 ins)
);Низ и Влево
((AND (= (CDR (ASSOC 72 ed)) 1) (= (CDR (ASSOC 73 ed)) 1))
(SETQ p1 (POLAR ins (+ ang PI) (/ wdth 2)))
);Низ и По центру
((AND (= (CDR (ASSOC 72 ed)) 2) (= (CDR (ASSOC 73 ed)) 1))
(SETQ p1 (POLAR ins (+ ang PI) wdth))
);Низ и Вправо
((AND (= (CDR (ASSOC 72 ed)) 0) (= (CDR (ASSOC 73 ed)) 2))
(SETQ p (POLAR ins (+ ang (* PI 0.5)) (/ hght 2))
p1 (POLAR p (- ang (* PI 0.5)) hght)
);SETQ
);Середина и Влево
((AND (= (CDR (ASSOC 72 ed)) 1) (= (CDR (ASSOC 73 ed)) 2))
(SETQ p (POLAR ins (- ang PI) (/ wdth 2))
p (POLAR p (+ ang (* PI 0.5)) (/ hght 2))
p1 (POLAR p (- ang (* PI 0.5)) hght)
);SETQ
);Середина и Центр
((AND (= (CDR (ASSOC 72 ed)) 2) (= (CDR (ASSOC 73 ed)) 2))
(SETQ p2 (POLAR ins (+ ang (* PI 0.5)) (/ hght 2))
p (POLAR p2 (+ ang PI) wdth)
p1 (POLAR p (- ang (* PI 0.5)) hght)
);SETQ
);Середина и Вправо
((AND (= (CDR (ASSOC 72 ed)) 0) (= (CDR (ASSOC 73 ed)) 3))
(SETQ p1 (POLAR ins (- ang (* PI 0.5)) hght))
);Верх и Влево
((AND (= (CDR (ASSOC 72 ed)) 1) (= (CDR (ASSOC 73 ed)) 3))
(SETQ p (POLAR ins (+ ang PI) (/ wdth 2))
p1 (POLAR p (- ang (* PI 0.5)) hght)
);SETQ
);Верх и По центру
((AND (= (CDR (ASSOC 72 ed)) 2) (= (CDR (ASSOC 73 ed)) 3))
(SETQ p (POLAR ins (+ ang PI) wdth)
p1 (POLAR p (- ang (* PI 0.5)) hght)
);SETQ
);Верх и Вправо
(t
(SETQ p1 ins)
);Влево по умолчанию
);COND
);DEFUN
;;;Поиск самого верхнего элемента списка
(DEFUN MAXY (l / m i)
(SETQ i 1
m (CAR l));
(WHILE (<= i (1- (LENGTH l)))
(IF (<= (CADR (TXTIPNT m)) (CADR (TXTIPNT (NTH i l))))
(SETQ m (NTH i l))
);IF
(SETQ i (1+ i))
);WHILE
m
);DEFUN
;;;Поиск самого левого элемента списка
(DEFUN MAXX (l / m i)
(SETQ i 1
m (CAR l));
(WHILE (<= i (1- (LENGTH l)))
(IF (<= (CAR (TXTIPNT m)) (CAR (TXTIPNT (NTH i l))))
(SETQ m (NTH i l))
);IF
(SETQ i (1+ i))
);WHILE
m
);DEFUN
;;;Удаление первого вхождения элемента a в список l
(DEFUN REMBER (a l)
(COND ((NULL l) nil)
((EQUAL (CAR l) a) (CDR l))
(t (CONS (CAR l) (REMBER a (CDR l))))
);COND
);DEFUN
;;;Сортировка списка в соответствии с заданным критерием
(DEFUN SORT (crit l / m)
(COND
((NULL (CDR l))
(CONS (CAR l) nil)
)
(t
(SETQ m (EVAL (LIST crit 'l)))
(CONS m (SORT crit (REMBER m l)))
);t
);COND
);DEFUN
;;Функция замены в строке base подстроки srch на repl
(DEFUN STRREPL (base srch repl / basel i)
(SETQ i 1)
(IF (AND (/= srch "")
(<= (STRLEN srch) (STRLEN base))
);AND
(PROGN
(SETQ basel (STRLEN base))
(WHILE
(< i (+ (- basel (STRLEN srch)) 2))
(IF (= (SUBSTR base i (STRLEN srch)) srch)
(PROGN
(SETQ base
(IF (= i 1)
(STRCAT repl
(SUBSTR base (+ i (STRLEN srch)))
);STRCAT
(STRCAT
(SUBSTR base 1 (- i 1))
repl
(SUBSTR base
(+ i (STRLEN srch))
);SUBSTR
);STRCAT
);IF
);SETQ
(SETQ i (+ i (strlen repl))
basel (STRLEN base)
);SETQ
);PROGN
(SETQ i (1+ i))
);IF
);WHILE
);PROGN
);IF
base
);DEFUN
;;;Выбор группы чисел
(DEFUN GETNUMBERS ( / en ss n i l sum)
(PRINC "\nВыберите группу чисел:")
(SETQ ss (SSGET '((0 . "TEXT"))))
(COND ((NULL ss) nil)
(t
(SETQ
n (SSLENGTH ss)
i 0
l nil
);SETQ
(WHILE (<= i (1- n))
(SETQ l (CONS (SSNAME ss i) l)
i (1+ i)
);SETQ
);WHILE
(SETQ ss nil
l (MAPCAR
'(LAMBDA (en) (ATOF (STRREPL (CDR (ASSOC 1 (ENTGET en))) "," "."))
);LAMBDA
(SORT 'MAXY (SORT 'MAXX l)));MAPCAR
sum (APPLY '+ l)
);SETQ
(TERPRI)
(PRINC (MAPCAR 'RTOS l))
(PRINC "\nКоличество: ")
(PRINC (ITOA n))
(PRINC "\nCумма: ")
(PRINC (RTOS sum))
; Добавить среднее значение
(CPCBD sum)
l
);t
);COND
);DEFUN
;;; Основной текст программы
(SETVAR "CMDECHO" 0)
(SETQ l1 (GETNUMBERS)
sum1 0
sum0 0
);SETQ
(IF l1 (SETQ l2 (GETNUMBERS)))
(WHILE (AND l1 l2)
(IF (= (LENGTH l1) (LENGTH l2))
(PROGN
(SETQ sum0 (+ sum0 (APPLY '+ l1) (APPLY '+ l2))
sum1 (+ sum1 (APPLY '+ (MAPCAR '* l1 l2)))
);SETQ
(PRINC "\nОбщая сумма: ")
(PRINC (RTOS sum0))
(PRINC "\nСумма произведений: ")
(PRINC (RTOS sum1))
(CPCBD sum1)
);PROGN
(PROGN
(PRINC "\nРазное количество чисел в группах!")
(SETQ sum0 (+ sum0 (APPLY '+ l1) (APPLY '+ l2)))
(PRINC "\nОбщая сумма: ")
(PRINC (RTOS sum0))
(CPCBD sum0)
);PROGN
);IF
(SETQ l1 (GETNUMBERS))
(IF l1 (SETQ l2 (GETNUMBERS)))
);WHILE
(SETVAR "CMDECHO" cmdecho-save)
(SETQ *error* error-save)
(PRINC)
);DEFUN
(IF (OR (NULL C:TXT-SUM)
(NOT (LISTP C:TXT-SUM))
);OR
(DEFUN C:TXT-SUM () (TXT-SUM))
);IF
(PRINC "\nДобавлена команда TXT-SUM...")
(PRIN1)
;;; Это нужно еще поправить!!!
Сообщения 4
Тему читают: 1 гость
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Autodesk → AutoCAD → Посчитать среднюю отметку по точкам?
Форум работает на PunBB, при поддержке Informer Technologies, Inc
