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))