[Pavel_GGS]

привет.
в программе g-tools при подсчете сумм произведений выдает округленный результат. вроде както настраивалась раньше точность округления.
может кто подсобит ?

[Profan]

Приведи код g-tools.

[Disney]

из G-tools

;;;---------------------------------->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));Угол наклона
);IF
);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))
);SUBSTR
);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 " Количество: ")
(PRINC (ITOA n))
(PRINC "; Cумма: ")
(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 "; Сумма произведений: ")
(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)
);DEFUN
);IF
(PRINC "\nTxtSum.lsp загружен... ")
(PRINC "\nДобавлена команда TXT-SUM...")
(PRINC)

"Точность округления" - если подразумевается количество знаков после запятой, то Формат -> Еденицы... или команда '_units или переменная LUPREC.

[Profan]

Однако c помощью (rtos) можно обойти установленную в чертеже точность.

[Disney]

Сообщение от Profan Однако c помощью (rtos) можно обойти установленную в чертеже точность.

Можно...
Но тогда нужно либо каждый раз в Lisp лезть и там устанавливать, или дополнительный запрос делать...
А так всё по честному какую точность пользователь себе в чертеже настроил, ту и получает

[Pavel_GGS]

Profan а где этот код взять. тока не смейтесть я обычный пользователь, и до высших материй мне далеко
Disney сделак как у вас. все заработало. спасибо.
блин про это я в курсе. затупил или забыл из-за неадобностью. думал это в самой проге g-tools настраивается

[Profan]

Disney привел этот код. Он же и объяснил все. Я именно и хотел посмотреть в коде, как там используется функция AutoLisp (rtos). Оказалось, что она используется с параметрами, принятыми по умолчанию в чертеже.