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))
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д