Visual Lisp. Autocad

Узнай цену своей работы

Формулировка задачи:

Всем привет. Произвольно размещенные на плоскости отрезки стянуть в одну заданную точку. Не идет программа. Выдает " error: bad argument type: numberp: nil ". Проверил код, но ошибки так и не увидел. Может кто подскажет в чем проблема.
Листинг программы
  1. (DEFUN GETVAL (S K) ;
  2. (COND
  3. ((NULL S) NIL)
  4. ((EQ K (CAAR S)) (CDAR S))
  5. (T (GETVAL (CDR S) K))
  6. ))
Листинг программы
  1. (DEFUN PUTVAL (S K V)
  2. (COND
  3. ((NULL S) NIL)
  4. ((EQ K (CAAR S)) (CONS (CONS K V)(CDR S)))
  5. (T (CONS (CAR S) (PUTVAL (CDR S) K V)))
  6. ))
Листинг программы
  1. (DEFUN LINK (S Q)
  2. (SETQ A1 (GETVAL S 10)) ; извлечение списка координат начальной точки ;
  3. (SETQ A2 (GETVAL S 11)) ; ... конечной точки
  4. (SETQ X1LN (CAR A1));
  5. (SETQ Y1LN (CADR A1)) ; координаты начальной точки линии
  6. (SETQ X2LN (CAR A2));
  7. (SETQ Y2LN (CADR A2)) ; координаты конечной точки линии
  8. (SETQ XQ (CAR Q)) ;
  9. (SETQ YQ (CADR Q)) ; координаты заданной точки
  10. (IF (< (DISTANCE A1 Q) (DISTANCE A2 Q)) ; если дистанция от начальной точки меньше чем от конечной,
  11. ; то смещаем начальную точку в заданную, а конечную смещаем на разность между начальной( до смещения) и ;заданной
  12. (THEN ( ; берем НАЧАЛЬНУЮ (ее расстояние меньше)
  13. (SETQ RAZX(- XQ X1LN)) ;
  14. (SETQ RAZY(- XY Y1LN)) ; вычисляем разность
  15. (SETQ S (PUTVAL S 10 Q)) ; установка новых значений координат начальной точки
  16. (SETQ X2LN(+ X2LN RAZX)) ;
  17. (SETQ Y2LN(+ Y2LN RAZY)) ; изменяем координаты конечной точки
  18. (SETQ A2 (CONS X2LN(CONS Y2LN (CDDR A2)))) ; замена новыми значениями
  19. (SETQ S (PUTVAL S 11 A2)) ; установка новых значений координат конечной точки
  20. ))
  21. (ELSE( ; если конечная точка ближе к заданной точки
  22. (SETQ RAZX(- XQ X2LN))
  23. (SETQ RAZY(- XY Y2LN))
  24. (SETQ S (PUTVAL S 11 Q))
  25. (SETQ X1LN(+ X1LN RAZX))
  26. (SETQ Y1LN(+ Y1LN RAZY))
  27. (SETQ A1 (CONS X1LN(CONS Y1LN (CDDR A1))))
  28. (SETQ S (PUTVAL S 10 A1))
  29. ))
  30. )
  31. (ENTMOD S)
  32. )
Листинг программы
  1. (DEFUN M2 NIL ; главная функция . для вызова
  2. (SETQ Q(GETPOINT "Введите точку."))
  3. (SETQ P (ENTNEXT)) ; линия
  4. (WHILE P
  5. (SETQ S(ENTGET P)) ; извлечение списка свойств примитива
  6. (SETQ A (GETVAL S 0)) ; извлечение названия типа примитива
  7. (IF (EQ A "LINE") ;
  8. (LINK S Q)
  9. )
  10. (SETQ P (ENTNEXT P))
  11. )
  12. )

Решение задачи: «Visual Lisp. Autocad»

textual
Листинг программы
  1. (defun get_prop ( dxf en )
  2. ;;; Возвращает свойство примитива
  3.   (cdr (assoc dxf (entget en))))
  4.  
  5. (defun mapset ( ss f )
  6.     (mapcar f  
  7.             (vl-remove-if 'listp
  8.                            (mapcar 'cadr (ssnamex ss)))))
  9.  
  10. (defun c:pol ()
  11.   (if (and (setq lineset (ssget '((0 . "LINE"))))
  12.        (setq basept (getpoint "\nБазовая точка: ")))
  13.     (mapset
  14.       lineset
  15.       '(lambda (line / sp ep mp)
  16.      (setq sp (get_prop 10 line)
  17.            ep (get_prop 11 line)
  18.            mp (if (< (distance sp basept)
  19.                      (distance ep basept))
  20.                     sp ep))
  21.      (command "_.move" line "" mp basept))))
  22.   (princ))

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 3.9 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут