• VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Тема: LISP. Подобие в обе стороны

Идея и реализация родились здесь https://www.caduser.ru/forum/topic31382.html
Код

(defun C:OFF2 ( / d obj pt ent adoc *error* pt1 ang OSM)
(defun *error* (msg)(vla-EndUndoMark adoc)(setvar "OSMODE" OSM))
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)
(if (setq obj (entsel "\n Выберите объект: "))
    (progn
    (initget 6)(setq d (getdist "\n Величина смещения: "))
    (setq pt (trans (cadr obj) 1 0)
         ent (vlax-ename->vla-object(car obj))
         pt  (vlax-curve-getclosestpointto ent pt)
         pt1 (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))
         pt1 (mapcar '+ pt pt1)
         ang (+ (angle pt pt1)(* 0.5 PI))
         pt1 (trans (polar pt (+ ang pi) 5) 0 1)
          pt (trans (polar pt ang 5) 0 1)
         OSM (getvar "OSMODE"))
    (setvar "OSMODE" 0)
    (command "_.offset" d obj pt obj pt1 "")
    (setvar "OSMODE" OSM))
    (princ "\n Объект не выбран."))
(vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:OFF2)(load "off2"));OFF2

Как сохранить код читаем Как сохранить программный код на своем компьютере?

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Вариант на подобие работы команды OFFSET. Сначала запрос на величину смещения, а после в цикле выбор объекта, выход по правой кнопке мыши. Контроль блокировки слоев и типа объектов.

(defun C:OFF2 (/ d obj pt ent adoc *error* pt1 ang OSM undo lays)
  (defun *error* (msg)(vla-EndUndoMark adoc)(setvar "OSMODE" OSM))
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
    lays (vla-get-layers adoc))
  (vla-StartUndoMark adoc)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq OSM (getvar "OSMODE"))
  (setq d (getvar "UNDOCTL"))
  (cond
    ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq    *OFF2* d undo 0)
  (initget "Undo Отмени Г J _Undo Undo Undo Undo")
  (while (setq obj (entsel (strcat "\n Выберите объект "
                   (if (not (zerop undo))
                     "[Отмени]"
                     ""
                   )
                   " <выход>: "
               )
           )
     )
    (cond ((= obj "Undo")
       (if (not (zerop undo))
         (progn (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))
         (alert "Нечего больше отменять"))
      )
      (t
       (setq pt  (trans (cadr obj) 1 0)
         ent (vlax-ename->vla-object (car obj)))
       (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
          (alert "На блокированном слое!"))
         ((wcmatch (strcase (cdr(assoc 0 (entget(car obj))))) "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")
           (setq pt  (vlax-curve-getclosestpointto ent pt)
         pt1 (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))
         pt1 (mapcar '+ pt pt1)
         ang (+ (angle pt pt1) (* 0.5 PI))
         pt1 (trans (polar pt (+ ang pi) 5) 0 1)
         pt  (trans (polar pt ang 5) 0 1))
       (setvar "OSMODE" 0)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
       (command "_.offset" d obj pt obj pt1 "")
       (setvar "OSMODE" OSM)
          )
         (t (alert "Не удается создать объект, подобный данному"))
         )
      )
    )
    (initget "Undo Отмени Г J _Undo Undo Undo Undo")
  )
 (vla-EndUndoMark adoc)
  (princ)
)
(princ "\nНаберите в командной строке OFF2")

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Переписанный вариан с использованием vla-offset

