Visual Lisp. Autocad

@Rocbis · Регистрация: 05.10.2013

Студворк — интернет-сервис помощи студентам

Всем привет.
Произвольно размещенные на плоскости отрезки стянуть в одну заданную точку.

Не идет программа. Выдает " error: bad argument type: numberp: nil ". Проверил код, но ошибки так и не увидел.
Может кто подскажет в чем проблема.

Lisp
1
2
3
4
5
6
(DEFUN GETVAL (S K) ; 
(COND 
    ((NULL S) NIL) 
    ((EQ K (CAAR S)) (CDAR S)) 
    (T (GETVAL (CDR S) K)) 
))

Lisp
1
2
3
4
5
6
(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))) 
))

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(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) 
)

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
(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)) 
    ) 
)

@vlisp · 17.12.2015, 22:36

Сообщение от Rocbis

Не идет программа.

какой автокад используете? почему не пользуетесь средствами отладки?

@Lambdik · 17.12.2015, 22:45

Сообщение от Rocbis

отрезки стянуть в одну заданную точку

Начальными точками отрезков?

@Rocbis · 18.12.2015, 08:45 **[ТС]**

Добавлено через 1 минуту

Сообщение от vlisp

какой автокад используете? почему не пользуетесь средствами отладки?

2016 trial version. Пробовал, но чет у меня получалось

Добавлено через 23 секунды

Сообщение от Lambdik

Начальными точками отрезков?

Сместить линию, не меняя ее наклона. Какая точка (из точек начала и конца отрезка) будет ближайшей к заданной, такую мы и смещаем в заданную точку, а координаты другой перемещаем с помощью не сложных вычислений.

Добавлено через 2 часа 43 минуты
Тему можно закрывать. В 15 и 24 перепутал аргумент.

@vlisp · 18.12.2015, 15:37

Lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(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))

Добавлено через 1 минуту
Не знаю дурят ли вас в универе или вы сами запутались в трех соснах. но задача эта элементарная... а ваш "код" - ересь... Чего стоит только вот это...

Сообщение от Rocbis

(THEN ( * * * * * * ; берем НАЧАЛЬНУЮ (ее расстояние меньше)
* * * * * * (SETQ RAZX(- XQ X1LN))

Новые блоги и статьи Все статьи Все блоги /
Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .	Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .