Тема: LISP. Удлинение отрезка

;|=======================================================================================
*    Удлиняет отрезок на заданную величину. Для масштаба читаются значения celtscale,
* ltscale, hpscale, hpspace, dimscale и выбирается максимальная из них. Для пространства
* листа принимается масштаб = 1 невзирая на значения этих переменных.
*    Обрабатываются только отрезки, для остального программа завершается.
*    Параметры :
*    pluslen    - величина увеличения отрезка. Для nil и <=0 принимается 2.5
* Примеры вызова:
(kpblc-extlen 3)
(kpblc-extlen nil)
=======================================================================================|;
(defun kpblc-extlen(pluslen
            /
            _cmdecho_
            _osmode_
            ent_line
            draw_scale
            ent_start_orig
            ent_end_orig
            )
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    );_if
  (vla-startundomark *kpblc-activedoc*)
  (setq _cmdecho_ (getvar "cmdecho")
    _osmode_ (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (if (= (getvar "tilemode") 0)
    (setq draw_scale 1)    ;Для пространства листа
    (setq draw_scale (max (getvar "dimscale")
              (getvar "hpscale")
              (getvar "ltscale")
              (getvar "celtscale")
              (getvar "hpspace")
              );_max
      );_setq    - для пространства модели
    );_if
  (if (or (= pluslen nil) (<= pluslen 0))
    (setq pluslen 2.5)
    );_if
  (setq ent_line (entsel "\nВыберите удлиняемый отрезок : "))
  (if (/= (cdr (assoc 0 (entget(car ent_line)))) "LINE")
    (alert "Обрабатываются только отрезки! Для остального мозгов не хватат.")
    (progn
      (setq ent_start_orig (cdr (assoc 10 (entget(car ent_line))))
        ent_end_orig   (cdr (assoc 11 (entget(car ent_line))))
        );_setq
      (command "_.Lengthen" "_Delta" pluslen ent_start_orig ent_end_orig "")
      );_progn
    );_if
  (setvar "cmdecho" _cmdecho_)
  (setvar "osmode" _osmode_)
  (vla-endundomark *kpblc-activedoc*)
  );_defun

Re: LISP. Удлинение отрезка

> kpblc
А что, если ты пояснишь, как запустить эту программу с учетом того, что здесь используется "vla"? Да и про мозги как-то....

Re: LISP. Удлинение отрезка

О! Спасибо, совсем забыл - в самом начале, перед (if *kpblc-activedoc*... надо поставить (vl-load-com).
И вот еще - один момент пропустил: после :

(if (or (= pluslen nil) (<= pluslen 0))
    (setq pluslen 2.5)
    );_if

Надо поставить

(setq pluslen (* pluslen draw_scale))

===
Весь код:

;|=======================================================================================
*    Удлиняет отрезок на заданную величину. Для масштаба читаются значения celtscale,
* ltscale, hpscale, hpspace, dimscale и выбирается максимальная из них. Для пространства
* листа принимается масштаб = 1 невзирая на значения этих переменных.
*    Обрабатываются только отрезки, для остального программа завершается.
*    Параметры :
*  pluslen  - величина увеличения отрезка. Для nil и <=0 принимается 2.5
* Примеры вызова:
(kpblc-extlen 3)
(kpblc-extlen nil)
=======================================================================================|;
(defun kpblc-extlen(pluslen
        /
        _cmdecho_
        _osmode_
        ent_line
        draw_scale
        ent_start_orig
        ent_end_orig
        )
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    );_if
  (vla-startundomark *kpblc-activedoc*)
  (setq _cmdecho_ (getvar "cmdecho")
  _osmode_ (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (if (= (getvar "tilemode") 0)
    (setq draw_scale 1)  ;Для пространства листа
    (setq draw_scale (max (getvar "dimscale")
        (getvar "hpscale")
        (getvar "ltscale")
        (getvar "celtscale")
        (getvar "hpspace")
        );_max
    );_setq  - для пространства модели
    );_if
  (if (or (= pluslen nil) (<= pluslen 0))
    (setq pluslen 2.5)
    );_if
  (setq pluslen (* pluslen draw_scale))
  (setq ent_line (entsel "\nВыберите удлиняемый отрезок : "))
  (if (/= (cdr (assoc 0 (entget(car ent_line)))) "LINE")
    (alert "Обрабатываются только отрезки! Для остального мозгов не хватат.")
    (progn
      (setq ent_start_orig (cdr (assoc 10 (entget(car ent_line))))
      ent_end_orig   (cdr (assoc 11 (entget(car ent_line))))
      );_setq
      (command "_.Lengthen" "_Delta" pluslen ent_start_orig ent_end_orig "")
      );_progn
    );_if
  (setvar "cmdecho" _cmdecho_)
  (setvar "osmode" _osmode_)
  (vla-endundomark *kpblc-activedoc*)
  );_defun

===
А запускать как обычный лисп, тут ничего сверхъестественного нет. vla-функции используются только для организации меток отмены команды. Я настолько привык это делать, что уже и не замечаю ;)
Примеры вызовов указаны в начале.
*kpblc-activedoc* - глобальная переменная, указатель на текущий документ.
А что с мозгами? Отдых на рабочем месте - самое то! Еще и деньги платят ;)
На всякий случай попробую разобрать прогу по шагам - поскольку перед глазами есть пример.
Сначала идет все описание функции как таковой с указанием параметров и примеров вызова. (находится между ";|" и "|;")
Потом - собственно объявление фукнции. Для удобства чтения разделитель параметров вызова и внутренних переменных вынесен в отдельную строку (/).

(if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    );_if

Проверка на наличие уже объявленного указателя на текущий документ. Если его нет (т.е. = Nil), то выполняется его "заполнение" - (vla-get-activedocument...)
Затем заполняются локальные переменные текущих значений cmdecho и osmode:

(setq _cmdecho_ (getvar "cmdecho")
  _osmode_ (getvar "osmode"))

На самом деле здесь это не особо требуется - выделение все равно идет только отрезка и только одного.
Потом идет проверка текущего пространства:

(if (= (getvar "tilemode") 0) <...>

Если tilemode = 0, то работа выполняется в пространстве листа. Следовательно, масштаб устанавливается в 1. Для пространства модели масштаб читается из заявленных системных переменных. Если известно, что некоторые программы хранят масштабы в других местах, здесб надо будет менять строки

    (setq draw_scale (max (getvar "dimscale")
        (getvar "hpscale")
        (getvar "ltscale")
        (getvar "celtscale")
        (getvar "hpspace")
        );_max

на чтение масштаба из других мест.
А дальше все совсем просто - через (entsel) получаем объект, потом проверяем его тип через (assoc 0...) - он должен быть "LINE", т.к. для "LWPOLYLINE", например, алгоритм не так очевиден.
Затем для выбранного отрезка получаем начальную и конечную точки и для него выполняем команду "_.Lengthen" с указанием дельты (приращения), объекта (выбранного) и точек (начальной и конечной).
Потом возвращаем обратно значения системных переменных osmode и cmdecho.
Если не очень объяснил - напиши, попробую получше. Но не гарантирую.

Re: LISP. Удлинение отрезка

> kpblc
Да я ведь не совсем про код говорю. Вот я в своих программах привожу пример имени файла, которое потом фигурирует в макросе на запуск.
Ну, допустим, я сохранил этот код в файл с именем, например, ext_line.lsp в прописанную папку. Дальше-то что делать. Если я сразу наберу в командной строке
(kpblc-extlen 3) или (kpblc-extlen nil)
ничего же не произойдет. Так вот и надо бы описать, как ЗАГРУЗИТЬ программу и как инициализировать ее ВЫПОЛНЕНИЕ. Ведь эта программа не имеет "C:имя_функции". FAQ'а на это еще нет, значит, надо дать или макрос с загрузкой на кнопку, или описать способы автозагрузки и способы выполнения, или же просто создать тему со всеми этими тонкостями и пусть den-si конвертирует ее в FAQ. А еще надо бы описать кратко загрузку программ с помощью acaddoc*.lsp, acad.lsp, acad.mnl...
Или это будет серьезный раздел, или он разбухнет от излишних диалогов, дублирующей информации, критики, самокритики и еще Бог знает от чего.

Re: LISP. Удлинение отрезка

Ок. Ясно. Тогда опишу последовательность загрузки в новой теме. Там же опишу последовательность создания лиспа-стартера (как я уго понимаю). См. https://www.caduser.ru/forum/topic19699.html

Re: LISP. Удлинение отрезка

я для удленения отрезка
испоьзую макрос
------------------------
^C^C_lengthen;_DE;\
------------------------

Re: LISP. Удлинение отрезка

kpblc
А возможно изменить код, под стандартный вызов С:

Re: LISP. Удлинение отрезка

> guest
Это вопрос или утверждение? И про какой код разговор?

Re: LISP. Удлинение отрезка

Я бы тоже предпочел

(defun kpblc-extlen(pluslen /

заменить на

(defun C:kpblc-extlen( /

а pluslen оформить в виде запроса во время выполнения программы.

Re: LISP. Удлинение отрезка

> Владимир Громов
Никто не мешает сделать хоть сотню функций примерно такого содержания:

(defun c:plus100()
(kpblc-extlen 100)
)
(defun c:plus200()
(kpblc-extlen 200)
)

И так далее.

Re: LISP. Удлинение отрезка

И значит - сотню кнопок...

Re: LISP. Удлинение отрезка

> Владимир Громов
Ну вот только не надо, да? ;)
Я показал, что функция универсальна. "Снаружи" прописывается все что угодно - от жестко задаваемого варианта до запроса. А вызывается уже собственно kpblc-extlen.

Re: LISP. Удлинение отрезка

Все-таки, набрался наглости и сделал вариант.
kpblc - не обижайся.

;|=======================================================================================
*    Удлиняет (укорачивает) отрезок на заданную величину. Для масштаба читаются значения celtscale,
* ltscale, hpscale, hpspace, dimscale и выбирается максимальная из них. Для пространства
* листа принимается масштаб = 1 невзирая на значения этих переменных.
*    Обрабатываются только отрезки, для остального программа завершается.
=======================================================================================|;
(defun C:EXT_LEN ( /
         pluslen
        _cmdecho_
        _osmode_
        ent_line
        draw_scale
        ent_start_orig
        ent_end_orig
        )
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    );_if
  (vla-startundomark *kpblc-activedoc*)
  (setq _cmdecho_ (getvar "cmdecho")
  _osmode_ (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (if (= (getvar "tilemode") 0)
    (setq draw_scale 1)  ;Для пространства листа
    (setq draw_scale (max (getvar "dimscale")
        (getvar "hpscale")
        (getvar "ltscale")
        (getvar "celtscale")
        (getvar "hpspace")
        );_max
    );_setq  — для пространства модели
    );_if
  (if (null plulen) (setq plulen "2.5"))
  (princ (strcat "\nВеличина удлинения отрезка <" plulen ">: "))
  (setq pluslen (getreal))
  (if (= pluslen nil)
      (setq pluslen (atof plulen))
  );_if
  (setq plulen (rtos pluslen))
  (setq pluslen (* pluslen draw_scale))
  (setq ent_line (entsel "\nВыберите удлиняемый отрезок : "))
  (if (/= (cdr (assoc 0 (entget(car ent_line)))) "LINE")
    (alert "Обрабатываются только отрезки! Для остального мозгов не хватат.")
    (progn
      (setq ent_start_orig (cdr (assoc 10 (entget(car ent_line))))
      ent_end_orig   (cdr (assoc 11 (entget(car ent_line))))
      );_setq
      (command "_.Lengthen" "_Delta" pluslen ent_start_orig ent_end_orig "")
      );_progn
    );_if
  (setvar "cmdecho" _cmdecho_)
  (setvar "osmode" _osmode_)
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  );_defun

Если код сохранить в файле ext_len.lsp, то макрос для кнопки или пункта меню может иметь вид:

^C^C(if (not C:EXT_LEN) (load "ext_len")) EXT_LEN

Re: LISP. Удлинение отрезка

Тогда и я тоже еще вариант выложу (тоже переделанный, на основе > Владимир Громов (2006-11-13 10:40:34)

;|=============================================================================
*    Удлиняет (укорачивает) отрезок на заданную величину. Для масштаба читаются
* значения celtscale, ltscale, hpscale, hpspace, dimscale и выбирается
* максимальная из них. Для пространства листа принимается масштаб = 1 невзирая
* на значения этих переменных.
*    Обрабатываются только отрезки, для остального программа завершается.
=============================================================================|;
(defun c:ext_len (/             pluslen       _cmdecho_     _osmode_
                  ent_line      draw_scale    ent_start_orig
                  ent_end_orig  *error*
                  )
  (defun *error* (msg)
    (mapcar '(lambda (x)
               (vl-catch-all-apply
                 '(lambda ()
                    (if (cdr x)
                      (setvar (car x) (cdr x))
                      ) ;_ end of if
                    ) ;_ end of lambda
                 ) ;_ end of vl-catch-all-apply
               ) ;_ end of lambda
            (list (cons "cmdecho" _cmdecho_) (cons "osmode" _osmode_))
            ) ;_ end of mapcar
    (vla-endundomark *kpblc-activedoc*)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_if
  (vla-startundomark *kpblc-activedoc*)
  (setq _cmdecho_ (getvar "cmdecho")
        _osmode_  (getvar "osmode")
        ) ;_ end of setq
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (if (= (getvar "tilemode") 0)
    (setq draw_scale 1) ;Для пространства листа
    (setq draw_scale
           (max (getvar "dimscale")
                (getvar "hpscale")
                (getvar "ltscale")
                (getvar "celtscale")
                (getvar "hpspace")
                ) ;_max
          ) ;_setq  — для пространства модели
    ) ;_if
  (if (null plulen)
    (setq plulen "2.5")
    ) ;_ end of if
  (setq pluslen (cond
                  ((getreal (strcat "\nВеличина удлинения отрезка <" plulen ">: "))
                   )
                  (t plulen)
                  ) ;_ end of cond
        plulen  (rtos pluslen)
        pluslen (* pluslen draw_scale)
        ) ;_ end of setq
  (setq ent_line (entsel "\nВыберите удлиняемый отрезок : "))
  (if (/= (cdr (assoc 0 (entget (car ent_line)))) "LINE")
    (alert "Обрабатываются только отрезки! Для остального мозгов не хватат.")
    (if
      (/=
        0
        (cdr
          (assoc
            70
            (entget (tblobjname "layer" (cdr (assoc 8 (entget (car ent_line)))))
                    ) ;_ end of entget
            ) ;_ end of assoc
          ) ;_ end of cdr
        ) ;_ end of /=
       (alert "Сначала разблокируйте слой!")
       (progn
         (setq ent_start_orig (cdr (assoc 10 (entget (car ent_line))))
               ent_end_orig   (cdr (assoc 11 (entget (car ent_line))))
               ) ;_ end of setq
         (command "_.Lengthen" "_Delta" pluslen ent_start_orig ent_end_orig "")
         ) ;_ end of progn
       ) ;_ end of if
    ) ;_ end of if
  (mapcar '(lambda (x)
             (vl-catch-all-apply
               '(lambda ()
                  (if (cdr x)
                    (setvar (car x) (cdr x))
                    ) ;_ end of if
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of lambda
          (list (cons "cmdecho" _cmdecho_) (cons "osmode" _osmode_))
          ) ;_ end of mapcar
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_defun

Re: LISP. Удлинение отрезка

Евгений Елпанов указал мне на ошибку. Исправляю...

;|=============================================================================
*    Удлиняет (укорачивает) отрезок на заданную величину. Для масштаба читаются
* значения celtscale, ltscale, hpscale, hpspace, dimscale и выбирается
* максимальная из них. Для пространства листа принимается масштаб = 1 невзирая
* на значения этих переменных.
*    Обрабатываются только отрезки, для остального программа завершается.
=============================================================================|;
(defun c:ext_len (/             pluslen       _cmdecho_     _osmode_
                  ent_line      draw_scale    ent_start_orig
                  ent_end_orig  *error*
                  )
  (defun *error* (msg)
    (mapcar '(lambda (x)
               (vl-catch-all-apply
                 '(lambda ()
                    (if (cdr x)
                      (setvar (car x) (cdr x))
                      ) ;_ end of if
                    ) ;_ end of lambda
                 ) ;_ end of vl-catch-all-apply
               ) ;_ end of lambda
            (list (cons "cmdecho" _cmdecho_) (cons "osmode" _osmode_))
            ) ;_ end of mapcar
    (vla-endundomark *kpblc-activedoc*)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_if
  (vla-startundomark *kpblc-activedoc*)
  (setq _cmdecho_ (getvar "cmdecho")
        _osmode_  (getvar "osmode")
        ) ;_ end of setq
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (if (= (getvar "tilemode") 0)
    (setq draw_scale 1) ;Для пространства листа
    (setq draw_scale
           (max (getvar "dimscale")
                (getvar "hpscale")
                (getvar "ltscale")
                (getvar "celtscale")
                (getvar "hpspace")
                ) ;_max
          ) ;_setq  — для пространства модели
    ) ;_if
  (if (null plulen)
    (setq plulen "2.5")
    ) ;_ end of if
  (setq pluslen (cond
                  ((getreal (strcat "\nВеличина удлинения отрезка <" plulen ">: "))
                   )
                  (t (atof plulen))
                  ) ;_ end of cond
        plulen  (rtos pluslen)
        pluslen (* pluslen draw_scale)
        ) ;_ end of setq
  (setq ent_line (entsel "\nВыберите удлиняемый отрезок : "))
  (if (/= (cdr (assoc 0 (entget (car ent_line)))) "LINE")
    (alert "Обрабатываются только отрезки! Для остального мозгов не хватат.")
    (if
      (/=
        0
        (cdr
          (assoc
            70
            (entget (tblobjname "layer" (cdr (assoc 8 (entget (car ent_line)))))
                    ) ;_ end of entget
            ) ;_ end of assoc
          ) ;_ end of cdr
        ) ;_ end of /=
       (alert "Сначала разблокируйте слой!")
       (progn
         (setq ent_start_orig (cdr (assoc 10 (entget (car ent_line))))
               ent_end_orig   (cdr (assoc 11 (entget (car ent_line))))
               ) ;_ end of setq
         (command "_.Lengthen" "_Delta" pluslen ent_start_orig ent_end_orig "")
         ) ;_ end of progn
       ) ;_ end of if
    ) ;_ end of if
  (mapcar '(lambda (x)
             (vl-catch-all-apply
               '(lambda ()
                  (if (cdr x)
                    (setvar (car x) (cdr x))
                    ) ;_ end of if
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of lambda
          (list (cons "cmdecho" _cmdecho_) (cons "osmode" _osmode_))
          ) ;_ end of mapcar
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

Re: LISP. Удлинение отрезка

А возможно развить программу?
Удлинение отрезка производится в одну сторону в зависимости от координат щелчка, т.е. на какой конец отрезка щелкнул тот и удлинился на заданное расстояние.

Re: LISP. Удлинение отрезка

> guest
Только что проверил на 2005 ("чистый", без дополнений и наворотов) - все работает корректно. Или пост относился не к последнему коду?

Re: LISP. Удлинение отрезка

> kpblc
Я так думаю, что guest именно хочет одностороннее удлинение отрезка.

Re: LISP. Удлинение отрезка

Тогда я пас.

Re: LISP. Удлинение отрезка

Ну, тогда вот. Удлинение линии с одной стороны:

(defun C:LEN1 ( / len)
    (if (not le) (setq le "1"))
    (setq len (getreal (strcat "\n Величина удлинения <" le ">: ")))
    (if len (setq le (rtos len)) (setq len (atof le)))
    (princ "\n Выберите объект со стороны удлинения: ")
    (command "_Lengthen" "_Delta" len pause "")
(princ)
)

Re: LISP. Удлинение отрезка

А удлинить сторону прямоугольника програмным путем, указывая направление и на сколько удлинить...

Re: LISP. Удлинение отрезка

> Владимир М
А разбитое корыто не желаете? Или вы забыли, что прямоугольник - это полилиния? Следовательно, надо говорить о перемещении вершины, а не об удлинении стороны.

Re: LISP. Удлинение отрезка

> Владимир М
Это, как я понимаю, _.stretch. При выходе по правому клику зачастую (если работать через лисп напрямую, командным методом) выдает неправильный результат.

Re: LISP. Удлинение отрезка

Но мы же понимаем, что удлинить ОДНУ сторону ПРЯМОУГОЛЬНИКА, как желает Владимир М, - это бред, грубо говоря.