(defun C:OFF2 (/ d obj ent adoc *error* undo lays)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq d (getvar "UNDOCTL"))
  (cond
    ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0)
  (initget "Undo Отмени Г J _Undo Undo Undo Undo")
  (while (setq obj (entsel (strcat "\n Выберите объект "
           (if (not (zerop undo)) "[Отмени]" "")
           " <выход>: ")))
    (cond ((= obj "Undo")
     (if (not (zerop undo))
       (progn (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))
       (alert "Нечего больше отменять")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((wcmatch (strcase (cdr(assoc 0 (entget(car obj))))) "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")
     (vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
    (initget "Undo Отмени Г J _Undo Undo Undo Undo"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

  • BigScrew
  • Восстановленный участник
  • На форуме с 17 июля 2006г.
  • Сообщений: 848
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

Хороша программа. Примите благодарность от пользователей. :)

  • На форуме с 4 апреля 2002г.
  • Сообщений: 1,348
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

Да, пора уже и поблагодарить разработчика! :)
Спасибо!
Действительно удобная и как оказалось нужная программа!
Как без нее раньше обходился?

  • CB
  • Восстановленный участник
  • На форуме с 17 мая 2006г.
  • Сообщений: 212
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

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

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Я думаю не сложно нажать 2 раза пробел, если промахнулся. Но чтобы было из чего выбирать вариант с анализом: промахнулся в выборе или нажал Enter. Надеюсь последний штрих :)

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq d (getvar "UNDOCTL"))
  (cond
    ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект "
           (if (not (zerop undo)) "[Отмени]" "")
           " <выход>: ")))
    (cond ((= obj "Undo")
     (if (not (zerop undo))
       (progn (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))
       (alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((wcmatch (strcase (cdr(assoc 0 (entget(car obj))))) "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")
     (vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

С опцией Выход по правому клику

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq d (getvar "UNDOCTL"))
  (cond
    ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")
     (if (not (zerop undo))
       (progn (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))
       (alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((wcmatch (strcase (cdr(assoc 0 (entget(car obj))))) "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")
     (vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

  • CB
  • Восстановленный участник
  • На форуме с 17 мая 2006г.
  • Сообщений: 212
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

> VVA
Естественно не сложно, но т.к. (имхо) здесь создается "народная" прога, явно претендующая на массового пользователя, я думаю пренебрегать даже мелочами не стоит (например (princ " *** Мимо ***") явно лишнее, а использование (setvar "cmdecho" 0) - желательно). Естественно каждый все это может сделать и  сам, но все таки...
А так все работает просто супер!
Еще раз спасибо.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

> CB
С CMDECHO замечание принимается. Про "** мимо **" считаю, что информировать пользователя почему ничего не произошло стоит. Форма может быть любая. Ну и, естественно, кто знает как может под себя сделать и сам.

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq d (getvar "UNDOCTL"))
  (cond
    ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")
     (if (not (zerop undo))
       (progn (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))
       (alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((wcmatch (strcase (cdr(assoc 0 (entget(car obj))))) "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE")
     (vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Более универсальный код, позволяет оффсетить объекты, у которых есть метод Offset. Это могут быть не только Автокадовские объекты.

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))(setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)(if (null (setq d (getdist))) (setq d *OFF2*))
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")(if (not (zerop undo))(progn
           (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((vlax-method-applicable-p ent 'Offset)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")

  • Yuriy
  • Yuriy
  • Активный участник
  • Откуда: Санкт-Петербург
  • На форуме с 20 декабря 2007г.
  • Сообщений: 1,503
  • Спасибо: 18

Re: LISP. Подобие в обе стороны

Классная програмка!
Может примете некоторые советы по улучшению.
1.
В программе нельзя выбрать несколько объектов.
А очень часто необходимо обработать несколько объектов.
2.
Получаемые копии можно было-бы переносить на текущий слой.
3.
добавить возможность удаления исходных объектов
4.
добавить опцию объеденения в замкнутый контур.
(если исходные объекты не замкнуты)
применив что-нибудь типа PEDIT.../join/join/add...  к полученным при подобии линиям, можно былобы получать замкнутые контуры.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

> Yuriy
С чем-то согласен, с чем-то нет
1. Можно сделать вариат для нескольких
2. ИМХО сомнительно. Лучше исходный объект выставить с нужными свойствами, а потом офсетить
3. Можно добавить запрос на удаление исходных
4. Все бы хорошо, если бы не одно но... Если контур состоял их линий, то при подобии "наружу" между вершинами будут разрывы, а при подобии "внутрь" - пересечения. PEDIT такое не возьмет. Опять, на мой взгляд, лучше объеднить исходные линии.

  • krieger
  • Восстановленный участник
  • На форуме с 21 апреля 2005г.
  • Сообщений: 74
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

При смещении в обе стороны зачастую знаешь только общее расстояние между крайними линиями. Поэтому целесообразно указывать именно это расстояние. А OFFSET делать уже на половинное значение в обе стороны. Если пополам не делить, то проще использовать обычный OFFSET и два раза щелкнуть мышкой с двух сторон от примитива. Так как у всех задачи разные все ИМХО. Для согласных со мной, я осмелился немного переделать код, добавив деление на 2:

(defun C:OFF/2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
    lays (vla-get-layers adoc))
  (vla-StartUndoMark adoc)
  (setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))
  (setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
        ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
        (t nil)) ;_ end of cond
  (princ "\n Величина смещения <")(princ *OFF2*)(princ ">: ")
  (initget 6)
  (if     (null (setq d (getdist)))
    (setq d *OFF2*))
  (setq *OFF2* d
    d (/ d 2.0)
    undo 0
    Flag t)
  (princ "Введено значение: <") (princ *OFF2*) (princ "> Смещение в обе стороны по: <") (princ *OFF2*) (princ "/2=") (princ d) (princ ">")
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")(if (not (zerop undo))(progn
           (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((vlax-method-applicable-p ent 'Offset)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
     (vla-offset ent d)(vla-offset ent (- 0  d)))
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF/2")

Кстати, в любом случае, после указки расстояния неплохо было бы показывать какое значение ввел пользователь.

  • Yuriy
  • Yuriy
  • Активный участник
  • Откуда: Санкт-Петербург
  • На форуме с 20 декабря 2007г.
  • Сообщений: 1,503
  • Спасибо: 18

Re: LISP. Подобие в обе стороны

> VVA
*** 2. ИМХО сомнительно. Лучше исходный объект выставить с нужными свойствами, а потом офсетить ***
достаточно часто подобные копии нужно иметь на другом слое. Например вначале создаются оси а затем получаются дороги(для генплана), стены(для архитектуры) и т.п.
Ведь утомительно будет выбирать объекты подобия для переноса на нужный слой.
А если переносить то сделать это последней операцией программы. Тогда первая отмена вернет слои ну а вторая все действие программы.
Тогда и дополнительной опции не надо.
Вместо переноса на текущий слой, то можно было-бы подсветить все полученные копии по завершении мульти-офсета (если вы примете первый пункт), а далее потребуется всего лишь одно действие для переноса подсвеченных объектов на новый слой.
*** 4. Все бы хорошо, если бы не одно но... Если контур состоял их линий, то при подобии "наружу" между вершинами будут разрывы, а при подобии "внутрь" — пересечения. PEDIT такое не возьмет. Опять, на мой взгляд, лучше объеднить исходные линии. ***
перед тем как применить программу исходные объекты будут подготовлены должным образом.
а запрос программы
***  Выберите объект [Выход] <выход>: ***
мог-бы выглядеть сл. образом
режим - объединять / Выберите объекты <смена метода> :
при нажатии на Enter запрос меняется на
режим - не объединять / Выберите объекты <смена метода> :
ну или как нибудь по другому.
5.
А иногда требуется уменьшить или увеличить множество замкнутых контуров
Это наверное тоже с применением команды offset
но наверное,уже в другой программе.
А ведь могла бы бать серия программ расширяющая возможности обычной команды offset?

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: LISP. Подобие в обе стороны

> Yuriy
Например вначале создаются оси а затем получаются дороги(для генплана), стены(для архитектуры) и т.п
Мне тоже довольно часто приходится разбрасывать оси на две стороны, а затем менять слой у полученных таким образом копий.
Поддерживаю Yuriy в том, что такая опция как автоматический (или по настойке) перенос "подобных" линий на активный слой может быть полезна.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Вариант с настройкой переноса "подобных" объектов на текущий слой.
В запрос смещения добавлены опции:
    Объект - "подобные" объекты наследуют слой родителя
    Текущий - "подобные" объекты переносятся на текущий слой
Значение сохраняется в сеансе работы в глобальной переменной *OFFLAY*

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))(setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (setq d nil)
  (while (not (numberp d))
     (princ (strcat "\n (Слой: " (if *OFFLAY* "Текущий)" "Объект)")
     " Величина смещения или слой объектов [Объект/Текущий] <"))
     (princ *OFF2*)(princ ">: ")
     (initget 6 "Текущий Объект Current Object _Current Object Current Object")
     (if (null (setq d (getdist))) (setq d *OFF2*))
     (cond ((= d "Object")(setq *OFFLAY* nil)) ;_Слой объекта
           ((= d "Current")(setq *OFFLAY* t)) ;_Слой текущий
           (t nil)
     )
    )
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")(if (not (zerop undo))(progn
           (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((vlax-method-applicable-p ent 'Offset)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
      (setq obj (append (vlax-safearray->list(vlax-variant-value (vla-offset ent d)))
                      (vlax-safearray->list(vlax-variant-value (vla-offset ent (- 0  d))))))
      (if *OFFLAY* (mapcar '(lambda(x)(vla-put-layer x (getvar "CLAYER"))) obj))
      )
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")
(vlax-safearray->list(vlax-variant-value (vla-offset ent d)))

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: LISP. Подобие в обе стороны

Ну и вдогонку вариант с возможностью удаления исходных объектов

(defun C:OFF2 (/ d obj ent adoc *error* undo lays Flag DelObjList)
  (defun *error* (msg)(vla-EndUndoMark adoc))
  (vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
  lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST"))))
  (if (zerop *OFF2*)(setq *OFF2* 1))(setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
    ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
    (t nil)) ;_ end of cond
  (setq d nil)
  (while (not (numberp d))
     (princ (strcat "\n (Слой: " (if *OFFLAY* "Текущий)" "Объект)")
     " Величина смещения или слой объектов [Объект/Текущий] <"))
     (princ *OFF2*)(princ ">: ")
     (initget 6 "Текущий Объект Current Object _Current Object Current Object")
     (if (null (setq d (getdist))) (setq d *OFF2*))
     (cond ((= d "Object")(setq *OFFLAY* nil)) ;_Слой объекта
           ((= d "Current")(setq *OFFLAY* t)) ;_Слой текущий
           (t nil)
     )
    )
  (setq  *OFF2* d undo 0 Flag t)
  (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit")
  (while Flag
    (setq obj (entsel (strcat "\n Выберите объект ["
           (if (not (zerop undo)) "Отмени/" "")
           "Выход] <выход>: ")))
    (cond ((= obj "Undo")(if (not (zerop undo))(progn
           (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
    ((= obj "Exit")(setq Flag nil))
    ((null obj)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***")))
    (t (setq ent (vlax-ename->vla-object (car obj)))
     (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
      (alert "На блокированном слое!"))
     ((vlax-method-applicable-p ent 'Offset)(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
      (setq obj (append (vlax-safearray->list(vlax-variant-value (vla-offset ent d)))
                      (vlax-safearray->list(vlax-variant-value (vla-offset ent (- 0  d))))))
      (if *OFFLAY* (mapcar '(lambda(x)(vla-put-layer x (getvar "CLAYER"))) obj))
      (setq DelObjList (cons ent DelObjList))
      )
     (t (alert "Не удается создать объект, подобный данному")))))
   (initget "Undo Отмени Г J Exit Выход У D _Undo Undo Undo Undo Exit Exit Exit Exit"))
   (initget "Да Нет Yes No _Yes No Yes No")
  (if (= (getkword "\nУдалять объекты? [Да/Нет] <Нет> : ") "Yes")
         (mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) DelObjList))
 (vla-EndUndoMark adoc)(princ))
(princ "\nНаберите в командной строке OFF2")
(vlax-safearray->list(vlax-variant-value (vla-offset ent d)))

  • Yuriy
  • Yuriy
  • Активный участник
  • Откуда: Санкт-Петербург
  • На форуме с 20 декабря 2007г.
  • Сообщений: 1,503
  • Спасибо: 18

Re: LISP. Подобие в обе стороны

> VVA
Попробовал. Все работает. Спасибо.
Но для полного счастья нехватает возможности выбирать не по одному а сразу несколько.
Впервые заметил, что опции автоматически попадают в контекстное меню.

  • Dextron3
  • Восстановленный участник
  • На форуме с 21 июня 2007г.
  • Сообщений: 27
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

Command:
Command:
Command: _appload OFF2.LSP successfully loaded.
Command:
Наберите в командной строке OFF2; error: bad argument type: VLA-OBJECT nil
Вроде работает а ошибку выдает?

  • Dextron3
  • Восстановленный участник
  • На форуме с 21 июня 2007г.
  • Сообщений: 27
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

А можно эти функции прикрутить к лиспу MOFF?

  • Yuriy
  • Yuriy
  • Активный участник
  • Откуда: Санкт-Петербург
  • На форуме с 20 декабря 2007г.
  • Сообщений: 1,503
  • Спасибо: 18

Re: LISP. Подобие в обе стороны

> Dextron3
А можно ссылочку ни MOFF.
Что то поиск подвисает.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: LISP. Подобие в обе стороны

(vl-load-com)

вколоти

  • Dextron3
  • Восстановленный участник
  • На форуме с 21 июня 2007г.
  • Сообщений: 27
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

> Yuriy
это не в этом форуме, а в форуме ДВЖ.РУ

  • Dextron3
  • Восстановленный участник
  • На форуме с 21 июня 2007г.
  • Сообщений: 27
  • Спасибо: 0

Re: LISP. Подобие в обе стороны

> Кулик Алексей aka kpblc
, а как в этом форуме смотреть новые сообщения в темах в которых оставиль коменты