Написать комментарии к коду - Lisp
Формулировка задачи:
Помогите плс нужно написать комментарии к коду подсчет общий длины линии (для AutoCAD)
(if (not (= (substr (ver) 1 11) "Visual LISP")) (load "acad2006doc.lsp"))
;; Silent load.
(princ)
(defun c:an (/ string string1 string2 nums is num i vla_txt)
(vl-load-com)
(setq higth (getint "\nВведите высоту текста..."))
(setq nums (getint "\nВведите стартовый номер..."))
(setq is (getint "\nВведите кол-во..."))
(setq string1 (getstring "\nВведите начало текста..."))
(setq string2 (getstring "\nВведите окончание текста..."))
(setq string (strcat string1 (rtos nums 2 0) string2))
(setq vla_txt1
(vla-addtext
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
string
(vlax-3d-point
(getpoint "\nУкажите точку вставки текста...")
)
higth;высота
)
)
(while (< num is)
(setq num (+ 1 nums ))
(setq nums num)
(setq string (strcat string1 (rtos nums 2 0) string2))
vla_txt1
(vla-addtext
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
string
(vlax-3d-point
(getpoint "\nУкажите точку вставки текста...")
)
higth;высота
)
);while
)
(defun C:Dlina (/ Nab Sum i Curve Param)
(vl-load-com)
(if (setq Nab (ssget))
(progn
(setq Sum 0 i 0 value 0)
(repeat (sslength Nab)
(setq Curve (vlax-ename->vla-object (ssname Nab i))
i (1+ i)
Param (vl-catch-all-apply 'vlax-curve-getEndParam
(list Curve))
)
(if (not (vl-catch-all-error-p Param))
(setq Sum (+ Sum (vlax-curve-getDistAtParam Curve
Param)))
)
)
)
)
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos
Sum 2 2)))
(setq value (rtos Sum 2 2))
(alert (strcat "Сумма = " value))
(prin1)
)
;;;функция для нумерации.
;;;вводите начальное число
;;;выбираете предварительно подготовленный текст по порядку
;;;программа увеличивает выбранное число на 1 от предыдущего
(defun c:plus1(/ s n g a name string1 string2)
(setq Name 0)
(setq i 1)
(setq s (getint "\nВведите первый номер:"))
(setq i (getint "\nВведите Шаг:"))
(setq string1 (getstring T "\nВведите начало текста..."))
(setq string2 (getstring T "\nВведите окончание текста..."))
; (if (i=nil) (setq i 1))
;(princ (strcat "\nСу " (rtos i 2 2)))
(while Name
(setq Name (car (entsel "\nУкажите текст или [Enter]:")))
(if Name
(if (= (cdr (assoc '0 (entget Name))) "TEXT")
(progn
(setq n (entget name))
(print n)
(setq str (strcat string1 (rtos s 2 0) string2 ) )
(setq g (cons 1 str ) )
(entmod (subst g (assoc '1 n) n))
(setq s (+ i s))
);progn
);if
);if
);while
);defun
;;;функция для нумерации.
;;;вводите начальное число
;;;выбираете предварительно подготовленный текст по порядку
;;;программа увеличивает выбранное число на 1 от предыдущего
(defun c:plus1m(/ s n g a name string1 string2)
(setq Name 0)
(setq i 1)
(setq s (getint "\nВведите первый номер:"))
(setq i (getint "\nВведите Шаг:"))
(setq string1 (getstring T "\nВведите начало текста..."))
(setq string2 (getstring T "\nВведите окончание текста..."))
(while Name
(setq Name (car (entsel "\nУкажите текст или [Enter]:")))
(if Name
(if (= (cdr (assoc '0 (entget Name))) "MTEXT")
(progn
(setq n (entget name))
(print n)
(setq str (strcat string1 (rtos s 2 0) string2 ) )
(setq g (cons 1 str ) )
(entmod (subst g (assoc '1 n) n))
(setq s (+ i s))
);progn
);if
);if
);while
);defun
(defun c:z-calc-text-value (/ value ent obj ss)
(vl-load-com)
(princ
"\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
) ;_ princ
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if (not ss)
(princ "Не выбраны объекты")
(progn
(setq
value (rtos
(apply
(function +)
(mapcar
(function
(lambda (a)
(atof
(vl-string-trim
"%Uu {\\Ll}"
(vl-string-subst
"."
","
(cdr (assoc 1 (entget a)))
) ;_ vl-string-subst
) ;_ vl-string-trim
) ;_ atof
) ;_ lambda
) ;_ function
(vl-remove-if
(function listp)
(mapcar (function cadr)
(ssnamex ss)
) ;_ mapcar
) ;_ vl-remove-if
) ;_ mapcar
) ;_ apply
) ;_ rtos
) ;_ setq
(if (vl-string-position (ascii ".") value)
(setq value (vl-string-right-trim ".0" value))
) ;_ if
(princ (strcat "\n Сумма = " value))
(alert (strcat "Сумма = " value))
(setvar "ERRNO" 0)
(while
(and (not (setq ent
(car
(nentsel
(strcat
"\n Выберите текстовый объект для записи значения <Выход>:"
) ;_ strcat
) ;_ entsel
) ;_ car
) ;_ setq
) ;_ not
(equal (getvar "ERRNO") 7)
) ;_ and
(setvar "ERRNO" 0)
) ;_ while
(if (and ent
(vlax-property-available-p
(setq obj (vlax-ename->vla-object ent))
'TextString
) ;_ vlax-property-available-p
) ;_ and
(progn
(vlax-put-property obj 'TextString value)
(vlax-release-object obj)
) ;_ progn
) ;_ if
) ;_ progn
) ;_ if
(princ)
) ;_ defunРешение задачи: «Написать комментарии к коду»
textual
Листинг программы
(defun C:DLINA (/ Nab Sum i Curve Param value) (vl-load-com) (if (setq Nab (ssget)) ;_ Если выбран набор (progn (setq Sum 0 i 0 ) ;_ Устанавливаем сумму и счетчик в ноль (repeat (sslength Nab) ;_ Для каждого объекта в наборе (setq Curve (vlax-ename->vla-object (ssname Nab i)) i (1+ i) Param (vl-catch-all-apply ;_ находим его конечный параметр 'vlax-curve-getEndParam (list Curve) ) ) (if (not (vl-catch-all-error-p Param)) (setq Sum (+ Sum ;_ и, если он (объект) имеет длину, прибавляем ее к общей сумме (vlax-curve-getDistAtParam Curve Param) ) ) ) ) ) ) (princ (strcat "\nСумма длин выбранных элементов равна: " (rtos Sum 2 2) ) ) ;_ а затем сумму выводим в ком.строку (setq value (rtos Sum 2 2)) (alert (strcat "Сумма = " value)) ;_ и во всплывающее сообщение (prin1) ;_ и наконец выходим по-тихому )
Объяснение кода листинга программы
В этом коде представлена функция, которая вычисляет сумму длин выбранных элементов в наборе. Вот список действий, которые выполняет код:
- Загрузка визуального лайаута.
- Проверка, выбран ли набор.
- Если выбран, инициализация суммы и счетчика.
- Для каждого объекта в наборе: a. Получение объекта. b. Получение конечного параметра объекта. c. Если конечный параметр получен без ошибок, прибавление его длины к сумме.
- Если ни один конечный параметр не получен без ошибок, вывод суммы длин в командную строку.
- Сохранение значения суммы в переменной.
- Вывод значения суммы во всплывающее окно.
- Выход из функции.