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

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


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

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

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