Подправте старый лисп

Подправте старый лисп · 24.10.2012, 23:13

Доброе время суток ALL!
вот заволялся лисп
в автокаде 2012 не хочет работать пишет
" ; ошибка: неверный тип аргумента: lentityp nil"
кому не за труд подправьте

Код:

[Выделить все]

 ; Преобразование градусов в радианы
(defun dtr (a)
     (* pi (/ a 180.0))
)
; Преобразование радиан в градусы
(defun dtr_ (a)
     (setq a(/ (* a 180.0) pi))
(setq b (- a (fix a)))
(setq c (fix a))
(setq b (* b 0.6))
(setq a (+ b c))
)
;Создать конструкцию с набором координат X Y
(defun nab ()
        (setq oss (getvar "osmode"));устанавливаем привязку в NONE
        (setvar "osmode" 0)
        (setq nach_x (car (getvar "ucsorg")))
        (setq nach_x (abs nach_x))
        (setq nach_y (cadr (getvar "ucsorg")))
        (setq nach_y (abs nach_y))
        (setq n 0)
        (setq nabx nil)
        (setq naby nil)
        (setq gran (ssget)) ; Создаем набор
        (setq x (ssname gran 0)) ;выбираем первый примитив
        (setq x1 (entnext x))
        (setq x2 (cdr (assoc 0 (entget x1))))
(while ( /= x2 "SEQEND") ; цикл с проверкой конца полилинии
(setq x1 (entnext x)) ; извлечение следующего подпримитива
(setq x2 (cdr (assoc 0 (entget x1)))) ;извлечение DXF данных (по признаку 0)
(if ( = x2 "VERTEX")
    (setq koord (cdr (assoc 10 (entget x1))));извлечение DXF данных (по признаку 10)
)

(if ( = x2 "VERTEX") (setq nabx (cons (car koord) nabx)));создание набора nabx (список Х координат
(if ( = x2 "VERTEX") (setq naby (cons (cadr koord) naby)));создание набора naby (список Y координат
        (setq n ( + 1 n))
        (setq x x1)
)
        (setq nabx (reverse nabx))
        (setq naby (reverse naby))
)

(defun dlin ();функция вычисления углов и длин линий
        (setq ln (length nabx))  ;длина набора
        (setq nabug nil)
        (setq nabdl nil)
        (setq perimetr 0)
        (setq pos (- ln 1))
        (setq zikl (- ln 2))    ;х - координата точки
        (setq p 0)    ;х - координата точки
        (setq n 1)    ;х - координата точки
        (setq o 2)    ;х - координата точки
        (setq y (nth 0 nabx))    ;х1 - координата точки
        (setq x (nth 0 naby))    ;y1 - координата точки
        (setq y1 (nth 1 nabx))    ;х2 - координата точки
        (setq x1 (nth 1 naby))    ;х3 - координата точки
        (setq x3 (nth 1 naby))    ;y2 - координата точки
        (setq yP (nth pos nabx))    ;х последняя координата точки
        (setq xP (nth pos naby))    ;y последняя координата точки
        (setq tochka3 (list x y)) ;координата точки
        (setq tochka1 (list x3 y1)) ;координата точки
        (setq ug (angle tochka3 tochka1));ugol
        (setq nach_ug ug);начальный дирекционный угол
        (setq dl (distance tochka3 tochka1));ugol
        (setq perimetr (+ perimetr dl))
        (setq nabug (cons ug nabug))
        (setq nabdl (cons dl nabdl))
(repeat zikl
        (setq y (nth n nabx))    ;х - координата точки
        (setq x (nth n naby))    ;y - координата точки
        (setq y1 (nth o nabx))    ;х - координата точки
        (setq y_1 (nth p nabx))    ;х - координата точки
        (setq x3 (nth o naby))    ;y - координата точки
        (setq tochka3 (list x y)) ;координата точки
        (setq tochka1 (list x3 y1)) ;координата точки
        (setq ug (angle tochka3 tochka1))
        (setq dl (distance tochka3 tochka1))
        (setq perimetr (+ perimetr dl))
        (setq nabug (cons ug nabug))
        (setq nabdl (cons dl nabdl))
        (setq n (+ 1 n))
        (setq o (+ 1 o))
        (setq p (+ 1 p))
        (setq x (+ 1 x))
)
        (setq y_1 (nth p nabx))    ;х - координата точки
        (setq y (nth n nabx))    ;х - координата точки
        (setq x (nth n naby))    ;y - координата точки
        (setq y1 (nth 0 nabx))    ;х - координата точки
        (setq x3 (nth 0 naby))    ;y - координата точки
        (setq tochka3 (list x y)) ;координата точки
        (setq tochka1 (list x3 y1)) ;координата точки
        (setq ug (angle tochka3 tochka1))
        (setq dl (distance tochka3 tochka1))
        (setq perimetr (+ perimetr dl))
        (setq nabug (cons ug nabug))
        (setq nabdl (cons dl nabdl))

        (setq nabug (reverse nabug))
        (setq nabdl (reverse nabdl))
)


(defun vychis ();функция вычисления измеренных углов
        (setq nabugol nil);обнуление набора nabugol
        (setq zikl (- ln 1))
        (setq n 0)
        (setq p 1)
(repeat zikl
        (setq ug1 (nth n nabug))    ;х - координата точки
        (setq ug2 (nth p nabug))    ;х - координата точки
        (setq ug (+ (dtr 180) (- ug2 ug1)))
(if ( > (dtr_ ug) 80)
 (if ( < (dtr_ ug) 100) (setq ug (dtr 90))
 )
)
(if ( > (dtr_ ug) 250)
 (if ( < (dtr_ ug) 290) (setq ug (dtr 270))
 )
)
        (setq nabugol (cons ug nabugol))
        (setq n (+ 1 n))
        (setq p (+ 1 p))
 )
        ;(setq nabugol (reverse nabugol))
)

(defun direkz ();функция вычисления исправленных дирекционных углов
        (setq nabug nil)
        (setq nabug (cons nach_ug nabug))
        (setq zikl (- ln 2))
        (setq n 1)
        (setq ug1 (nth 0 nabugol))    ;исправленный угол
        (setq ug (- (+ nach_ug ug1) (dtr 180) ))
        (setq ug2 ug)
        (setq nabug (cons ug nabug))
(repeat zikl
        (setq ug1 (nth n nabugol))
        (setq ug (- (+ ug2 ug1) (dtr 180)))
        (setq ug2 ug)
        (setq nabug (cons ug nabug))
        (setq n (+ 1 n))
)
        (setq nabug (reverse nabug))
)

(defun prirash ();функция вычисления исправленных дирекционных углов
        (setq nab_x nil)
        (setq nab_y nil)
        (setq sum_x 0)
        (setq sum_y 0)
        (setq zikl (- ln 0))
        (setq n 0)
        (setq nach_x (nth 0 nabx))    ;исправленный угол
        (setq nach_y (nth 0 naby))    ;исправленный угол
(repeat zikl
        (setq dl (nth n nabdl))
        (setq ug (nth n nabug))
        (setq pr_x (* (sin ug) dl))
        (setq pr_y (* (cos ug) dl))
        (setq sum_x (+ sum_x pr_x ))
        (setq sum_y (+ sum_y pr_y ))
        (setq nab_x (cons pr_x nab_x))
        (setq nab_y (cons pr_y nab_y))
        (setq n (+ 1 n))
)
(setq  nevazka_x (/ sum_x perimetr))
(setq  nevazka_y (/ sum_y perimetr))
        (setq nab_x (reverse nab_x))
        (setq nab_y (reverse nab_y))
)

(defun razbros ();функция вычисления исправленных дирекционных углов
        (setq nabx_ nil)
        (setq naby_ nil)
        (setq zikl (- ln 0))
        (setq n 0)
(repeat zikl
        (setq dl (nth n nabdl))
        (setq x (nth n nab_x))    ;исправленный угол
        (setq y (nth n nab_y))    ;исправленный угол
        (setq nevazkax_ (* dl nevazka_x))
        (setq nevazkay_ (* dl nevazka_y))
        (setq nev_x (- x nevazkax_))
        (setq nev_y (- y nevazkay_))
        (setq nabx_ (cons nev_x nabx_))
        (setq naby_ (cons nev_y naby_))
        (setq n (+ 1 n))
  )
        (setq nabx_ (reverse nabx_))
        (setq naby_ (reverse naby_))
 )

(defun kor ();функция вычисления исправленных дирекционных углов
        (setq naborx nil)
        (setq nabory nil)
        (setq naborx (cons nach_x naborx))
        (setq nabory (cons nach_y nabory))
        (setq zikl (- ln 1))
        (setq n 0)
        (setq p 1)
        (setq x nach_x)
        (setq y nach_y)
(repeat zikl
        (setq x_ (nth n nabx_))    ;исправленный угол
        (setq y_ (nth n naby_))    ;исправленный угол
        (setq x (+ x x_))    ;исправленный угол
        (setq y (+ y y_))    ;исправленный угол

        (setq naborx (cons x naborx))
        (setq nabory (cons y nabory))
        (setq n (+ 1 n))
        (setq p (+ 1 p))
 )
        (setq naborx (reverse naborx))
        (setq nabory (reverse nabory))
)
(defun snova ();функция вычисления исправленных дирекционных углов
        (setq zikl ln )
        (setq n 0)
        (setq p 1)
(repeat zikl
    (command "_pline" (list (nth n naborx) (nth n nabory)) (list (nth p naborx) (nth p nabory))
     "" )
        (setq n (+ 1 n))
        (setq p (+ 1 p))
 )
        (setq n (- n 1))

     (setq x (nth n naborx))
     (setq y (nth n nabory))
     (setq x1 (nth 0 naborx))
     (setq y2 (nth 0 nabory))
     (setq tochka (list x y)) ;координата точки
     (setq tochka1 (list x1 y2)) ;координата точки
     (command "_pline" tochka tochka1
     "" )
 )

( defun c:editp ()
      (nab)
      (dlin)
      (vychis)
      (direkz)
      (prirash)
      (razbros)
      (kor)
      (snova)
)

5hev · 25.10.2012, 00:04

Цитата:

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

(while ( /= x2 "SEQEND") ; цикл с проверкой конца полилинии

Это что, из мезозоя? Acad 13? И не будет работать, надо принципиально менять.

evg76 · 25.10.2012, 00:13

угадал

, я тут еще 1 раскопал дык он заработал

пришлось правда команду подправить.

gomer · 25.10.2012, 00:27

Цитата:

Сообщение от 5hev[ru

;988858]Это что, из мезозоя?

а с каких пор это перестало работать?

evg76, вам vlide зачем? посмотрите где ошибку выдает, это а, б - ну че влом было оформить

Код:

[Выделить все]

 код как положено

?

evg76 · 25.10.2012, 00:36

с момента как нашел этот лисп и подсунул его в акад 2012 ( с сегодняшнего дня)

кроме того я в лиспе чайник ( ну совсем никак)

gomer · 25.10.2012, 02:59

evg76, тыкай в полилинии, а не в легкие полилинии, хотя оно все равно хрень какую-то рисует

5hev · 25.10.2012, 09:07

gomer, очевидно, с тех пор как полилинии представляются не так, как блоки. Или я не прав? Я выделил строку в #2 - может, чего-то не знаю, но мне кажется, это неверно (к тому же, не работает).

Цитата:

тыкай в полилинии, а не в легкие полилинии

Все, с этим разобрался

Тысяча извинений!
Дима_, спасибо и Вам) Я гораздо позже начал с кадом работать, вот и все.

Дима_ · 25.10.2012, 09:25

Цитата:

Сообщение от 5hev[ru]

gomer, очевидно, с тех пор как полилинии представляются не так, как блоки. Или я не прав? Я выделил строку в #2 - может, чего-то не знаю, но мне кажется, это неверно (к тому же, не работает).

Полилинии как представлялись, так и представляются, просто сейчас под полилинией, по умолчанию, подразумеваются легкие lwpolyline, а лисп заточен на "настоящие" polyline с vertex'ами и пр.

Do$ · 25.10.2012, 09:39

evg76, ну лисп, ну хорошо, а что он должен делать? А на чем проверять?
5hev[ru], еще есть многогранная сеть, которая тоже объект "POLYLINE", но усложненный. Ее вершины (и грани) ищутся тоже через entnext, до объекта "SEQEND".

evg76 · 25.10.2012, 10:03

Вообще лисп когда-то задумывался на то что бы править в полигоне кривые углы на углы в 90 гр. (если мне моя память не изменяет, с эпохи мезозоя прошло слишком много времени.)

Do$ · 25.10.2012, 10:23

Но сейчас-то есть параметризация

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Интересно где работают ЛИСП программисты?	dextron3	LISP	114	17.12.2017 13:53
Что прописать в acad.lsp чтобы всегда загружались пользовательские лисп команды?	overband	LISP	43	07.02.2013 14:47
Лисп: моментальное редактирование цифр в предложениях	dextron3	LISP	12	27.09.2008 09:33
Лисп для копирования данных нескольких мтекстов по принципу расположения.	Red Nova	LISP	14	18.06.2008 22:08
Нужен лисп (пронизыватель лайаутов)	dextron3	LISP	91	25.07.2007 07:37

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск