Тема: Трассировка линий связи на плане (корректировка)
Помогите скоректировать програмку!!!
Перед началом работы программы нужен запрос на выбор маштаба (1:1, 1:5, 1:10, 1:20, 1:25, 1:40, 1:50, 1:100, 1:200, 1:500, 1:1000) трассировки!
Если это возможно!
;************ TRASSA.LSP — Трассировка линии связи на плане ******
;
; Разработал Громов В.В. декабрь 2004.
;
(defun C:TRASSA ( / nug tug tn tk dlina fl inf dl_all)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq inf (getstring T "\n Служебная информация (объект, этаж, помещение и др.): "))
(setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) "_trs.txt"))
(setq nug (getpoint "\n Укажите начальную точку трассировки (ENTER-отказ): "))
(if nug
(progn
(if nug (setq tn nug))
(setq tug 0 dl_all 0)
(while tug
(setq tug (getpoint tn "\n Укажите следующую точку трассировки (ENTER-Закончить): "))
(if tug
(progn
(setq tk tug)
(grdraw tn tk 5 1)
(setq dlina (distance tn tk))
(princ "\n Длина текущего сегмента (мм): ") (princ dlina)
(setq dl_all (+ dl_all dlina))
(setq tn tk)
))
);while
(setq dl_all (/ dl_all 1000))
(princ "\n Суммарная длина всех сегментов (в метрах): ") (princ dl_all)
(alert (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1)))
(command "_redraw")
(setq fl (open fil "a"))
(princ "\n\n" fl)
(princ inf fl)
(princ "\n ----------------------------------------------" fl)
(princ (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1) "\n") fl)
(close fl)
(princ "\n Информация записана в файл: ") (princ fil)
) ;progn
(princ "\n Отказ.")
)
(setvar "CMDECHO" echo)
(princ)
)