[MrBrown]

Здравствуйте!
Отрисовываю защитные зоны электрокабелей. Много зон. Прошу помочь в автоматизации.
Электрокабели в модели - это всё обычные ломаные полилинии на одном уровне (Z=0). Редко вместо какой-нибудь вершины - дуга.
Хотелось бы получить макрос с таким алгоритмом:

В ком.строке ввожу название макроса, например "ZZ" (защитная зона); Или придумайте своё название, я не против.
макрос приглашает указать расстояние смещения;
Я ввожу в ком.строке нужное расстояние, жму ENTER;
макрос приглашает выбрать объект или несколько (чтобы можно было выбирать отдельными тыками или рамкой);
Если объекты уже выбраны до включения макроса, то он автоматически начинает работать, а именно:
1. создает автоматически слой "ZZ", если он ещё не создан. Все вновь созданные линии должны быть в этом слое. Параметры слоя: толщина линий - по умолчанию, стиль - сплошная линия, цвет линий - красный.
2. проводит OFFSET от выбранной (исходной) полилинии в обе стороны, соединяя концы вновь созданных полилиний, чтобы получилась замкнутая площадь (как частный случай, от прямой полилинии получится прямоугольник, середины противоположных коротких сторон которого касаются концов исходной полилинии).
3. удаляет исходную центральную полилинию.
В приложенном файле, думаю, всё понятно.

Если перед работой макрос отключает настройки (привязки и прочее), в конце работы (по нажатию ESC) обратно включает.

Прошу мастеров ЛИСПа помочь.
Спасибо.
p.s. AutoCAD-2010, 2011 RUS
p.p.s макросов "OFFSET" на форуме много, но, я просмотрел, меня не устраивают.

[Do$]

Сообщение от MrBrown Или придумайте своё название, я не против.

Ай какой добрый человек
Ну ладно, хоть слово "Прошу" написал, а то бывает, что и этого не пишут...

[gomer]

GAME OVER, что в переводе звучит как "время гардемаринов прошло"! К слову, "придумать" стоит гораздо больше, чем научить, сделать, и, тем более, помочь.

[Олег (jr.)]

Спробуй, набросал на скорую руку, проверять нет времени

Код:

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

