[semvb]

Написанные когда-то (или скачанные) лисп-программы для ACAD 2006 не работают, или криво работают в 2009 и выше. В чем проблема?

[Кулик Алексей aka kpblc]

В очень ясно заданном вопросе. Хотя бы один пример привел, что ли...

[semvb]

;;------------------> Рисование прямоугольника с осевыми линиями
;; Должен быть создан слой с именем "осевая"
;;-------------------------------------------------------------------

(defun c:kvdr ( / pt1 lkv hkv p1 p2 p3 p4 p5 p6 os1 os2 oldlr oldcl oldcp)
(setq sosmo (getvar "osmode"))
(setvar "osmode" 615)
(setq pt1 (getpoint "\nЦентральная точка: "))
(setq lkv (getdist pt1 "\nШирина прямоугольника: "))
(setq hkv (getdist pt1 "\nВысота прямоугольника: "))
(setq p1 (list (-(car pt1) (/ lkv 2.0)) (-(cadr pt1) (/ hkv 2.0))));координаты центра -> в координаты левого нижнего угла p1
(setq p2 (list (car p1) (+(cadr p1) hkv)))
(setq p3 (list (+(car p2) lkv) (cadr p2)))
(setq p4 (list (car p3) (cadr p1)))
(setvar "osmode" 0)
(COMMAND "PLINE" p1 p2 p3 p4 "c")

(setq os1 (* lkv 0.6))
(setq os2 (* hkv 0.6))
(setq p5 (polar pt1 pi os1))
(setq p6 (polar pt1 0 os1))
(setq p7 (polar pt1 (* pi 0.5) os2))
(setq p8 (polar pt1 (* pi 1.5) os2))
(setq oldlr (getvar "clayer")

)
(command "layer" "s" "осевая" ""); перход в слой осевых линий, если известно имя
(command "line" p5 p6 "")
(command "line" p7 p8 "")
(setvar "clayer" oldlr); возврат из слоя осевых линий, если было известно имя

(setvar "osmode" 743)
)

[Кулик Алексей aka kpblc]

1. Почему команды и опции без символа "_"?
2. А слой "Осевая" существует?

[semvb]

2. Слой существует, забит в шаблон dwt - у некоторых лиспов не происходит переход в нужный слой, открывается окно выбора слоя и команда обрывается.
1. При написании новых лиспов стал вводить символ "_" перед командой, а все старые и без него неплохо работают в 2006.

[Кулик Алексей aka kpblc]

Код:

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

(defun c:kvdr1 (/ adoc *error* pt1 len height ent1 ent2 ent3)
  (defun *error* (msg)
    (foreach item (list ent1 ent2 ent3)
      (if item
        (entdel ent1)
        ) ;_ end of if
      ) ;_ end of foreach
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (and (= (type (setq pt1 (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint "\nЦентральная точка <Отмена> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           (= (type (setq len (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getdist pt1 "\nШирина прямоугольника <Отмена> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           (= (type (setq height (vl-catch-all-apply
                                   (function
                                     (lambda ()
                                       (getdist pt1 "\nВысота прямоугольника <Отмена> : ")
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'real
              ) ;_ end of =
           ) ;_ end of and
    (setq ent1 (entmakex (list '(0 . "LWPOLYLINE")
                               '(100 . "AcDbEntity")
                               '(8 . "Осевая")
                               '(100 . "AcDbPolyline")
                               '(90 . 4)
                               '(70 . 1)
                               '(43 . 0.0)
                               '(38 . 0.0)
                               '(39 . 0.0)
                               (cons 10 (list (- (car pt1) (/ len 2.)) (- (cadr pt1) (/ height 2.))))
                               (cons 10 (list (+ (car pt1) (/ len 2.)) (- (cadr pt1) (/ height 2.))))
                               (cons 10 (list (+ (car pt1) (/ len 2.)) (+ (cadr pt1) (/ height 2.))))
                               (cons 10 (list (- (car pt1) (/ len 2.)) (+ (cadr pt1) (/ height 2.))))
                               '(210 0.0 0.0 1.0)
                               ) ;_ end of list
                         ) ;_ end of entmakex
          ent2 (entmakex (list (cons 0 "LINE")
                               (cons 10 (list (car pt1) (- (cadr pt1) (* height 0.75))))
                               (cons 11 (list (car pt1) (+ (cadr pt1) (* height 0.75))))
                               ) ;_ end of list
                         ) ;_ end of entmakex
          ent3 (entmakex (list (cons 0 "LINE")
                               (cons 10 (list (- (car pt1) (* len 0.75)) (cadr pt1)))
                               (cons 11 (list (+ (car pt1) (* len 0.75)) (cadr pt1)))
                               ) ;_ end of list
                         ) ;_ end of entmakex
          ) ;_ end of setq
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  )

[semvb]

Спасибо, только поясни пожалуйста принцип, у меня много таких зависших лиспов!

[Кулик Алексей aka kpblc]

Принцип? Уйти от применения командных методов.

[semvb]

C вводом данных более-менее понятно, как перейти в нужный слой и что за список:
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(8 . "Осевая")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 (list (- (car pt1) (/ len 2.)) (- (cadr pt1) (/ height 2.))))
(cons 10 (list (+ (car pt1) (/ len 2.)) (- (cadr pt1) (/ height 2.))))
(cons 10 (list (+ (car pt1) (/ len 2.)) (+ (cadr pt1) (/ height 2.))))
(cons 10 (list (- (car pt1) (/ len 2.)) (+ (cadr pt1) (/ height 2.))))
'(210 0.0 0.0 1.0)

[Кулик Алексей aka kpblc]

Могу только отправить к DXF Reference...

[semvb]

Я это и имел в виду, не могу найти полную расшифровку кодов примитивов, где что под каким номером

[Кулик Алексей aka kpblc]

semvb, так ты открой DXF Reference - там все написано (правда, по-английски).

[semvb]

Вот с английским как раз и проблема, а на русском нет?

[Кулик Алексей aka kpblc]

Насколько я знаю, некоторая часть была переведена в книгах Н.Н.Полещука.

[Disney]

Сообщение от semvb Я это и имел в виду, не могу найти полную расшифровку кодов примитивов, где что под каким номером

Можно методом «научного тыка», получаешь entget-ом список и ищешь, что тебе нужно.
Например:
Хочешь узнать под каким кодом цвет, красишь примитив в 5 (синий) цвет, получаешь entget-ом список:

((-1 . <Имя объекта: 7ef8bf10>) (0 . "LWPOLYLINE") (330 . <Имя объекта: 7ef01cf8>) (5 . "3CB2") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 5) (100 . "AcDbPolyline") (90 . 2) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 214.778 256.467) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 270.31 285.265) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))

находишь 5 в точечной паре (62 . 5), значит скорее всего цвет идёт под 62 кодом

[semvb]

спасибо, будем пробовать!

[Do$]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (defun c:kvdr1 (/ adoc *error* pt1 len height ent1 ent2 ent3) (defun *error* (msg) (foreach item (list ent1 ent2 ent3) (if item (entdel ent1) ) ;_ end of if ) ;_ end of foreach (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (vl-load-com) .... )

Описание функции внутри другой функции?

[Кулик Алексей aka kpblc]

А что такого? Это нормально.
---
Уточнение: в LISP, реализованном в AutoCAD - это нормально.

[Do$]

Возьмем на вооружение! Спасибо