Visual Lisp. Autocad
Формулировка задачи:
Всем привет.
Произвольно размещенные на плоскости отрезки стянуть в одну заданную точку.
Не идет программа. Выдает " error: bad argument type: numberp: nil ". Проверил код, но ошибки так и не увидел.
Может кто подскажет в чем проблема.
(DEFUN GETVAL (S K) ; (COND ((NULL S) NIL) ((EQ K (CAAR S)) (CDAR S)) (T (GETVAL (CDR S) K)) ))
(DEFUN PUTVAL (S K V) (COND ((NULL S) NIL) ((EQ K (CAAR S)) (CONS (CONS K V)(CDR S))) (T (CONS (CAR S) (PUTVAL (CDR S) K V))) ))
(DEFUN LINK (S Q) (SETQ A1 (GETVAL S 10)) ; извлечение списка координат начальной точки ; (SETQ A2 (GETVAL S 11)) ; ... конечной точки (SETQ X1LN (CAR A1)); (SETQ Y1LN (CADR A1)) ; координаты начальной точки линии (SETQ X2LN (CAR A2)); (SETQ Y2LN (CADR A2)) ; координаты конечной точки линии (SETQ XQ (CAR Q)) ; (SETQ YQ (CADR Q)) ; координаты заданной точки (IF (< (DISTANCE A1 Q) (DISTANCE A2 Q)) ; если дистанция от начальной точки меньше чем от конечной, ; то смещаем начальную точку в заданную, а конечную смещаем на разность между начальной( до смещения) и ;заданной (THEN ( ; берем НАЧАЛЬНУЮ (ее расстояние меньше) (SETQ RAZX(- XQ X1LN)) ; (SETQ RAZY(- XY Y1LN)) ; вычисляем разность (SETQ S (PUTVAL S 10 Q)) ; установка новых значений координат начальной точки (SETQ X2LN(+ X2LN RAZX)) ; (SETQ Y2LN(+ Y2LN RAZY)) ; изменяем координаты конечной точки (SETQ A2 (CONS X2LN(CONS Y2LN (CDDR A2)))) ; замена новыми значениями (SETQ S (PUTVAL S 11 A2)) ; установка новых значений координат конечной точки )) (ELSE( ; если конечная точка ближе к заданной точки (SETQ RAZX(- XQ X2LN)) (SETQ RAZY(- XY Y2LN)) (SETQ S (PUTVAL S 11 Q)) (SETQ X1LN(+ X1LN RAZX)) (SETQ Y1LN(+ Y1LN RAZY)) (SETQ A1 (CONS X1LN(CONS Y1LN (CDDR A1)))) (SETQ S (PUTVAL S 10 A1)) )) ) (ENTMOD S) )
(DEFUN M2 NIL ; главная функция . для вызова (SETQ Q(GETPOINT "Введите точку.")) (SETQ P (ENTNEXT)) ; линия (WHILE P (SETQ S(ENTGET P)) ; извлечение списка свойств примитива (SETQ A (GETVAL S 0)) ; извлечение названия типа примитива (IF (EQ A "LINE") ; (LINK S Q) ) (SETQ P (ENTNEXT P)) ) )
Решение задачи: «Visual Lisp. Autocad»
textual
Листинг программы
(defun get_prop ( dxf en ) ;;; Возвращает свойство примитива (cdr (assoc dxf (entget en)))) (defun mapset ( ss f ) (mapcar f (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))) (defun c:pol () (if (and (setq lineset (ssget '((0 . "LINE")))) (setq basept (getpoint "\nБазовая точка: "))) (mapset lineset '(lambda (line / sp ep mp) (setq sp (get_prop 10 line) ep (get_prop 11 line) mp (if (< (distance sp basept) (distance ep basept)) sp ep)) (command "_.move" line "" mp basept)))) (princ))
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д