(defun C:ZZ(/ *error* layer_set  acsp adoc clay en line1 line2 obj obj1 obj2 ofdist sset ssunion x)
(defun *error* (msg)
  (if clay (setvar "clayer" clay))
    (if adoc
      (vla-endundomark adoc)
    )
    (cond ((not msg)) 
          ((member msg '("Function cancelled" "quit / exit abort")))
          ((princ (strcat "\n** Error: " msg " ** ")))
    )
   (command "_layerp")
    (princ)
  )
  (defun layer_set (lyr col ltp)
  (setvar "cmdecho" 0)  
  (if (tblsearch "layer" lyr)
  (command "_-layer" "_t" lyr "_u" lyr "_on" lyr  "_s" lyr "")
  (command "_-layer" "_m" lyr "_c" col lyr "_lt" ltp lyr ""))
  )

  
       (vla-startundomark(setq adoc (vla-get-activedocument
			(vlax-get-acad-object))))
       (setq acsp (vla-get-block
		    (vla-get-activelayout
		      adoc)))
  
  (setq clay (getvar "clayer"))
  (layer_set "ZZ" "1" "Continuous")
  (setvar "peditaccept" 1)
       (setq ofdist (getreal "\nOffset distance: "))
       (princ "\nSelect single polyline: ")
      (while
       (setq sset (ssget "_:S:L" '((0 . "lwpolyline")(70 . 0))))
       (progn
       (setq en (ssname sset 0))
      (setq obj (vlax-ename->vla-object en))
       (setq obj1 (car (vl-catch-all-apply 'vlax-invoke (list obj 'offset ofdist))))
       (setq obj2 (car (vl-catch-all-apply 'vlax-invoke (list obj 'offset (* -1. ofdist)))))
      
       (setq line1 (vlax-invoke acsp 'addline (vlax-curve-getstartpoint obj1)(vlax-curve-getstartpoint obj2)) )
       (setq line2 (vlax-invoke acsp 'addline (vlax-curve-getendpoint obj1)(vlax-curve-getendpoint obj2)) )
      (setq ssunion (ssadd))
       (mapcar '(lambda (x)(ssadd x ssunion))(mapcar 'vlax-vla-object->ename (list obj1 obj2 line1 line2)))
       (command "_pedit" "_M" ssunion "" "_Join" 0.0 "_Width" 0.0 "")
       (command "_chprop" "_L" "" "_LA" "ZZ" "_Color" "1" "")
       (vl-catch-all-apply 'vlax-invoke (list obj 'delete))
       ;(command)
       )
       )
  (*error* nil)
(princ)
  )
(or (vl-load-com)(princ))

[Малявка]

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

[MrBrown]

Олег (jr.), спасибо за единственный адекватный отклик. К сожалению, макрос запрашивает с десяток опций по слою и всё. Это только усложняет работу. Хотелось бы, чтобы макрос молча проверял существование слоя ZZ и, если такого не встречал в файле, создавал бы его с опциями по умолчанию. А перекрасить потом все примитивы слоя - это я ручками сделаю, быстрым выбором.
Ну и главное, чего нет пока - чтобы макрос запрашивал расстояние как в команде OFFSET, создавал бы две линии по обе стороны исходной, соединил бы их концы короткими отрезками и выполнил бы команду JOINT, объединив полилинии в одну замкнутую. А потом удалил бы исходную полилинию.
gomer, Do$, Offtop: я знаю и уважаю ваше мастерство в программировании и не только: почитываю форум, вижу кто чего стóит. Пользуюсь не одним десятком макросов с DWG.RU, некоторые, безусловно, написаны и вами. Тем грустнее читать ваши отписки, граничащие с оффтопом.
"Прошу мастеров ЛИСПа помочь", написал я в вопросе. Это означает, что мне нравится этот сайт, я привык к форуму, где, уверен, мне всегда помогут, практически решат за меня мою проблему по причине полного незнания ЛИСПа. Вам недостаточно этой просьбы о помощи? Ну, научите меня, 54-летнего инженера, как правильно "расшаркиваться" перед вами, буду признателен.
p.s. Уж если и уважаемый мною kpЬlc, отзовётся в том же духе, придётся сделать вывод, что форум серьёзно заболел звёздной болезнью.
p.p.s Вполне могу понять и тот факт, что ваши ответы были написаны под влиянием эмоций, вызванных кем-то из предыдущих посетителей "с претензиями". В этом случае - примите мои извинения за всё, сказанное в оффтопе.

[hexD]

MrBroun...u are Broun!!! Вам решение на 95 % дали! Имейте совесть!

[MrBrown]

hexD, Вспомнил юмориста: "Чуть-чуть ушла жена. Слегка умерла тёща"
Прошу понять, что я и один процент на ЛИСПе не осилю, не то, что оставшиеся пять, увы.
А макросы, они ведь создаются для облегчения, а не затруднения работы. А с "незаточенным" как нужно макросом будет ещё тот гемор. Поэтому и прошу, если есть возможность, время, силы - помогите, создайте полнофункциональную вещь, от которой я был бы без ума от счастья и на вопрос "Где взял?" гордо показывал пальцем на аббревиатуру DWG.RU.
p.s. Напомню, я озаглавил вопрос - "для частного случая". ПОэтому не нужно много лишних настроек, пригодных для общих решений.
Спасибо.

[Дима_]

Сообщение от MrBrown ...почитываю форум, вижу кто чего стóит... Вам недостаточно этой просьбы о помощи? Ну, научите меня, 54-летнего инженера, как правильно "расшаркиваться" перед вами, буду признателен.

Я, тоже, выражась Вашим языком почитываю форум. Уверяю Вас форум ничуть не зазвездился, просто люди устали (и я в том числе) от регулярных "односторонних" просьб и "решить за них их проблему". Вы, если я правильно сделал вывод из указания возраста вкупе с профессией, инженер с большим стажем - так не уж-то с 2009 года (даты Вашей регистрации) Вам сказать (выложить) нечего было, на сайт который Вам нравится? А критиковать, что мол форум уже не тот - вот это действительно "стало модным". Просто "разнюхали" что здесь "дурачков" много - им мол задание давай - они напишут. Посмотрите старые темы - да они дружно решались, но это в большинстве своем "общие", а не частные (под меня) вопросы - которые в большинстве своем уже разобранны (и как результат 2 из 3 тем заканчиваються на отсылки в поиск), и самое главное - люди САМИ старались сделать все возможное (по мере сил и знаний) для их решения, а не отписывались - мол я в этом ни шиша не понимаю - но мне надо. Никому Ваши "расшаркивания" здесь не нужны, внесите свой вклад из того что знаете и умеете - у Вас от решений отбоя не будет. Помочь хорошему человеку - душа сама просыпается (я не к тому, что Вы плохой, но суть думаю понятна).

[Олег (jr.)]

Сообщение от MrBrown Олег (jr.), спасибо за единственный адекватный отклик.

У меня нет русского Автокада, попробуй удалить все точки перед знаком подчеркивания
в командах, работает на 2010 и 2014 (без лишних вопросов), выбор по одной полилинии,
на правый клик или Энтер все заканчивается

[MrBrown]

Олег (jr.), удалил, всё равно не фурычит.
Ладно, завтра на работе проверю. Возможно, на работе будет работать
(на работе - работать. Масло масляное )

[Олег (jr.)]

Файл удален, см. ниже

[MrBrown]

Олег (jr.), Почти работает.
короткие отрезки на слое ZZ, а длинные - остались на прежнем слое. И не замкнуты.
Можно убрать из ком. строки это:
Преобразовать отрезки и дуги в полилинии [Да/Нет]? <Д>
и это:
Задайте опцию [Замкнуть/Разомкнуть/Добавить/Ширина/СГладить/СПлайн/Убрать
сглаживание/Типлин/Отменить]:
Надо просто выполнить JOINT, чтобы получившийся замкнутый контур был на слое ZZ.
p.s. Обнаружил, что несколько полилиний не выбираются рамкой. Выбираются тольько по одной.
Ну и надо удалить центральную полилинию в конце работы макроса.

[Олег (jr.)]

Нашел косяк, пробуй еще
Peditaccept должен быть = 1

[MrBrown]

Олег (jr.), без изменений.

[Олег (jr.)]

Ничего не понимаю:

[MrBrown]

Олег (jr.), Есть! Работает!
Так, как надо! Почему-то результирующий контур выполнен толстой полилинией, не по умолчанию.
Ну, это легко исправляется быстрым выбором.
Спасибо!
p.s. а нельзя добавить выделение нескольких объектов рамкой? А то выбор - по одному только.
И чтобы введенное расстояние запоминалось, чтобы не приходилось каждый раз его заново вводить.

[Олег (jr.)]

Завтра посмотрю, извини
Чтобы тонкой линией поменяй 30.0 на 0.0,
сам найдешь где, пока

[MrBrown]

Олег (jr.), Уже поменял. Спокойной ночи.

[Олег (jr.)]

Для множественного выбора: