Проникающая гидроизоляция бетона
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

Новые команды для работы с полилинией

Ответ
Поиск в этой теме
Непрочитано 14.09.2006, 13:30 3 | #1
Новые команды для работы с полилинией
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,795

Данный набор программ является коллективным продуктом участников форумов autocad.ru и dwg.ru с моими доработками.
Захотелось собрать все программы для работы с полилиниями воедино и оформить как полагается.

=========== Доступные команды PLTOOLS=================
Редакция 17.06.2014
PL-JOIN -Объединение выбранных полилиний
PL-VFI -вставка вершин в выбранной полилинии в местах пересечения с
указанными полилиниями, линиями, дугами
PL-JOIN3D -Объединение 3D полилиний
PL-A2L -Замена линейного сегмента в полилинии дуговым сегментом.
PL-L2A -Замена дугового сегмента в полилинии линейным сегментом.
PL-DIV -Разбивает выбранный сегмент полилинии на указанное количество
сегментов или через указанное расстояние
PL-DIVAll -Разбивает все сегменты полилинии на указанное количество
сегментов или через указанное расстояние
PL-VxAdd -Добавляет новую вершину к полилинии
ENTREVS -Реверс объекта
ENTREV -Реверс объектов (множественный выбор)
PL-CW -Реверс выбранных полилиний по часовой стрелке
PL-CCW -Реверс выбранных полилиний против часовой стрелки
PL-VxRdc -Удаление вершин полилиний, которые лежат на одной прямой
PL-VxDel -Удаление выбранной вершины
pl-VxOpt -Удаление совпадающих вершин из полилинии
PL-NoArc -Аппроксимация дуговых сегментов полилинии
PL-Clone -Построение полилинии путем копирования ее сегментов
PL-VxMove -Перемещение вершин полилинии
PL-Vx1 -Изменение начала полилинии
ConvTo2d -Преобразование линейных объектов в 2D полилинии
ConvTo3d -Преобразование линейных объектов в 3D полилинии
MPL -Построение средней линии Более продвинутая версия Rollin_Ball.lsp Find MidBoundary between two polylines.
R3P -Прямоугольгик по 3-м точкам
PL-P90 -Рисование перпендикулярных друг к другу сегментов полилинии
PL-CSE -Объединение 2d полилиний по примитиву
PL-SgWidth -Изменить ширину сегмента полилинии

Реверс дуговых сегментов полилинии из #79
На дуговых сегментах полилинии тип линий может быть "вверх тормашками", причем реверс не помогает. Этот артефакт можно побороть, если в полилинии включить "генерацию типа линий".

Панели, лисп и инструкции здесь http://dwg.ru/dnl/607
Обсуждаем, критикуем, предлагаем

Миниатюры
Нажмите на изображение для увеличения
Название: plrevers.jpg
Просмотров: 8538
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 20.07.2015 в 19:42. Причина: Реверс дуговых сегментов полилинии
Просмотров: 283458
 
Непрочитано 14.09.2006, 13:42
#2
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Щас посмотрим.
Profan вне форума  
 
Непрочитано 14.09.2006, 14:13
#3
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Маленькое уточнение.
Можно было бы написать в благодарностях
Владимир Громов aka Profan.
Profan вне форума  
 
Автор темы   Непрочитано 14.09.2006, 14:22
#4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Не знал, исправлю.
VVA вне форума  
 
Непрочитано 14.09.2006, 14:53
#5
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Замечания к программам (командам).

"Добавить новую вершину в полилинию."
Не обрабатывается нажатие правой кнопки мыши. В программе предполагается, что новую вершину мы куда-то переместим мышью. но если нам не надо перемещать вершину, а подтвердить уже указанную точку, то напрашивается нажатие правой кнопки мыши и вот тут программа срывается. По-моему, kpblc дорабатывал эту программу.

"Удалить вершину полилинии".
Результат может оказаться непредсказуемым, если удаляется вершина между линейным и дуговым сегментами. В зависимости от направления полилинии вместе с вершиной удаляется или дуговой или линейный сегмент.

"Аппроксимация дуговых сегментов линейными".
В русской версии не работает контекстное меню.
Profan вне форума  
 
Непрочитано 14.09.2006, 14:59
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Дорабатывал, но не добил. Stretch все равно слетает черт-те куда. Там на оригинальном адресе, по-моему, Евгений Елпанов показывал обработку. Его вариант, насколько мне помнится, работал более устойчиво.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.09.2006, 16:22
#7
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
"Добавить новую вершину в полилинию."
Не обрабатывается нажатие правой кнопки мыши
"Аппроксимация дуговых сегментов линейными".
В русской версии не работает контекстное меню.
Исправлено грузить с VVA №1

Цитата:
"Удалить вершину полилинии".
Результат может оказаться непредсказуемым
По моему очевидно. Если до удаляемой вершины был дуговой сегмент, а после удаляемой линейный, то новый сохранит кривизну и наоборот.
Другое дело, что тот кто удаляет вершину должен отдавать себе отчет как направлена полилиния. Но как помочь ему в этом [sm2100] >kpblc В результате плотного общения с Лентяем, доработавшего код Евгения Елпанова, удалось добиться главного: избавиться от _break (полилинии не теряют ассоциативность). В этой версии вершины добавляются без _strech (там основная сложность была в пересчете bulge), что на мой взгляд более корректно.

Последний раз редактировалось VVA, 19.09.2015 в 20:42.
VVA вне форума  
 
Непрочитано 18.09.2006, 16:20
#8
Юрий Water Jet

Гидрорезка
 
Регистрация: 18.09.2006
г Владимир
Сообщений: 2


"Аппроксимация дуговых сегментов линейными".

Как сделать следующее:
Есть полилиния состоящая из нескольких прямых и дуг с разными радиусами до 500 мм и более 500 мм.
Надо аппроксимировать дуги с радиусом более 500 мм с отклонением 0.1 мм.
__________________
Гидро абразивная резка waterjet 4000 Атм
Юрий Water Jet вне форума  
 
Автор темы   Непрочитано 18.09.2006, 16:37
#9
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Я бы сделал так:
1. _break в точке ->Выделить дуговые сегменты с радиусом более 500 мм в отдельные полилинии (вариант: скопировать полилинию и обрезать)
2. Аппроксимировать их с отклонением 0.1 (имеется ввиду предельное отклонение хорды, т.е. высота стрелки дуги)
3. PL-JOIN собрать все обратно в полилинию
4. При необходимости ENTREVS задать нужный порядок обхода
VVA вне форума  
 
Непрочитано 18.09.2006, 18:01
#10
Юрий Water Jet

Гидрорезка
 
Регистрация: 18.09.2006
г Владимир
Сообщений: 2


Так и делаю, но это очень долго. Уходят часы и дни на обработку нескольких полилиний.
Хотелось бы автоматически.
Задать радиус дуги болше которого полилиния должна обрабатываться и отклонение.
__________________
Гидро абразивная резка waterjet 4000 Атм
Юрий Water Jet вне форума  
 
Автор темы   Непрочитано 18.09.2006, 19:37
#11
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Юрий Water Jet Сделал, пробуй по ссылке с поста №1
VVA вне форума  
 
Непрочитано 19.09.2006, 08:20
#12
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Решил тоже добавить код в копилку...
Программа аппроксимирует дуговые сегменты полилинии по заданной высоте, т.е я использую подобный код для генерации векторной картинки полилинии в диалоговых окнах, задавая максимальную высоту в один пиксел.
Предложенная программа только пример, никакой оптимизации...
Я ее наспех выдернул из другого кода и слегка адаптировал для форума...

Код:
[Выделить все]
(defun c:lw-apr (/ A A1 E H I L LST P R)
  ;;  ElpanovEvgeniy, Russia, Moscow, 2006
  ;;  Example of creation of a polyline with the аррrоximаted arc segments
  ;; (c:lw-apr)
  (if (and (setq e (car (entsel)))
           (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
           (setq h (getdist "\nУкажите максимальную высоту аппроксимируемой дуги. "))
      ) ;_  and
    (progn
      (setq p   0
            lst (list (vlax-curve-getStartPoint e))
      ) ;_  setq
      (repeat (- (cdr (assoc 90 (entget e))) (abs (1- (cdr (assoc 70 (entget e))))))
        (if (setq r (vlax-curve-getSecondDeriv e p))
          (if (equal r '(0 0 0) 1e-8)
            (setq lst (cons (vlax-curve-getPointAtParam e p) lst)
                  p   (1+ p)
            ) ;_  setq
            (progn
              (setq r  (distance '(0 0) (vlax-curve-getFirstDeriv e p))
                    p  (1+ p)
                    i  (/ (- r h) r)
                    l  (* r (atan (sqrt (abs (- 1. (* i i)))) i) 2)
                    a1 (vlax-curve-getDistAtParam e p)
                    a  (vlax-curve-getDistAtParam e (1- p))
                    l  (/ (- a1 a) (1+ (fix (/ (- a1 a) l))))
              ) ;_  setq
              (while (and (< a a1) (not (equal a a1 1e-8)))
                (setq lst (cons (vlax-curve-getPointAtDist e a) lst)
                      a   (+ a l)
                ) ;_  setq
              ) ;_  while
            ) ;_  progn
          ) ;_  if
          (setq p (1+ p))
        ) ;_  if
      ) ;_  repeat
      (entmakex
        (append
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            (cons 90 (length lst))
            (assoc 70 (entget e))
          ) ;_  list
          (mapcar
            (function
              (lambda (x)
                (cons 10 x)
              ) ;_  lambda
            ) ;_  function
            lst
          ) ;_  mapcar
        ) ;_  append
      ) ;_  entmakex
    ) ;_  progn
  ) ;_  if
)
Елпанов Евгений вне форума  
 
Непрочитано 19.09.2006, 12:02
#13
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


посмотрел понравилось, но я думаю что стоит добавит еще 1 команду
или чуть-чуть изменить существующую-

PL-DIV -Разбивает выбранный сегмент полилинии на указанное количество сегментов или через указанное расстояние


что бы можно было делить не только один сегмент но и всу полилинию вместе, с сохранением текущих вершин

А програмка супер

молодцы
ilka_t вне форума  
 
Автор темы   Непрочитано 20.09.2006, 19:22
#14
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Добавлена новая команда
PL-DIVALL -Разбивает все сегменты полилинии на указанное количество сегментов или через указанное расстояние
VVA вне форума  
 
Непрочитано 21.09.2006, 09:38 Re: Новые команды для работы с полилинией
#15
Inner

Инженер-конструктор, магистр СПбГПУ.
 
Регистрация: 27.11.2005
Санкт-Петербург
Сообщений: 78
<phrase 1=


Цитата:
Сообщение от VVA

PL-JOIN -Объединение полилиний чохом
Мы на эту команду теперь дружно молимся двумя проектными отделами двух контор. Спасибо огромное. Высочайший респект.
__________________
Начинаю писать магистерскую диссертацию на тему нелинейных методов совместных расчетов оснований и фундаментов. Буду рад любой помощи со стороны профессионалов.
Inner вне форума  
 
Непрочитано 22.09.2006, 10:28
#16
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,873


Спасибо за замечательный набор программ!
Может быть уважаемым авторам не составит труда добавить программку, которая бы по одиночному клику на полилинии строила бы фаску и скругление смежных сегментов, ближайших к точке выбора.
Nike вне форума  
 
Непрочитано 22.09.2006, 10:37
#17
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для Nike.
Аналогичная тема:
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=29880Df
Profan вне форума  
 
Непрочитано 22.09.2006, 12:01
#18
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,760


А как сделать реверс дуговых сегментов?
Как ни крути тип линии в одну сторону направлен.
AutoCAD2007
[ATTACH]1158912159.gif[/ATTACH]
Krieger вне форума  
 
Непрочитано 22.09.2006, 12:03
#19
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Это не сделать, наколько я помню, вообще никак. Только если изготовить новый тип линии и его назначать на полилинию
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.09.2006, 00:44
#20
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,453


Спасибо огромное всем программистам за огромный труд!
2VVA
Цитата:
(полилинии не теряют ассоциативность)
Если вас не затруднит разъясните пожалуйста что здесь имелось ввиду?
Sleekka вне форума  
 
Непрочитано 24.09.2006, 17:32
#21
AleX

CNC
 
Регистрация: 28.08.2003
Belarus
Сообщений: 47


Наверно более актуально преобразование SPLINE в 2D_POLYLINE.Как-то начинал, но результата так и нет.
AleX вне форума  
 
Автор темы   Непрочитано 25.09.2006, 10:08
#22
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Krieger №18 Версия Автокада тут ни при чем. Отрисуй две зеркальные дуги и увидишь, что типом линии они покрываются одинаково. Такое ощущение, что при встрече дуги (дугового сегмента) по алгоритму заново рассчитываются начало/конец дуги, причем справа-налево и против часовой. Мы у себя для этих целей имеем типы линий - перевертыши.
>AleXПочему именно в 2D_POLYLINE? Управляющие точки могум иметь различные координаты Z. Тут наверное только 3d polyline.
>Sleekka
Ассоциативновть полилинии, это когда она задает контур каким-либо другим примитивам. Я знаю два: штриховка и видовой экран. Причем ассоциативность штриховки иногда слетает. Т.к. в своей работе часто пользуюсь подрезанными видовыми экранами, то особо хочу подчеркнуть, что если в PL-VxAdd будет указан видовой экран, то он подрежется полилинией. Получается 2 в 1: подрезаем В.Э. и указываем новую конфигурацию, чем я особо доволен.
[ATTACH]1159164515.jpg[/ATTACH]
VVA вне форума  
 
Непрочитано 25.09.2006, 21:32
#23
AleX

CNC
 
Регистрация: 28.08.2003
Belarus
Сообщений: 47


>VVA
"Почему именно в 2D_POLYLINE? Управляющие точки могум иметь различные координаты Z. Тут наверное только 3d polyline."

По двум причинам:
1. в 2D_POLYLINE конечно же 2-х мерный SPLINE. Задачка уж больно интересная.
Преобразование в 2D_POLYLINE позволяет уменьшить количество точек ее определяющих, что может быть полезным, например при написании управляющих программ станков с ЧПУ. Что-то вроде имеющейся возможности определить элипс участками полилинии.
2. В 3d polyline полилинию через точки наверно банально и просто. Поискав по форумам можно найти почти готовые решения.
AleX вне форума  
 
Непрочитано 26.09.2006, 14:30
#24
luser


 
Регистрация: 20.04.2006
Сообщений: 67


vva.
спасибо огромное за ваш труд, очень облгечает рутинные операции.
пожелание можна ли дополнить функциями копирования сегментов,
т.е по указанным пользователем сегментам pline создавался новый
объект-копия включающий в себя только указанные сегменты.
еще раз спасибо.
luser вне форума  
 
Автор темы   Непрочитано 26.09.2006, 15:42
#25
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>AleX
Цитата:
Преобразование в 2D_POLYLINE позволяет уменьшить количество точек ее определяющих, что может быть полезным, например при написании управляющих программ станков с ЧПУ
Я не знаю другого математического решения кроме как апроксимация 2d/3d линейными сегментами заданной длины. Даже здесь это делают так (и за деньги).
Цитата:
Что-то вроде имеющейся возможности определить элипс участками полилинии.
А про системную переменную PELLIPSE знаешь?
Цитата:
В 3d polyline полилинию через точки наверно банально и просто
А зачем искать трудности? :wink:
>luser Сейсас готовится обновление с найденными багами KAI, попробую учесть и твое предложение.
VVA вне форума  
 
Непрочитано 26.09.2006, 15:50
#26
luser


 
Регистрация: 20.04.2006
Сообщений: 67


VVA.
спасибо, ждем новых версий.
luser вне форума  
 
Непрочитано 28.09.2006, 23:21
#27
AleX

CNC
 
Регистрация: 28.08.2003
Belarus
Сообщений: 47


Цитата:
А про системную переменную PELLIPSE знаешь?
Обижаешь.
AleX вне форума  
 
Непрочитано 29.09.2006, 12:26
#28
ilka_t


 
Регистрация: 20.01.2004
Москва
Сообщений: 154


А можно сделать удаление совподающих вершин не толко для одной полилинии но и для группы, что бы не по одной выделять
ilka_t вне форума  
 
Автор темы   Непрочитано 29.09.2006, 16:10
#29
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Выложены новые обновления от 29.09.2006
1. Добавлена новая команда
PL-CLONE - Из указанных пользователем сегментов полилинии создавается новая полилиния
2.В замене линейного сегмента в полилинии дуговым сегментом предусмотрена опция задания радиуса
радиус может быть положительным и отрицательным (влияет на
направление дуги)
3. PL-A2L и PL-L2A подружились с UCS
4. Удаление совпадающих вершин полилинии (PL-VxOpt) работает с группой объектов, а не по одной
VVA вне форума  
 
Непрочитано 11.10.2006, 13:31
#30
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 97


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

(defun C:con_ed (/ object object2)
(defun obrabotka ()
(if (> vert_no1 vert_no2)
(while do_next
(if (setq
new_pt (getpoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
vname
'Coordinate
(if (= begin_vert 0)
0
(- begin_vert 1)
)
)
)
)
"\nСледующая вершина"
)
)
(progn
(setq
new_pos (vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 1))
(vl-remove (last new_pt) new_pt)
)
)
(vla-put-Coordinate vname begin_vert new_pos)


(if (<= (+ 1 begin_vert) (vlax-curve-getEndParam vname))
(setq begin_vert (+ 1 begin_vert))
(progn (exit)
(princ)
)
)
)
(setq do_next nil)
)
)

(while do_next
(if (setq
new_pt (getpoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property
vname
'Coordinate
begin_vert
)
)
)
"\nСледующая вершина"
)
)
(progn
(setq
new_pos (vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 1))
(vl-remove (last new_pt) new_pt)
)
)
(vla-put-Coordinate vname (- begin_vert 1) new_pos)


(if (> begin_vert 1)
(setq begin_vert (- begin_vert 1))
(progn (exit)
(princ)
)
)
)
(setq do_next nil)
)
)
)
(princ)
)
;;Main function;;
(setq object (entsel
"\nЩелкните по той части полилинии, которую собираетесь редактировать"
)
name (car object)
place (cadr object)
prlst (entget name)
)
(if (equal (cdr (assoc 0 prlst)) "LWPOLYLINE")
(progn
(setq
vname (vlax-ename->vla-object (car object))
dist1 (vlax-curve-getDistAtPoint
vname
(vlax-curve-getClosestPointTo
vname
(cadr object)
)
)
object2 (entsel
"\nА теперь щелкните вблизи от той вершины, с которой собираетесь начать"
)
name2 (car object2)
place2 (cadr object2)
vname2 (vlax-ename->vla-object (car object2))
dist2 (vlax-curve-getDistAtPoint
vname2
(vlax-curve-getClosestPointTo
vname2
(cadr object2)
)
)
vert_no1 (vlax-curve-getParamAtDist vname dist1)
vert_no2 (vlax-curve-getParamAtDist vname dist2)
begin_vert (if (< (fix vert_no2) 0.5)
(fix vert_no2)
(+ (fix vert_no2) 1)
)
do_next T
)
(if (eq name name2)
(obrabotka)
(progn
(alert
"Очень странно!\nСначала был указан другой объект.\nНе желаете ли подумать,\nчто же вы хотите делать?"
)
(princ)
)
)
)
(progn
(alert "С выбранным объектом\nв такие игры не играют")
(princ)
)
)
)
P_S вне форума  
 
Непрочитано 11.10.2006, 14:02
#31
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


А это что такое:
Код:
[Выделить все]
Команда: CON_ED

Щелкните по той части полилинии, которую собираетесь редактировать
А теперь щелкните вблизи от той вершины, с которой собираетесь начать
Следующая вершина
Следующая вершина
Следующая вершина
Следующая вершина
Следующая вершина; ошибка: Возникло исключение: 0xC0000005 (Нарушение доступа)
; предупреждение: раскрутка пропущена для неверное исключение

Команда:
Profan вне форума  
 
Автор темы   Непрочитано 11.10.2006, 17:24
#32
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


PL-VxMove - программа для редактирования вершин без таскания за ручки. Дополнительные ф-ции по ссылке с поста №1.
Будет включена в новое обновление. Интересуют замечания по интерфейсу.
Код:
[Выделить все]
(defun C:PL-VxMove ( / *error* next ent-pline pl Npt Ovx par vx lst)
(setq *error* pltool-err)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)) next t)
(setvar "CMDECHO" 0)
(vla-startundomark *kpblc-activedoc*)
(while next
  (if (setq ent-pline (entsel "\nУкажите изменяемую вершину полилинии <выход>: "))
  (if (and (lib:Is-object-modifed (car ent-pline) nil)
        (member (vla-get-ObjectName (setq pl (vlax-ename->vla-object (car ent-pline))))
                '("AcDb2dPolyline" "AcDbPolyline" "AcDb3dPolyline")))
    (progn
      	(setq Npt (osnap (cadr ent-pline) "_nea")
	      Npt (trans Npt 1 0)
	     par (vlax-curve-getParamAtPoint pl Npt)
	     par (fix (+ 0.5 par)) ;_Ближайшая вершина
    	     par (if (and (eq (vla-get-closed pl) :vlax-true)
		    (= par (vlax-curve-getEndParam pl))) 0 par)
	      Ovx (trans (vlax-curve-getPointAtParam pl par) 0 1))
      (initget "X")
      (while (/= "X" (setq Npt (getpoint Ovx (strcat "\nНовое положение вершины " (itoa (1+ par)) "[выход(X)] <оставить>:"))))
	(if Npt (progn
	(setq Npt (trans Npt 1 (car ent-pline))
	      par (if (and (eq (vla-get-closed pl) :vlax-true)
		    (= par (vlax-curve-getEndParam pl))) 0 par)
	      vx (lib:pline-get-verts pl)
	      vx (subst-i par (if (= (vla-get-ObjectName pl) "AcDbPolyline")
				(list (car Npt)(cadr Npt))
				Npt) vx)
	      lst (apply 'append vx))	  
      (vla-put-coordinates pl (vlax-make-variant (vlax-safearray-fill
	(vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lst)))) lst)))
	))
        (setq par (1+ par))
        (if (> par (vlax-curve-getEndParam pl))(setq par 0))
	(setq par (if (and (eq (vla-get-closed pl) :vlax-true)
		    (= par (vlax-curve-getEndParam pl))) 0 par))
	(setq Ovx (trans (vlax-curve-getPointAtParam pl par) 0 1))
	(initget "X")
	)
      )
    (princ "*** Объект на блокированном слое или не полилиния ***")
    )
    (setq next nil))
);_while
(princ))
Цитата:
Следующая вершина; ошибка: Возникло исключение: 0xC0000005 (Нарушение доступа)
; предупреждение: раскрутка пропущена для неверное исключение
Нельзя в полилинии (LW) обновлять одну вершину. Надо обновлять все координаты.Вот здесь с этим боролись.

Последний раз редактировалось VVA, 19.09.2015 в 20:46.
VVA вне форума  
 
Непрочитано 12.10.2006, 01:00
#33
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


По интерфейсу:
не мешало бы добавить опции "вперед" и "назад" (или как в Pedit, Prev/Next), а уж если и Undo на неверно введенную точку!

Кстати, после выхода из программы по Esc надо жать 3 раза на U, чтобы отменить действие команда (при нормальном выходе все OK), далее листинг действий:

Command: PL-VXMOVE

Укажите изменяемую вершину полилинии <выход>:
Новое положение вершины 2[выход(X)] <оставить>:
Новое положение вершины 3[выход(X)] <оставить>:
Новое положение вершины 4[выход(X)] <оставить>:*Cancel*

Команда прервана пользователем
Command: u
PL-VXMOVE
Command: u
GROUP
Command: u
GROUP
Command:
KAI вне форума  
 
Непрочитано 12.10.2006, 08:34
#34
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 31
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Прекрасный набор команд. Удобно оформлен. Хотя это не ново. В ToolPac это уже есть, да и не мешало бы посмотреть создателю, как реализовано это все в GeoniCS. Намного удобней.
Если возможно, то добавьте, пожалуйста, в функцию "добавления вершин в полилинию" возможность редактирования при включенных ручках, или подсвеченных вершин. А то добавляешь вершину, а рядом уже есть. Приходится корректировать.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 08:52
#35
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Насчет Toolpac'a я не знаю, может, он и стал бесплатным, но за GeoniCS (при условии всех его плюсов и минусов) платить приличные суммы лично я не согласный.
И потом, как-то нелогично получается - Toolpac удобнее, Geonics вообще заоблачные высоты, и тут же "добавьте то-то и то-то"...
---
P.S. Обязательно прочтите мою подпись!
---
Добавлено:
В GeoniCS масса вещей (если вообще не все) сделаны на ObjARX, а там ничего не посмотришь, кроме как на междумордие да результаты работы. И потом пытаться сделать на лиспе то же самое. у меня лично подобные трюки прокатывают далеко не всегда
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.10.2006, 10:11
#36
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 31
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Я совсем не хочу уменьшить значение твоей программы, но, некоторые моменты в Геониксе реализованы гораздо удобней. И если бы была возможность вытащить в Автокад из Геоникса набор команд по редактированию полилинии, то меня бы все устроило. Имелась в виду концепция решения.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 13:05
#37
MIP

инженер
 
Регистрация: 13.12.2004
Минск
Сообщений: 496


>>Игорь Богаченко
Цитата:
Я совсем не хочу уменьшить значение твоей программы, но, некоторые моменты в Геониксе реализованы гораздо удобней. И если бы была возможность вытащить в Автокад из Геоникса набор команд по редактированию полилинии, то меня бы все устроило. Имелась в виду концепция решения.
В GeoniCS многие вещи сделаны удобно, но реализовать некоторые приятные возможности на лисп просто не возмжно, а вот извлечь ARX библиотеки, без помощи разработчика врядли получиться и насколько я его знаю они пока это делать не собираются. Написать аналог можно, но кто этим займеться?
Поэтому пользуемся тем что есть! И низкий поклон VVA за собраную до кучки информацию и всем авторам любезно предоставленных программ.
MIP вне форума  
 
Автор темы   Непрочитано 12.10.2006, 13:48
#38
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Новый АВТОНОМНЫЙ вариант PL-VxMove с учетом замечаний KAI и Игорь Богаченко

Код:
[Выделить все]
(defun C:PL-VxMove ( / *error* next ent-pline pl Npt Ovx par vx lst undolst what str pdr nab)
  (defun DTR (a)(* pi (/ a 180.0)))
  (defun _vxgrdraw ( ptdraw color / ang pt11 pt12 pt21 pt22 len )
  (setq len (* 0.03 (getvar "VIEWSIZE"))
       ang 0
       pt11 (polar ptdraw (+ ang (dtr 225)) len)
       pt12 (polar ptdraw (+ ang (dtr 45)) len)
       pt21 (polar ptdraw (+ ang (dtr 315)) len)
       pt22 (polar ptdraw (+ ang (dtr 135)) len))
  (grvecs (list color pt11 pt12 pt21 pt22)))
(defun sbst-i (indel zn sps / buff i e1)
  (setq	i 0 buff nil) ;_ End of setq
  (foreach e1 sps (if (= i indel)
   (setq buff (append buff (list zn)))(setq buff (append buff (list e1))))
    (setq i (1+ i))) buff)
(defun *error* (msg)
  (princ "\nКоманда прервана пользователем")
  (while (> (getvar "CMDACTIVE") 0)(command))  
  (vla-endundomark *kpblc-activedoc*)
  (SSSETFIRST)(vl-cmdf "_.redrawall")(princ))
(defun Is-object-modifed (object param /) 
    (if (= (type object) 'ENAME)(setq object (vlax-ename->vla-object object)))
    (and (or param (setq param '"layer"))
      (vlax-property-available-p object param t)
         (vlax-property-available-p object "layer")
	 (eq (vla-get-Lock (vla-item (vla-get-Layers
	     (vla-get-activedocument(vlax-get-acad-object)))
             (vla-get-Layer object))) :vlax-false)))
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)
 (progn (setq ls nil)(repeat (/ (length lst) num)
    (repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
  (setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(defun pline-get-verts (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
      verts (cond((wcmatch (vlax-get pline_obj 'Objectname )
           "AcDb2dPolyline,AcDb3dPolyline")(group-by-num verts 3))
        ((eq (vlax-get pline_obj 'Objectname ) "AcDbPolyline")
         (group-by-num verts 2)) (T nil))))
(defun vecs_grdraw ( ptdraw ang color / pt1 pt2 )
  (setq pt1 (polar ptdraw (+ ang (dtr 135)) (* 0.05 (getvar "VIEWSIZE"))))
  (setq pt2 (polar ptdraw (+ ang (dtr 225)) (* 0.05 (getvar "VIEWSIZE"))))
  (grvecs (list color pt1 ptdraw ptdraw pt2)))
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)) next t)
(setvar "CMDECHO" 0)(vla-startundomark *kpblc-activedoc*)
(while next (SSSETFIRST)(vl-cmdf "_redrawall")
  (if (setq ent-pline (entsel "\nУкажите изменяемую вершину полилинии <выход>: "))
  (if (and (Is-object-modifed (car ent-pline) nil)
        (member (vla-get-ObjectName (setq pl (vlax-ename->vla-object (car ent-pline))))
                '("AcDb2dPolyline" "AcDbPolyline" "AcDb3dPolyline")))
    (progn (setq nab nil nab (ssadd))(ssadd (car ent-pline) nab)
      (SSSETFIRST nab nab)(setq nab nil)
      (setq Npt (osnap (cadr ent-pline) "_nea"))
      (setq  Npt (trans Npt 1 0)
	     par (vlax-curve-getParamAtPoint pl Npt)
	     pdr (+ 0.5 (fix par))  par (fix (+ 0.5 par)) ;_Ближайшая вершина
    	     par (if (and (eq (vla-get-closed pl) :vlax-true)
		    (= par (vlax-curve-getEndParam pl))) 0 par)
	      Ovx (trans (vlax-curve-getPointAtParam pl par) 0 1)
	      what 1+ str "следующая" undolst nil)
      (vecs_grdraw (setq Npt (trans (vlax-curve-getPointAtParam pl pdr) 0 1))
	 (angle Npt (trans (vlax-curve-getPointAtParam pl
	     (+ (vlax-curve-getParamAtPoint pl (trans Npt 1 (car ent-pline))) 1e-5))
	     (car ent-pline) 1)) 1)
      (_vxgrdraw Ovx -1)(initget "X N P U _X N P U")
      (while (/= "X" (setq Npt (getpoint Ovx
				(strcat "\nНовое положение вершины " (itoa (1+ (fix par)))
				        " [следующий(N)/предыдущий(P)/отмени(U)/выход(X)] <" str ">:"))))
	(cond
	  ((null Npt) nil)
	  ((= Npt "N")(setq what 1+ str "следующая"))
	  ((= Npt "P")(setq what 1- str "предыдущая"))
	  ((listp Npt)
	   (setq Npt (trans Npt 1 (car ent-pline))
	         par (if (and (eq (vla-get-closed pl) :vlax-true)
	               (= par (vlax-curve-getEndParam pl))) 0 par)
	      vx (pline-get-verts pl)
	 undolst (append (list(list par (apply 'append vx))) undolst)
	      vx (sbst-i par (if (= (vla-get-ObjectName pl) "AcDbPolyline")
		 (list (car Npt)(cadr Npt)) Npt) vx) lst (apply 'append vx))
	   (vla-put-coordinates pl (vlax-make-variant (vlax-safearray-fill
             (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lst)))) lst)))
	   (vl-cmdf "_redrawall")
	   (vecs_grdraw (setq Npt (trans (vlax-curve-getPointAtParam pl pdr) 0 1))
		(angle Npt (trans (vlax-curve-getPointAtParam pl
	           (+ (vlax-curve-getParamAtPoint pl (trans Npt 1 (car ent-pline))) 1e-5))
		(car ent-pline) 1)) 1))
	   ((= Npt "U")
	    (setq lst (car undolst) undolst (cdr undolst))
	    (if lst (progn
	      (setq par (car lst) lst (cadr lst))
	      (vla-put-coordinates pl (vlax-make-variant (vlax-safearray-fill
                (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lst)))) lst)))
		(setq Ovx (trans (vlax-curve-getPointAtParam pl par) 0 1))
		(vl-cmdf "_redrawall")
	      (vecs_grdraw (setq Npt (trans (vlax-curve-getPointAtParam pl pdr) 0 1))
		(angle Npt (trans (vlax-curve-getPointAtParam pl
	           (+ (vlax-curve-getParamAtPoint pl (trans Npt 1 (car ent-pline))) 1e-5))
		(car ent-pline) 1)) 1))
	      (alert "Нечего отменять"))) (t nil))
	(_vxgrdraw Ovx 0)(if (/= Npt "U")(setq par (what par)))
        (if (> par (vlax-curve-getEndParam pl))(setq par 0))
        (if (< par 0)(setq par (if (eq (vla-get-closed pl) :vlax-true)
            (1- (vlax-curve-getEndParam pl))(vlax-curve-getEndParam pl))))
	(setq par (if (and (eq (vla-get-closed pl) :vlax-true)
		    (= par (vlax-curve-getEndParam pl))) 0 par))
	(setq Ovx (trans (vlax-curve-getPointAtParam pl par) 0 1))
	(_vxgrdraw Ovx -1)(initget "X N P U _X N P U")))
    (princ "*** Объект на блокированном слое или не полилиния ***"))
    (setq next nil)));_while
(vl-cmdf "_redrawall")(vla-endundomark *kpblc-activedoc*)(princ))
При выборе полилинии она подсвечивается ручками и рисуется стрелка по направлению обхода. Возможность редактирования при включенных ручках - мне нравится. Будет включена во все команды по аналогу этой, то же и с undo.

Добавлено
Команда сделана автономной
VVA вне форума  
 
Непрочитано 12.10.2006, 14:05
#39
P_S


 
Регистрация: 09.10.2006
Санкт-Петербург
Сообщений: 97


VVA
Цитата:
Интересуют замечания по интерфейсу
.

Какие были мысли относительно этой команды: указывается направление редактирования, и резиновая нить цепляется за предыдущую вершину, обозначая положение линейного сегмента полилинии после изменения положения вершины. Таким образом, для пользователя процесс схож с вычерчиванием заново участка полилинии.
P_S вне форума  
 
Автор темы   Непрочитано 12.10.2006, 15:16
#40
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>P_Sуказывается направление редактирования - пробуй послений вариант
Цитата:
резиновая нить цепляется за предыдущую вершину
- не введет ли это пользователя в заблуждение.
VVA вне форума  
 
Непрочитано 12.10.2006, 16:18
#41
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 31
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Вроде бы все хорошо, но простите за назойливость, мне не нужно каждую вершину редактировать, а, переходя по полилинии корректировать некоторые из них, не выходя из команды.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 16:21
#42
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 31
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Не досмотрел. Так устроит. Большое спасибо.
Игорь Богаченко вне форума  
 
Непрочитано 12.10.2006, 16:25
#43
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Объясните, пожалуйста, а чем ручки-то плохи? Выделил полилинию и выбирай любую ручку, если нет ножки.
Profan вне форума  
 
Непрочитано 13.10.2006, 04:18
#44
Игорь Богаченко

геодезист, генпланист
 
Регистрация: 26.09.2006
Калуш, Украина
Сообщений: 31
<phrase 1= Отправить сообщение для Игорь Богаченко с помощью Skype™


Этот код не вставляет вершину, а смещает. Это не подходит.
Если применять резинувую нить, то для двух смежных вершин, а не для одной с направлением. И, желательна свобода перемещения по редактируемой полилинии, а не быть привязаным к определенному участку, и двигаться по линии к следующему участку редактирования.
Лучше просто подсветить редактируемую линию, и вставлять вершины в нужных местах.
Игорь Богаченко вне форума  
 
Непрочитано 13.10.2006, 05:49
#45
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для VVA.
А это почему?
Код:
[Выделить все]
Команда: PL-VXMOVE

Укажите изменяемую вершину полилинии <выход>: ; ошибка: no function definition: 
LIB:IS-OBJECT-MODIFED

Команда:
Программа не может работать автономно?
Profan вне форума  
 
Автор темы   Непрочитано 13.10.2006, 09:15
#46
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Игорь Богаченко В № 38 писал
Цитата:
Возможность редактирования при включенных ручках - мне нравится. Будет включена во все команды по аналогу этой, то же и с undo.
PL-VxAdd с ручками уже готова, допишу отмену и выложу обновления. На этой (PL-VxMove) команде можно посмотреть как будет. Чуточку терпения.
Цитата:
Если применять резинувую нить, то для двух смежных вершин, а не для одной с направлением
В лиспе такое нельзя, по крайней мере я не знаю как.
Я тоже сомневаюсь в практической ценности PL-VxMove и согласен с Profan №43 Хотел написать на Profan №45
Цитата:
в №32 писал, здесь забыл Дополнительные ф-ции по ссылке с поста №1.
Но подправлю VVA №38, сделаю ф-цию автономной.
VVA вне форума  
 
Непрочитано 13.10.2006, 10:00
#47
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Еще про ручки (такие, знаете ли, миленькие нежные ручки).
Подумавши, свою фразу построил бы по другому:
Выделил полилинию и выбирай любую ручку, если нет ножки, или выбирай с Shift'ом несколько ручек, если тебя привлекает групповуха. :twisted:
Profan вне форума  
 
Непрочитано 16.11.2006, 14:58
#48
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Спасибо за прогу, но почему не добавляется вершина в полилинии с глобальной шириной, пишет ничего типа не выбранно, очень редко проскакивает. и в 2007 не пашет эта команда, чего-тот не хватает
Neznayka вне форума  
 
Автор темы   Непрочитано 16.11.2006, 17:58
#49
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пользуясь случаем обновил программы. Исправленные ошибки:
- PL-CLONE, PL-VxRdc Неточночть работы в UCS
- Добавлена команда PL-VX1 - Изменение начала полилинии
- В команду PL-VxMove добавлена опция:
Для 3d полилиний добавляется запрос сохранения Z узла полилинии
- CVPOLY переведена в режим командной строки.
- Вместо нее добавлена PL-3d2d (проецирование 3d на текущую ПСК)
- Entrevs - для замкнутых полилиний вершина остается на месте
- Корректная обработка кривизны и ширины замыкающего сенмента полилинии в ENTREVS
Особо хочу поблагодарить KAI за дельные замечания и советы.

> Neznayka Все добавляется. Просто размер прицела выбора (PICKBOX) должен быть больше текущей толщины полилинии на экране.
Варианта 2:
1. Либо зумом отъедь от полилинии
2. Либо в командной строке PICKBOX и увеличь значение.

Только что проверил: работает в 2007 RUS. Там чистый Лисп. От версии не должно зависеть.
VVA вне форума  
 
Непрочитано 21.11.2006, 11:07
#50
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


> Neznayka Все добавляется. Просто размер прицела выбора (PICKBOX) должен быть больше текущей толщины полилинии на экране.
Варианта 2:
1. Либо зумом отъедь от полилинии
2. Либо в командной строке PICKBOX и увеличь значение.

Только что проверил: работает в 2007 RUS. Там чистый Лисп. От версии не должно зависеть.[/quote]

Все понял , спасибо, поставил новую версию и в 2007 заработало почему-то :roll:

еще нашёл замечательное применение :
все время мучился с отрисовкой забора на своих схемах, теперь полилинию можно разбить на нужной длины сегмент, назначить
глобальную ширину, и переменную FILLMODE обнулить - все. а то я раньше всякие (мультилинии), выдумывал

вот только акад при разбивки секунд на 15 призадумывается, и это при том , что комп далеко не слабый у меня
[ATTACH]1164096458.GIF[/ATTACH]


а может еще такую фишку с геоникса добавить, типа есть замкнутый контур (здание обведено с растра, например) внутренние углы стремятся к 90 градусам, но у них это не получается из-за того не пользовались ф8 . Так вот щелкнул по линии и она трансформировалась в фигуру с углами в 90 гр. , за основу берется самая длиная сторона
возможно ли такое ?
Neznayka вне форума  
 
Автор темы   Непрочитано 21.11.2006, 17:04
#51
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Neznayka Тебе поможет эта команда. Несмотря на то, что речь идет о шпалах, можешь рисовать и заборы

Код:
[Выделить все]
(Defun C:RW ( /  ang col dH DL DLN e1 H_put i nev Param pt0 pt11 pt21
		S_spal Vobj *error* adoc Flg CL)
(defun *error* (msg)(vla-endundomark adoc)(setq PICK1 nil)(setvar "CLAYER" CL))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark adoc)
;;;H_put - ширина пути
;;;S_spal - шаг шпал
;;;DL- на сколько шпалы выступают за путь с одной стороны
  (setq	H_put 3 ;_ширина пути 3 мм
	S_spal 6 ;_шаг шпал 6 мм
	DL 0.5  ;выступают на 0.05 мм
  ) ;_ End of setq
  (setq Flg t)
  (while Flg
    (initget "S")
    (setq e1 (entsel "\nВыберите ось путей [настройки S] <выход>: "))
    (cond
      ((= e1 "S")
       (princ "\nШирина пути в мм <")(princ H_put)(princ "> : ")
       (initget 6)(setq pt0 (getdist))
       (if pt0 (setq H_put pt0)) ;_ End of if
       (princ "\nШаг шпал в мм <")(princ S_spal)(princ "> : ")
       (initget 6)(setq pt0 (getdist))
       (if pt0 (setq S_spal pt0)) ;_ End of if
       (princ "\nВыступ шпал в мм <")(princ DL)(princ "> : ")
       (initget 5)(setq pt0 (getdist))
       (if pt0 (setq DL pt0)) ;_ End of if
      )
      ((null e1)(if (= (getvar "ERRNO") 52)(setq Flg nil e1 nil vobj nil)(princ " *мимо*")))
      (t
       (setq e1 (car e1) vobj (vlax-ename->vla-object e1))
       (cond
	 ((null(vlax-write-enabled-p vobj))(alert "На блокированном слое!"))
	 ((wcmatch (cdr(assoc 0 (entget e1))) "LINE,ARC,SPLINE,*POLYLINE,ELLIPSE,CIRCLE")(setq Flg nil))
	 (t (alert (strcat "Объект " (cdr(assoc 0 (entget e1)))
	    " не может быть осью пути\nОсь пути - полилиния, линия, дуга, сплайн, эллиптическая дуга, круг"))))))
  ) ;_while 
(if vobj (progn
  (setq dH (+ (* H_put 0.5) DL)  
       DLN (vlax-curve-getDistAtParam vobj (vlax-curve-getEndParam vobj))
        col (fix (/ dln s_spal 1.0))
        nev (- DLN (* col S_spal))
        nev (* nev 0.5))
  (setq	PICK1 nil PICK1 (ssadd)) ;_ end of setq
  (setq CL (getvar "CLAYER"))(setvar "CLAYER" (vla-get-Layer vobj))
  (setq i '-1)
  (repeat (+ col 1)
    (setq i (1+ i))
    (setq pt0 (vlax-curve-getPointAtDist vobj (+ (* S_spal i) nev)))
    (setq param (vlax-curve-getParamAtPoint vobj pt0))
    (setq ang (vlax-curve-getFirstDeriv vobj param))
    (setq pt11 (mapcar '+ pt0 ang))
    (setq ang (angle pt0 pt11))
    (setq ang (- ang (* PI 0.5)))
    (setq pt11 (polar pt0 ang dH))
    (setq pt21 (polar pt0 (+ ang PI) dH))
    (vla-AddLine (vla-ObjectIDToObject adoc (vla-get-OwnerID vobj))
      (vlax-3d-point pt11)(vlax-3d-point pt21))
    (ssadd (entlast) PICK1)
  ) ;_ End of repeat
  (vla-Offset vobj (* H_put 0.5))(ssadd (entlast) PICK1)(vla-Offset vobj (- 0 (* H_put 0.5)))(ssadd (entlast) PICK1)
  (setq pt0 (mapcar '(lambda (x)(vlax-get-property vobj x)) '(Linetype LineWeight Color Layer)))
  (setq pt11 (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex PICK1)))))
  (mapcar '(lambda (vla)
	     (mapcar '(lambda (x y)(vlax-put-property vla x y))
		'(Linetype LineWeight Color Layer) pt0)) pt11)
  (setvar "CLAYER" CL)(command "_.-group" "_C" "*" "Трамвайные (ж.д.) пути" PICK1 "")
  (initget "Yes No")(if (= (getkword "\nУдалять ось путей? [Yes/No] <No> : ") "Yes")(vla-erase vobj))
    )
  )
(setq PICK1 nil)
(vla-endundomark adoc)
 (princ)
)
VVA вне форума  
 
Непрочитано 21.11.2006, 17:59
#52
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


интересно я это попробую , но для жд дороги , а заборы все-таки легче выше описанным, имхо
Neznayka вне форума  
 
Непрочитано 22.11.2006, 07:22
#53
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 11,026


Совет программистам:

Для того, чтобы предотвратить ситуацию с неправильным указанием широкой (c физической шириной) полилинии, надо в функцию выбора примитива включать наподобие


Код:
[Выделить все]
 (setq om           (getvar "OSMODE")
          old_aperture (getvar "aperture")
 ) ;_ end of setq
 (setvar "OSMODE" 512)
 (setvar "aperture" (getvar "pickbox"))

;;..... здесь указание на примитив с обработкой правильности
(if (setq ent_selected
        (ru-get-entsel-by-type
                     msg
                     "Примитив недопустимого типа"
                     (list "LINE" "LWPOLYLINE")
                     t
                 ) 

        ) 
        (setq result (list (car ent_selected)
               (trans (osnap (trans (cadr ent_selected) 0 1) "_nea" 1 0)
                     ) 
        ) 
    )

;; Потом восстановление
(setvar "OSMODE" om)
(setvar "aperture" old_aperture)
Функция ru-get-entsel-by-type проверяет тип примитива, блокированность слоя и т.п. Не в ней дело (она вернет список как entsel), а в применении объектной привязки к полученной точке - функция osnap.
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 22.11.2006, 13:25
#54
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>ShaggyDoc Спасибо, использовал.
>Neznayka
Цитата:
а может еще такую фишку с геоникса добавить, типа есть замкнутый контур (здание обведено с растра, например) внутренние углы стремятся к 90 градусам, но у них это не получается из-за того не пользовались ф8 . Так вот щелкнул по линии и она трансформировалась в фигуру с углами в 90 гр. , за основу берется самая длиная сторона
возможно ли такое ?
Пробуй
Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90 градусов
;;;За основу берется самая длинная сторона
;;;
(Defun C:p90 ( / Flg e1 vobj i ang *error* crs pt0 pt1 pt2 pt3 var adoc)
(defun *error* (msg)(vla-endundomark adoc))
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates)
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3))
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil))))
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq Flg t)(while Flg (setq e1 (entsel "\nВыберите полилинию  <выход>: "))
    (cond ((null e1)(if (= (getvar "ERRNO") 52)(setq Flg nil e1 nil vobj nil)(princ " *мимо*")))
      (t (setq e1 (car e1) vobj (vlax-ename->vla-object e1))
       (cond ((null(vlax-write-enabled-p vobj))(alert "На блокированном слое!"))
	 ((wcmatch (cdr(assoc 0 (entget e1))) "*POLYLINE")(setq Flg nil))
	 (t (alert (strcat "Объект не полилиния"))))))) ;_while 
(if vobj (progn (setq crs (pline-get-verts vobj))(if (> (length crs) 2)(progn
(setq Pt1 nil pt2 nil ptS nil ptE nil var nil)(setq pt1 (car crs))
(mapcar'(lambda ( x )(if (or (null var)(< var (distance pt1 x)))
	   (setq var (distance pt1 x) ptS pt1 ptE x))(setq pt1 x))
 (cdr crs))(setq var nil i 0 lst crs)
(while i
  (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6))
    (setq i nil)(setq var (append var (list (nth i crs))) i (1+ i) lst (cdr lst))))
(setq crs (append lst var))(setq ang (angle (car crs)(cadr crs)))
(setq lst (list (car crs)(cadr crs)) crs (cddr crs))
(foreach pt crs
  (setq pt1 (last lst)) (setq pt2 (polar pt ang 100))
  (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt pt2 pt1 pt3 nil))
  (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0)))
(setq crs (reverse lst))(setq ang (angle (car lst)(cadr lst)))
(if (or (equal (angle (car crs)(cadr crs)) ang 1e-6)
	(equal (angle (car crs)(cadr crs))(+ ang PI) 1e-6)
	(equal (angle (car crs)(cadr crs))(- ang PI) 1e-6))
  (progn (setq pt1 (car lst))(setq pt0 (car crs))
    (setq pt2 (polar pt0 ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))
    (setq pt0 (inters pt0 pt2 pt1 pt3 nil))(setq lst (append (reverse(cdr crs))(list pt0)))
    (vla-put-Closed vobj :vlax-true))
  (progn (setq pt1 (car crs))(setq pt2 (cadr crs))
    (setq pt0 (inters (car lst)(cadr lst) pt1 pt2 nil))
    (if (and pt0 (equal (angle pt2 pt1)(angle pt2 pt0) 1e-6))
      (progn (setq pt1 (polar (car lst)(+ ang (* 0.5 PI)) 100))
	(setq pt0 (inters pt2 (polar pt2 ang 100)(car lst) pt1 nil))
	(setq crs (cddr crs))(setq crs (append (list pt0) crs))
	(setq lst (reverse crs))(vla-put-Closed vobj :vlax-true)))))
 (if (= (vla-get-ObjectName vobj) "AcDbPolyline")(setq lst (mapcar '(lambda (cr)(mapcar '+ cr '(0 0))) lst)))
  (setq crs (apply 'append lst))
  (setq var (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray
             vlax-vbDouble (cons 0 (1- (length crs)))) crs)))
(vla-put-Coordinates vobj var)))));_vobj
(vla-endundomark adoc)(princ))
(princ "\nНаберите в командной строке p90")

Последний раз редактировалось VVA, 19.09.2015 в 20:52.
VVA вне форума  
 
Непрочитано 22.11.2006, 14:13
#55
Lizzy

архитектор
 
Регистрация: 14.01.2006
Portugal, Sintra
Сообщений: 119


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

В одном файле после использования команды flatten objekts изменилось отбражение вновь проводимых полилиний. Толщина их стало отбражаться в абсолютных величинах, а не относительно экрана. мне удалось только выяснить, что это зависит от величин global width. Где можно это значение "обнулить"? Пока приходится делать это вручную в свойствах... :?:
__________________
жизнь-занятная штука...
Lizzy вне форума  
 
Непрочитано 22.11.2006, 14:46
#56
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Вы кудесник, это так "окрасивит" мои чертежи,!!! прям сказка,

немогли бы вы на словах рассазать про алгоритм работы, это сравни уравновешивания теодолитного хода?
если Вас интересуют пожелания, то они такие:
некорректно работает с не замкнутой плинией (появляется короткий апендикс который совсем в другую сторону смотрит), и если можно ограничить выпрямляймые углы , скажем от 85 до 95 градусов, а то в зданиях бывают не только прямые углы, и еще чтоб скапом можно было контура обрабатывать, а не по одному.

ОГРОМНОЕ СПАСИБО
Neznayka вне форума  
 
Автор темы   Непрочитано 23.11.2006, 14:25
#57
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Lizzy Вручную в свойствах, только для всех полилиний сразу.
Выдели объекты, в окне свойств (там где Все) раскрой список, выбери полилинии. в поле Глобальная ширина вбей 0.
>Neznayka Пробуй. Про алгоритм чуть позже
Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90+- допуск градусов
;;;За основу берется самая длинная сторона
;;;
(Defun C:p90 ( / Flg e1 i ang *error* crs pt0 pt1 pt2 pt3 var adoc dop1 dop2)
(defun *error* (msg)(princ msg)(vla-endundomark adoc))
(defun angw1w2 (Wekt1 Wekt2 $P000 / CosA)
(setq Wekt1 (mapcar '- Wekt1 $P000) Wekt2 (mapcar '- Wekt2 $P000) $P000 (mapcar '- $P000 $P000))
 (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2))
  (distance $P000 Wekt1) (distance $P000 Wekt2))) -1.0 1e-6) Pi
  (if (equal CosA 0.0 1e-6) Pi2 (atan (sqrt (- 1 (* CosA CosA))) CosA))))
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates)
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline")
             (group-by-num verts 3))
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil))))
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq ang (getangle "\nДопуск в градусах для выравнивания до 90 <любой угол>: "))
(if ang (setq dop1 (- (* 0.5 PI) ang) dop2  (+ (* 0.5 PI) ang))
(setq dop1 nil dop2 nil))
(princ "\nВыберите полилинии ")(setq selset (ssget "_:L" '((0 . "*POLYLINE"))))
(if selset (progn (setq selset (mapcar 'vlax-ename->vla-object  (vl-remove-if 'listp
 (mapcar 'cadr (ssnamex selset)))))
 (mapcar '(lambda(vobj / ug ptS ptE)(setq crs (pline-get-verts vobj))
    (if	(> (length crs) 2)(progn (setq Pt1 nil pt2 nil ptS nil ptE nil var nil)
	(setq pt1 (car crs))(mapcar '(lambda (x)(if (or (null var) (< var (distance pt1 x)))
        (setq var (distance pt1 x) ptS pt1 ptE x))  (setq pt1 x))(cdr crs))(setq i 0 var 0)
	(while (and i (nth i crs))(if (and (equal (nth i crs) ptS 1e-6)
               (equal (nth (1+ i) crs) ptE 1e-6))(setq var (1+ i) i (+ (length crs) 1)))
	    (setq i (1+ i)))
	(if (> var (* 0.5 (length crs)))(setq crs (reverse crs) i ptS ptS ptE ptE i))
	(setq var nil i 0 lst crs)
	(while (and i (nth i crs))
	  (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6))
	    (setq i nil)(setq var (append var (list (nth i crs)))
		  i   (1+ i) lst (cdr lst))))
	(setq crs (append lst var))(setq ang (angle (car crs) (cadr crs)))
	(setq lst (list (car crs) (cadr crs)) crs (cddr crs))
	(foreach pt crs (setq pt1 (last lst))
	  (setq pt2 (polar pt ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))
	  (setq ug (angw1w2 pt (cadr (reverse lst)) pt1))
	  (if (or (null dop1)(and (> ug dop1)(< ug dop2)))
	    (setq pt0 (inters pt pt2 pt1 pt3 nil))(setq pt0 pt))
	  (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0)))
	(setq crs (reverse lst))(setq ang (angle (car lst) (cadr lst)))
	(if (or	(equal (angle (car crs) (cadr crs)) ang 1e-6)
		(equal (angle (car crs) (cadr crs)) (+ ang PI) 1e-6)
		(equal (angle (car crs) (cadr crs)) (- ang PI) 1e-6))
	  (progn (setq pt1 (car lst))(setq pt0 (car crs))(setq pt2 (polar pt0 ang 100))
		 (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt0 pt2 pt1 pt3 nil))
		 (setq lst (append (reverse (cdr crs)) (list pt0)))
		 (vla-put-Closed vobj :vlax-true))
	  (progn (setq pt1 (car crs))(setq pt2 (cadr crs))
	    (setq pt0 (inters (car lst) (cadr lst) pt1 pt2 nil))
	    (if	(and pt0 (equal (angle pt2 pt1) (angle pt2 pt0) 1e-6))
	      (progn (setq pt1 (polar (car lst) (+ ang (* 0.5 PI)) 100))
		     (setq pt0 (inters pt2 (polar pt2 ang 100) (car lst) pt1 nil))
		     (setq crs (cddr crs))(setq crs (append (list pt0) crs))
		     (setq lst (reverse crs))(vla-put-Closed vobj :vlax-true)))))
	(if (= (vla-get-ObjectName vobj) "AcDbPolyline")
	  (setq lst (mapcar '(lambda (cr) (mapcar '+ cr '(0 0))) lst)))
	(setq crs (apply 'append lst))(setq var (vlax-make-variant (vlax-safearray-fill
        (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length crs)))) crs)))
	(vla-put-Coordinates vobj var)))) selset))) ;_selset
(vla-endundomark adoc)(princ))(princ "\nНаберите в командной строке p90")
Если в ответ на запрос
Цитата:
Допуск в градусах для выравнивания до 90 <любой угол>:
ввести 5, то будут обрабатываться углы 85-95 градусов

Последний раз редактировалось VVA, 19.09.2015 в 20:55.
VVA вне форума  
 
Непрочитано 24.11.2006, 13:41
#58
Кочетков Андрей

Regular Java Developer
 
Регистрация: 03.02.2006
Сообщений: 4,630


Комментарий к программе PL-VxRdc (прополка полилинии):

работаю с lwpolyline
она имеет свойство Замкнута

программа выдает ошибку
Код:
[Выделить все]
Command: PL-VxRdc
25 found

Command:
Введите max отклонение от прямой (H) [угловой допуск A/отклонение H] <0.15>:
ERRNO # 0: Automation Error. Invalid index

Command: *Cancel*
Снимаю атрибут Замкнута.
Программа работает корректно.
Кочетков Андрей вне форума  
 
Автор темы   Непрочитано 24.11.2006, 14:32
#59
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Спасибо проверю
VVA вне форума  
 
Автор темы   Непрочитано 24.11.2006, 16:30
#60
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Кочетков Андрей Исправил. Выложил в download
VVA вне форума  
 
Непрочитано 24.11.2006, 17:23
#61
Кочетков Андрей

Regular Java Developer
 
Регистрация: 03.02.2006
Сообщений: 4,630


Спасибо
Кочетков Андрей вне форума  
 
Непрочитано 27.11.2006, 14:36
#62
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Спасибо, но есть еще вопросы
а нельзя ли сделать так чтоб угол не вводить каждый раз. Типа как в акаде рисование окружности - старое значение по умолчанию
Neznayka вне форума  
 
Автор темы   Непрочитано 27.11.2006, 15:54
#63
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Код:
[Выделить все]
;;;Команда выравнивает внутренние углы полилинии до 90+- допуск градусов 
;;;За основу берется самая длинная сторона 
;;;http://forum.dwg.ru/showthread.php?p=104952#post104952
(Defun C:p90 ( / Flg e1 i ang *error* crs pt0 pt1 pt2 pt3 var adoc dop1 dop2) 
(defun *error* (msg)(princ msg)(vla-endundomark adoc)) 
(defun angw1w2 (Wekt1 Wekt2 $P000 / CosA) 
(setq Wekt1 (mapcar '- Wekt1 $P000) Wekt2 (mapcar '- Wekt2 $P000) $P000 (mapcar '- $P000 $P000)) 
 (if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2)) 
  (distance $P000 Wekt1) (distance $P000 Wekt2))) -1.0 1e-6) Pi 
  (if (equal CosA 0.0 1e-6) Pi2 (atan (sqrt (- 1 (* CosA CosA))) CosA)))) 
(defun pline-get-verts (pline_obj / verts)(setq verts (vlax-get pline_obj 'Coordinates) 
      verts (cond ((wcmatch (vlax-get pline_obj 'Objectname ) "AcDb2dPolyline,AcDb3dPolyline") 
             (group-by-num verts 3)) 
             ((eq (vlax-get pline_obj 'Objectname )"AcDbPolyline")(group-by-num verts 2))(T nil)))) 
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn 
(setq ls nil)(repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) 
(setq ret (append ret (list (reverse ls))) ls nil)))) ret) 
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))(vla-startundomark adoc)
(setq ang *P90-ANG*)(princ"\nДопуск в градусах для выравнивания до 90 [Любой] <")(initget "Любой Any _Any Any")
(princ (if ang (/ (* ang 180.0) pi) "любой угол"))(princ">: ")(setq ang (getangle))
(if (= ang "Any")(setq ang nil *P90-ANG* nil))(if ang (setq *P90-ANG* ang))
(if ang (setq dop1 (- (* 0.5 PI) ang) dop2  (+ (* 0.5 PI) ang)) 
(setq dop1 nil dop2 nil))(VL-PROPAGATE '*P90-ANG*) 
(princ "\nВыберите полилинии ")(setq selset (ssget "_:L" '((0 . "*POLYLINE")))) 
(if selset (progn (setq selset (mapcar 'vlax-ename->vla-object  (vl-remove-if 'listp 
 (mapcar 'cadr (ssnamex selset))))) 
 (mapcar '(lambda(vobj / ug ptS ptE)(setq crs (pline-get-verts vobj)) 
    (if   (> (length crs) 2)(progn (setq Pt1 nil pt2 nil ptS nil ptE nil var nil) 
   (setq pt1 (car crs))(mapcar '(lambda (x)(if (or (null var) (< var (distance pt1 x))) 
        (setq var (distance pt1 x) ptS pt1 ptE x))  (setq pt1 x))(cdr crs))(setq i 0 var 0) 
   (while (and i (nth i crs))(if (and (equal (nth i crs) ptS 1e-6) 
               (equal (nth (1+ i) crs) ptE 1e-6))(setq var (1+ i) i (+ (length crs) 1))) 
       (setq i (1+ i))) 
   (if (> var (* 0.5 (length crs)))(setq crs (reverse crs) i ptS ptS ptE ptE i)) 
   (setq var nil i 0 lst crs) 
   (while (and i (nth i crs)) 
     (if (and (equal (nth i crs) ptS 1e-6)(equal (nth (1+ i) crs) ptE 1e-6)) 
       (setq i nil)(setq var (append var (list (nth i crs))) 
        i   (1+ i) lst (cdr lst)))) 
   (setq crs (append lst var))(setq ang (angle (car crs) (cadr crs))) 
   (setq lst (list (car crs) (cadr crs)) crs (cddr crs)) 
   (foreach pt crs (setq pt1 (last lst)) 
     (setq pt2 (polar pt ang 100))(setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100)) 
     (setq ug (angw1w2 pt (cadr (reverse lst)) pt1)) 
     (if (or (null dop1)(and (> ug dop1)(< ug dop2))) 
       (setq pt0 (inters pt pt2 pt1 pt3 nil))(setq pt0 pt)) 
     (setq lst (append lst (list pt0)))(setq ang (angle pt1 pt0))) 
   (setq crs (reverse lst))(setq ang (angle (car lst) (cadr lst))) 
   (if (or   (equal (angle (car crs) (cadr crs)) ang 1e-6) 
      (equal (angle (car crs) (cadr crs)) (+ ang PI) 1e-6) 
      (equal (angle (car crs) (cadr crs)) (- ang PI) 1e-6)) 
     (progn (setq pt1 (car lst))(setq pt0 (car crs))(setq pt2 (polar pt0 ang 100)) 
       (setq pt3 (polar pt1 (+ ang (* 0.5 PI)) 100))(setq pt0 (inters pt0 pt2 pt1 pt3 nil)) 
       (setq lst (append (reverse (cdr crs)) (list pt0))) 
       (vla-put-Closed vobj :vlax-true)) 
     (progn (setq pt1 (car crs))(setq pt2 (cadr crs)) 
       (setq pt0 (inters (car lst) (cadr lst) pt1 pt2 nil)) 
       (if   (and pt0 (equal (angle pt2 pt1) (angle pt2 pt0) 1e-6)) 
         (progn (setq pt1 (polar (car lst) (+ ang (* 0.5 PI)) 100)) 
           (setq pt0 (inters pt2 (polar pt2 ang 100) (car lst) pt1 nil)) 
           (setq crs (cddr crs))(setq crs (append (list pt0) crs)) 
           (setq lst (reverse crs))(vla-put-Closed vobj :vlax-true))))) 
   (if (= (vla-get-ObjectName vobj) "AcDbPolyline") 
     (setq lst (mapcar '(lambda (cr) (mapcar '+ cr '(0 0))) lst))) 
   (setq crs (apply 'append lst))(setq var (vlax-make-variant (vlax-safearray-fill 
        (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length crs)))) crs))) 
   (vla-put-Coordinates vobj var)))) selset))) ;_selset 
(vla-endundomark adoc)(princ))(princ "\nНаберите в командной строке p90")
Значение сохраняется в текущем сеансе редактирования

Последний раз редактировалось VVA, 19.09.2015 в 21:00.
VVA вне форума  
 
Непрочитано 18.12.2006, 11:49
#64
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Выражаю особую благодарность VVA за программу "Прополка полиинии". Очень пригодилась для значительного уменьшения количества вершин полилиний после выполнения таких преобразований: CDR->DWG->WMF->DWG.
Profan вне форума  
 
Непрочитано 18.12.2006, 13:22
#65
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для VVA.
В вашей функции PL-L2A есть запрос:
Код:
[Выделить все]
Выберите нужный дуговой сегмент в полилинии [отмени U/радиус R/выход X] <выход>:
Наверное, надо слово "дуговой" заменить на "линейный"?
Profan вне форума  
 
Автор темы   Непрочитано 14.03.2007, 10:46
#66
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Profan Спасибо, Владимир. Как-то пропустил твой пост, только сейчас заметил. Заменил. Исправления от 14.03.2007
Помимо этого добавлено:
ConvTo2d -Преобразование линейных объектов в 2D полилинии
ConvTo3d -Преобразование линейных объектов в 3D полилинии
MPL -Построение средней линии
R3P -Прямоугольгик по 3-м точкам
PL-JOIN -Объединение полилиний чохом (если есть 3d полилинии, то объединяет и их тоже, но не с 2d, а между собой)
PL-JOIN3D -Объединение 3D полилиний (Отрезки + 3d полилинии)
Исправлены мелкие и не очень (спасибо KAI) глюки.
VVA вне форума  
 
Непрочитано 15.03.2007, 01:03
#67
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Цитата:
Исправлены мелкие и не очень (спасибо KAI) глюки.
Правда еще более маленькие появились, но это мелочи.
Даже мне, зунуде, кажется, что уже все в норме. Есть конечно мелкие огрехи, кое в чем с автором я не согласен, но на то и АВТОР! Ему видней.
А в целом комплекс ОЧЕНЬ хороший! Рекомендую!
Огромное спасибо VVA!
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 15.03.2007, 06:35
#68
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для VVA.
Вот ЗДЕСЬ есть еще программа Евгения Елпанова "Изменение начальной и конечной ширины произвольного сегмента полилинии". Вы не хотите включить ее или ваш аналог в пакет PLTOOLS?
Правильно вы сделали, что сгруппировали кнопки.
Profan вне форума  
 
Автор темы   Непрочитано 18.04.2007, 18:25
#69
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Поступают просьбы добавить команду, чтоб выбирать надо было бы только один объект, а команда объединяла все примыкающие объекты (линии, полилинии, дуги...) в полилинию.
Выкладываю на тестирование и для предложений/замечаний.
Алгорити взят у ChainSelect Fatty
Код:
[Выделить все]
;;* Утилита объединения набора линий в полилинию*
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - точка в мировой системе координат !!!
;;    - или имя (ENAME VLA-OBJECT) начального примитива
;; fuzz - точность
;;Возвращает список vla объектов
(defun ChainSelectFromAny ( pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil
             )
       )
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I")
          ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))
    ) ;_ end of setq
  (progn
    (if pt
      (progn
        (setq ln1 (vla-addLine
                    (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
                             (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))
                             ) ;_ end of and
                      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-3d-point pt)
               (vlax-3d-point (mapcar '- pt '(1 1 0)))))
        (setq ln ln1)))
     (setq spt (vlax-curve-getStartPoint ln)
           ept (vlax-curve-getEndPoint ln))
    (setq line_list  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (cons ln chain_list)
    ) ;_ end of setq
    (setq line_list (vl-remove-if
                      '(lambda (x)
                         (eq "AcDb3dPolyline" (vla-get-objectname x))
                       ) ;_ end of lambda
                      line_list
                    ) ;_ end of vl-remove-if
    ) ;_ end of setq
    (setq loop t cycl 0)
    (while loop
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
         (if couple
           (progn
             (setq chain_list (append couple chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq ln (car chain_list))
           ) ;_ end of progn
           (setq line_list (cdr line_list))
         ) ;_ end of if
      ) ;_ end of while
      (setq loop nil)
    ) ;_ end of while
  ) ;_ end of progn
) ;_ end of if
  (setq chain_list (vl-remove ln1 chain_list))
  (if (= (type ln1) 'VLA-OBJECT)(vl-catch-all-apply 'vla-erase (list ln1)))
  (vl-cmdf "_.redraw")
  chain_list
)


;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:mark
;;;* Mark data base to allow KB:catch.
;;;*http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
   (setq val (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast))
      nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)
      )
   )
   (setvar "cmdecho" val)
   (princ)
)
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:catch
;;;* returns selection set of entities since last KB:mark.
;;;*
(defun mip:get-last-ss (/ ss tmp)
   (if *mip:mark
      (progn (setq ss (ssadd))
             (while (setq *mip:mark (entnext *mip:mark)) (ssadd *mip:mark ss))
             (command "._select" ss "")
             (setq tmp ss)
      )
      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
   )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------



(defun C:CSS ( / ss pda en fuzz)
 (vl-load-com)
 (if (and (setq en (car(entsel "\nВыбрать первую или последнюю линию в цепи :")))
          (wcmatch (cdr(assoc 0 (entget en))) "ARC,LINE,*POLYLINE"))
 (progn
 (if (null (setq fuzz (getdist "\nЗначение допуска < 0.01 >: ")))
   (setq fuzz 0.01))
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss)
    )
  (mip:mark)
  (vl-catch-all-apply '(lambda()
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    )
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))

  (setq ss nil)
  )
   )
  (princ)
  )
(defun C:CSP ( / ss pt1 pda lst fuzz)
 (vl-load-com)  
 (initget 1)
 (setq pt1 (getpoint "\nТочка начала объединения:"))
  (if (null (setq fuzz (getdist "\nЗначение допуска < 0.01 >: ")))
   (setq fuzz 0.01))
 
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny (trans pt1 1 0)(+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss)
    )
  (mip:mark)
  (vl-catch-all-apply '(lambda()
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    )
  (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))
;;;  (setq ln (entlast))
;;;  (if (and (wcmatch (cdr(assoc 0 (entget ln))) "*POLYLINE")
;;;           (not(lwcl ln)))
;;;           (plineLW-reverse ln))
  (setq ss nil)
  (princ)
  )

(princ "\nНаберите CSP или CSS в командной строке")
Две команды
CSS - объединение путем выбора притива
CSP - объединение путем указания точки
VVA вне форума  
 
Непрочитано 19.04.2007, 03:15
#70
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
Очень интересно! Но:

0. Мур-мур от команд надо-бы отключить.

1. CSS. В одном из моих отладочных чертежей вылезла следующая ошибка (правда там объекты отрисованы в разных UCS и ужасная мешанина из объектов):

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
; error: bad argument value: AcDbCurve 2130505112

2. CSS. 3DPoly следует исключать из набора, иначе получается следующая картина:

---3DPoly в конце цепочки------------

Command: css
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
_.redraw
Command: _pedit Select polyline or [Multiple]: _M
Select objects: 9 found

Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]: _j
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: _j
Enter join type [Extend/Add/Both] <Both>: _b
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: 0.010000000000000
8 segments added to polyline

Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]:
Command: ._select
Select objects: 0 found
Select objects:

---3DPoly в начале----------------------

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0.01 >:
_.redraw
Command: _pedit Select polyline or [Multiple]: _M
Select objects: 10 found

Select objects:
Enter an option [Close/Open/Spline curve/Decurve/Undo]: _j
Invalid option keyword.

Enter an option [Close/Open/Spline curve/Decurve/Undo]: ._select
Invalid option keyword.
; error: Function cancelled

Enter an option [Close/Open/Spline curve/Decurve/Undo]:

3. CSP. Похоже точку надо указывать точно на узле объекта?

4. Для PEDITACCEPT лучше применять конструкцию:
(if (getvar "PEDITACCEPT");для 2006>>
(progn
(setq pda (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
)
)
Вдруг прогу запустят в acad 2005?

5. CSS. Кроме 3DPoly, думаю следует проверять еще и линии (они должны лежать в одной плоскости), а то получается, что грипсы загораются на всей цепочке, но это только видимость! Если последняя линия не в плоскости полилинии.

6. На мой взгляд, fuzz по умолчанию лучше бы сделать 0.0, будем приучать пользователей к точности.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 19.04.2007, 11:50
#71
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> 0. Мур-мур от команд надо-бы отключить
Извини, не понял о чем речь
>1. CSS. В одном из моих отладочных чертежей вылезла следующая >ошибка (правда там объекты отрисованы в разных UCS и ужасная >мешанина из объектов):
Попробуй проверить этот чертеж _audit или _recover. Это помогло на том глючном файле, который ты присылал раньше.
>2. CSS. 3DPoly следует исключать из набора, иначе получается >следующая картина:
Пришли файл, т.к. 3dpoly исключаю
Код:
[Выделить все]
(setq line_list (vl-remove-if
                      '(lambda (x)
                         (eq "AcDb3dPolyline" (vla-get-objectname x))
                       ) ;_ end of lambda
                      line_list
                    ) ;_ end of vl-remove-if
    ) ;_ end of setq
>3. CSP. Похоже точку надо указывать точно на узле объекта?
Да
>4. Для PEDITACCEPT лучше применять конструкцию:
PEDITACCEPT появилась с 2004 Автокада. Не знаю, есть ли смысл ввводить проверку?

>5. CSS. Кроме 3DPoly, думаю следует проверять еще и линии (они >должны лежать в одной плоскости), а то получается, что грипсы >загораются на всей цепочке, но это только видимость! Если >последняя линия не в плоскости полилинии.
Здесь принцип такой: строится список объектов с совпадающими началом/концом и отдается на откуп _PEDIT _M. А уж сколь там контуров построит PEDIT одному Autodesk'у известно. Грипсами подсвечивается все, что получилось (или осталось). Это могут быть и несколько контуров, или (и) не объединенные LINE. Почему проскальзывают 3dpoly пока не понятно?

>6. На мой взгляд, fuzz по умолчанию лучше бы сделать 0.0, будем >приучать пользователей к точности.
Это правильно.

Еще терзают смутные сомнения в необходимости CSP.
VVA вне форума  
 
Автор темы   Непрочитано 19.04.2007, 11:51
#72
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> 0. Мур-мур от команд надо-бы отключить
Имеется ввиду CMDECHO?
VVA вне форума  
 
Непрочитано 20.04.2007, 04:11
#73
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA

>0. Именно CMDECHO.

>1. CSS. В одном из моих отладочных чертежей вылезла ошибка...

Audit and Recover не помогло.

>2. CSS. 3DPoly следует исключать из набора...

Если 3DPoly в конце - все OK.
А вот если в начале, то ....

>4. Для PEDITACCEPT

Отнюдь не все перешли еще на 2004>>

>5. CSS. Линии не в плоскости.

Может лучше подсветить грипсы для итоговой полилинии, а не для набора, передаваемого в PEdit?

> Еще терзают смутные сомнения в необходимости CSP.

Наверное, это не нужно, что-то никак не могу придумать в каких ситуациях это будет полезно.

И еще заметил. Если выбирать дугу, расположенную в середине цепочки, то CSS вроде логично объединяет дугу с последующими объектами (предыдущие не объединяются, предыдущий объект линия).
Но если выбрать линию (дугу) в середине цепочки, то объединяются выбранный объект и последующие и почему-то один предыдущий линия (или дуга при выборе дуги).
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 20.04.2007, 16:55
#74
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вот новый вариант
Код:
[Выделить все]
;;* Утилита объединения набора линий в полилинию*
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - точка в мировой системе координат !!!
;;    - или имя (ENAME VLA-OBJECT) начального примитива
;; fuzz - точность
;;Возвращает список vla объектов
(defun ChainSelectFromAny ( pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil))
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I") ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))) ;_ end of setq
  (progn
    (if pt (progn
      (setq ln1 (vla-addLine
            (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
                     (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))) ;_ end of and
                      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-3d-point pt)(vlax-3d-point (mapcar '- pt '(1 1 0)))))
        (setq ln ln1)))
     (setq spt (vlax-curve-getStartPoint ln)  ept (vlax-curve-getEndPoint ln))
    (setq line_list  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (cons ln chain_list)) ;_ end of setq
    (setq line_list (vl-remove-if
                      '(lambda (x)(eq "AcDb3dPolyline" (vla-get-objectname x)))
                      line_list)) ;_ end of setq
    (setq loop t cycl 0)
    (while loop
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
         (if couple (progn
             (setq chain_list (append couple chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq ln (car chain_list))) ;_ end of progn
           (setq line_list (cdr line_list))) ;_ end of if
      ) ;_ end of while
      (setq loop nil)
    ) ;_ end of while
  ) ;_ end of progn
) ;_ end of if
  (setq chain_list (vl-remove ln1 chain_list))
  (if (= (type ln1) 'VLA-OBJECT)(vl-catch-all-apply 'vla-erase (list ln1)))
  (vl-cmdf "_.redraw") chain_list)

;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
 (setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast)) nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)))
   (setvar "cmdecho" val)(princ))
;;;* returns selection set of entities since last KB:mark.
(defun mip:get-last-ss (/ ss tmp val)
(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
(if *mip:mark (progn (setq ss (ssadd))
 (while (setq *mip:mark (entnext *mip:mark))(ssadd *mip:mark ss))
 (command "._select" ss "")(setq tmp ss ss nil));_progn
 (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."));_if
 (setvar "cmdecho" val) tmp)
(defun C:CSS ( / ss pda en fuzz val)
 (vl-load-com)(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
 (if (and (setq en (car(entsel "\nВыбрать первую или последнюю линию в цепи :")))
          (wcmatch (cdr(assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
          (setq en (vlax-ename->vla-object en))
          (/= "AcDb3dPolyline" (vla-get-objectname en))
          )
 (progn
 (if (null (setq fuzz (getdist "\nЗначение допуска < 0 >: ")))(setq fuzz 0))
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss))
  (mip:mark)
  (vl-catch-all-apply '(lambda()
  (if (setq pda (getvar "PEDITACCEPT"))(progn
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz ""))))
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))(progn
      (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (setq fuzz 0)
      (while (setq en (ssname ss fuzz))
        (if (/= (cdr(assoc 0 (entget en))) "LWPOLYLINE")
          (ssdel en ss)
          (setq fuzz (1+ fuzz))))
      (sssetfirst ss ss)))
  (setq ss nil)
  )
   (princ "\nНеобходимо выбрать ОТРЕЗОК, ДУГУ, или Полилинию")
   )
(setvar "cmdecho" val)(princ)
)
(princ "\nНаберите CSS в командной строке")
VVA вне форума  
 
Непрочитано 21.04.2007, 02:21
#75
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
Может это старческое брюзжание, но:

1. Болезнь отмены работы программы так и не преодолена, для отмены нужно 2 раза посылать команду U (это касается и программ комплекса pltools).
2. Все-таки логичнее будет, если пользователь выбирает объект вблизи будущего начала полилинии и к нему добавляются только объекты, примыкающие к концу этого объекта! Сейчас же, похоже, объединение выполняется в зависимости от направления исходных объектов, причем объединение происходит в режиме: все в одном направлении + один объект в противоположном.
3. Перед началом работы программы следует сбросить грипсы. Если после CSS снова ее запускаем (грипсы на предыдущей не сброшены), то после указания нового объекта для объединения получаем ошибку:

Command: CSS
Выбрать первую или последнюю линию в цепи :
Значение допуска < 0 >:

Invalid option keyword.

Invalid option keyword.
; error: Function cancelled

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype
gen/Undo]:

А в целом, можно уже помещать ее в PLTolls.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 26.04.2007, 13:28
#76
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для VVA.
Панель "Толщины полилиний" лучше назвать "Ширина новой полилинии". А в программе не мешало бы учесть "DIMSCALE".
Profan вне форума  
 
Автор темы   Непрочитано 26.04.2007, 16:21
#77
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
А в программе не мешало бы учесть "DIMSCALE"
С этого места поподробнее. На что может влиять DimScale?
VVA вне форума  
 
Непрочитано 26.04.2007, 16:34
#78
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Да вот, например. Архитекторы чертят план в масштабе 1:1, а выводить на печать будут из модели в масштабе 1:100. Все размерные величины (и тексты) соответственно увеличены в 100 раз. Для этого задается переменная "DIMSCALE" равная 100. В этих условиях ширина полилинии должна быть, для примера, не 0.5, а 50. Поэтому я и предположил, что, если "DIMSCALE" > 1, то и ширину полилинии надо устанавливать равной, скажем, 0.5 x (getvar "DIMSCALE"). Возможно, это спорный момент.
Profan вне форума  
 
Автор темы   Непрочитано 07.05.2007, 10:27
#79
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> Krieger №18
Цитата:
А как сделать реверс дуговых сегментов?
Как ни крути тип линии в одну сторону направлен.
AutoCAD2007
> Кулик Алексей aka kpblc №19
Цитата:
Это не сделать, наколько я помню, вообще никак. Только если изготовить новый тип линии и его назначать на полилинию
Может уже давно всем это известно, но для себя открыл недавно.
На дуговых сегментах полилинии тип линий может быть "вверх тормашками", причем реверс не помогает. Этот артефакт можно побороть, если в полилинии включить "генерацию типа линий".

Последний раз редактировалось VVA, 19.09.2015 в 22:56.
VVA вне форума  
 
Непрочитано 07.05.2007, 10:43
#80
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Вах-вах-вах! Позор на мою дурную голову! Я этого не знал! Вай-вай-вай!
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 08.05.2007, 01:16
#81
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


А я посыплю голову пеплом!
p.s. А что уже начали проектировать газопроводы по дугам! Как я отстал!
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 08.05.2007, 10:23
#82
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>KAI это для наглядности. А так см. Krieger №18 (сварной шов).
Хотя с приходом пластика не удивлюсь, если в проекте будет написано "Трубу согнуть по месту"
VVA вне форума  
 
Автор темы   Непрочитано 12.12.2007, 17:09
#83
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Profan # 76,78
По поводу учета толщины полилинии и DIMSCALE все решается через меню. Добавил панель "Ширина полилинии*Dimscale". Выложил в download. Обновление от 12.12.2007. Ссылка в 1 посте
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 13.11.2009 в 20:23. Причина: орфография
VVA вне форума  
 
Непрочитано 12.12.2007, 18:41
#84
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Хорошо.
Profan вне форума  
 
Непрочитано 27.12.2007, 21:00
#85
plugins


 
Регистрация: 27.12.2007
Сообщений: 2


В файле новом файле dnl607.rar загружаемом со страницы http://dwg.ru/dnl/607 обновлены только history.txt, pltools.mnu и pltools.mns.
Все остальные файлы к сожалению от 13,03,2007
plugins вне форума  
 
Автор темы   Непрочитано 28.12.2007, 11:11
#86
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Да, пока так и есть. См. #83. Планирую обновления выложить после праздников. Основные отличия - переработаны алгоритмы оптимизации (прополки) полилинии + прополка (PL-VxRdc) восстанавливает дуговые сегменты. В данный момент переписываю алгоритм PL-DIV. Если успею, добавлю новую команду переноса сегмента полилинии по вертикали (а может и по горизонтали) с учем разных вертикальных и горизонтальных масштабов. Написал по заказу дорожников, для работы с профилями
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 28.12.2007, 15:17
#87
plugins


 
Регистрация: 27.12.2007
Сообщений: 2


Спасибо Вам огромное. Ваши программы увеличивают возможности автокада в несколько раз. Раньше пользовался ToolPack, теперь уже почти год Вашим пакетом. Работает отлично, без каких либо глюков и ошибок. Единственно где были проблемы, так это в программе VxRdc (с дугами, а также очень медленно работает при количестве точек порядка 7000). Проблему с дугами решил для себя заменив фрагмент:

if (or (and (vlax-method-applicable-p pl 'Getbulge)
(zerop (vla-GetBulge pl (1- n))))
(not (vlax-method-applicable-p pl 'Getbulge))
(and (vlax-method-applicable-p pl 'Getbulge)
(not (zerop (vla-GetBulge pl (1- n))))
pang
))

На

if (zerop (vla-GetBulge pl (1- n)))

Очень рад что после праздников может быть будет оптимизация.

Последний раз редактировалось plugins, 28.12.2007 в 15:43.
plugins вне форума  
 
Автор темы   Непрочитано 24.01.2008, 18:54
#88
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Ну вот, свершилось. Выложил новую версию (обновление от 24.01.2008).
Кратко что нового:
Новые команды
PL-CSE -Объединение 2d полилиний по примитиву
PL-SgWidth -Изменить ширину сегмента полилинии

Переписан алгоритм PL-DIV и PL-DIVALL (теперь все делается геометрически)
Переписана и оптимизирована PL-VxRdc (теперь восстанавливает и дуговые сегменты)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.01.2008, 09:39
#89
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Для VVA.
При выполнении команды PL-JOIN получил сообщение:
Код:
[Выделить все]
 
ERRNO # 0: no function definition: LIB:SELSET-TO-VLALIST
Хотел объединить 3 отрезка в полилинию. Не получилось. _PEDIT объединяет нормально.
Profan вне форума  
 
Автор темы   Непрочитано 25.01.2008, 14:08
#90
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Спасибо Владимир, Александр (KAI) мне уже сообщил. Обновил сборку (от 25.01.2008). Найденные Александром отсальные глюки (в основном при работе с тяжелыми [2d] полилиниями) устраню на досуге. Постараюсь не добавить новых.
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 25.01.2008 в 14:38. Причина: Склероз и невнимательность
VVA вне форума  
 
Непрочитано 30.01.2008, 16:46
#91
rus22


 
Регистрация: 30.07.2007
Беларусь
Сообщений: 101


(Продублировал с доунлоада)

А есть ли там функция объеденить в полилинию все отрезки на прямой? Или надо добавить?
Например делаем сечение втулки, кольца, итд, чтобы сделать разрез нужно линии объеденить, joynt конечно помогает но было бы проще одним щелчком или с промежуточным подтверждением, чтобы убедиться что не захвачены линии не входящие в этот объект

Загрузил прогу подключил, а то о чем писал один пост назад (объединение нескольких отрезков на одной прямой в одну сплошную полилинию у меня не получилось, команда (привожу дословно) ОБЪЕДИНИТЬ ВЫБРАННОЕ В 2d ПОЛИЛИНИИ , всего лишь ПРЕОБРАЗОВЫВАЕТ их, но НЕОБЪЕДИНЯЕТ!

Никаких ошибок не сообщает. АКАД2007русифицированный(неРУС)
rus22 вне форума  
 
Автор темы   Непрочитано 30.01.2008, 17:07
#92
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Выложи сюда фрагмент чертежа.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.01.2008, 23:57
#93
rus22


 
Регистрация: 30.07.2007
Беларусь
Сообщений: 101


Выкладываю
ACAD2007 (русификация)
Кстати стоит SPDS4 на всякий случай...
Вложения
Тип файла: dwg
DWG 2004
Пример PLTOOLS.dwg (47.9 Кб, 3528 просмотров)
rus22 вне форума  
 
Непрочитано 31.01.2008, 09:04
#94
Valery Brelovsky

Инженер дорожник
 
Регистрация: 22.10.2007
Израиль
Сообщений: 1,848


Для объединения в полилинию пользуюсь макросом. Данный макрос позволяет не вязку линий, в данном случае 10 в плане. Само собой, что линии на разных уровнях и с разными координатами по Z начала и конца линии, а также 3D линии.

^C^C(progn(setq ssnab (ssget "_I"))(while (not ssnab)(setq ssnab (ssget)))(command "_pedit" "_Multiple" ssnab "" "_Y" "_Join" 10.00 ""));
Valery Brelovsky вне форума  
 
Непрочитано 31.01.2008, 09:18
#95
Valery Brelovsky

Инженер дорожник
 
Регистрация: 22.10.2007
Израиль
Сообщений: 1,848


Цитата:
Сообщение от rus22 Посмотреть сообщение
Выкладываю
ACAD2007 (русификация)
Кстати стоит SPDS4 на всякий случай...
Посмотрел и ваш пример. Если речь идёт о трёх отрезках так между концами отрезков почти 500 мм. Концы отрезков должны совпадать тогда они объедятся через редактирование полилилнии объединить. Команда _join она продлевает и объединяет если отрезки лежат на одной прямой.
Valery Brelovsky вне форума  
 
Автор темы   Непрочитано 31.01.2008, 09:35
#96
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>rus22 Можешь воспользаваться макросом #94. В pltools есть справке, а в енй написано
Цитата:
При объединени полилиний значение допуска (fuzz distance) принимается равным 0!.
В твоем случае невязку нужно задавать где-то 500 единиц.
Кстати твой отрезки прекрасно объединила новая команда PL-CSE с значением допуска 500
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.02.2008, 06:05
#97
rus22


 
Регистрация: 30.07.2007
Беларусь
Сообщений: 101


Блин сообщение с благодарностью куда-то делось

Спасибо за разъяснение ещё раз
эти функции казались очевидными (объединение строк) в необходимости однако с наскоку не получилось, поэтому может в хелп стоит добавить пару строк, да и вообще комментировать в каких случаях большинство участвовавших каким-либо образом в разработке этого хорошего набора его применяют
rus22 вне форума  
 
Непрочитано 01.02.2008, 06:06
#98
rus22


 
Регистрация: 30.07.2007
Беларусь
Сообщений: 101


>>>>очевидными (объединение строк)

Пардон ошибся - линий с разрывами на одной прямой
rus22 вне форума  
 
Непрочитано 01.02.2008, 17:13
#99
Владимир.

Проектирую
 
Регистрация: 10.01.2005
Сообщений: 3,724


Цитата:
Сообщение от KAI Посмотреть сообщение
А что уже начали проектировать газопроводы по дугам!
Всю жизнь был "радиус естественного изгиба" у подземных трубопроводов
Владимир. вне форума  
 
Непрочитано 13.03.2008, 21:48
#100
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA, Только что узнал что PLtools это твоих рук творение. Я без нее давно AutoCAD не представляю. Спасибо большое.
Есть кое что в PLtools, что мне хотелось бы слегка подкорректировать. Когда добавляешь вершину в полилинию почему-то работает только привязка nearest, тогда как очень бывает нужно чтобы работали и другие привязки. Извиняюсь если этот вопрос уже обсуждали. Форум весь я не читал.
Red Nova вне форума  
 
Автор темы   Непрочитано 14.03.2008, 09:21
#101
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Это связано с тем, что за один раз указывается точка и по этой точке выбирается полилиния. Привязки действуют, но только временные. Нажми Shift+ правый клик и выбери нужную.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 14.03.2008, 10:59
#102
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Есть идея новой команды. Часто бывает нужно удалить один из сегментов полилинии, нажал на сегмент и он удален. Может такое уже было, но я не встречал.
Red Nova вне форума  
 
Непрочитано 14.03.2008, 11:01
#103
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


_.break, что ли?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.03.2008, 11:33
#104
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Red Nova И что остается потом?
Если 2 полилинии, то _.break
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 14.03.2008, 11:44
#105
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,383
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
_.break, что ли?
похоже, но наверно хочется чтоб простым указаниием мышкой, что-то вроде этого
Нажмите на изображение для увеличения
Название: sdfsdfsd.jpg
Просмотров: 373
Размер:	16.6 Кб
ID:	4277
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 14.03.2008, 11:49
#106
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от zenon Посмотреть сообщение
похоже, но наверно хочется чтоб простым указаниием мышкой, что-то вроде этого
Вложение 4277
команда trim из экспрессов, делает все именно так...
Елпанов Евгений вне форума  
 
Непрочитано 14.03.2008, 12:19
#107
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,383
<phrase 1=


Цитата:
Сообщение от Елпанов Евгений Посмотреть сообщение
команда trim из экспрессов, делает все именно так...
Угу, вот только еще удаляет то что не надо удалять, да и 2 клика нужно
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 14.03.2008, 12:26
#108
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


zenon, Во во, именно так.
Елпанов Евгений, Енто где, я не нашел в express такого
Red Nova вне форума  
 
Непрочитано 14.03.2008, 14:16
#109
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,440
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Red Nova Посмотреть сообщение
zenon, Во во, именно так.
Елпанов Евгений, Енто где, я не нашел в express такого
Пример:
Изображения
Тип файла: gif 01_028.gif (78.5 Кб, 927 просмотров)
Елпанов Евгений вне форума  
 
Непрочитано 14.03.2008, 14:22
#110
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,383
<phrase 1=


3 клика, нужен 1
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 14.03.2008, 15:16
#111
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Елпанов Евгений, А если линии разных полилиний пересекаются? Trim не всегда то.
Red Nova вне форума  
 
Непрочитано 15.03.2008, 00:22
#112
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Ну если сильно хочется одним кликом, попробуйте:
Код:
[Выделить все]
(defun c:mod-break (/ *error* adoc ent pt_near pt_prev pt_next param)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda () (setq ent (entsel "\nУкажите полилинию <Отмена> : ")))
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
      ) ;_ end of and
     (progn
       (setq pt_near (cadr ent)
             ent     (vlax-ename->vla-object (car ent))
             pt_near (vlax-curve-getclosestpointto ent pt_near)
             pt_prev (vlax-curve-getpointatparam
                       ent
                       (setq param (fix (vlax-curve-getparamatpoint ent pt_near)))
                       ) ;_ end of vlax-curve-getPointAtParam
             pt_next (vlax-curve-getpointatparam ent (1+ param))
             ) ;_ end of setq
       (command "_.break"
                "_none"
                (vlax-vla-object->ename ent)
                "_none"
                pt_prev
                "_none"
                pt_next
                ) ;_ end of command
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Код особо не гонял, предупреждаю сразу.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.03.2008, 09:47
#113
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,148


Когда kpblc вылезает с entsel'ом с последующим vl-ename->vla-jbject'ом, у меня начинается изжога с скердцебиением. А потому - мои бесценные два цента.
Код:
[Выделить все]
(defun c:mod-break (/ *error* adoc util ent pt asp param par_end pts add)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        util (vla-get-utility adoc))
  (vla-startundomark adoc)
  (if (not (vl-catch-all-error-p (vl-catch-all-apply
               '(lambda () (vla-getEntity util 'ent 'pt "\nУкажите полилинию <Отмена> : ")))));not
     (progn
       (setq asp (vla-ObjectIDToObject adoc (vla-get-OwnerID ent))
             pt (vlax-curve-getclosestpointto ent (vlax-safearray->list pt)))             
       (vla-InitializeUserInput util 128 "Начало Конец")
       (setq kw (vla-getKeyword util "Отрезать [Начало/Конец] <Конец>: "))
       (if (= kw "") (set kw "Конец")) 
       (if (= kw "Конец") (setq param 0 par_end (vlax-curve-getparamatpoint ent pt))
         (setq param (1+ (fix (vlax-curve-getparamatpoint ent pt)))
               par_end (vlax-curve-getendparam ent)));if
       (while (<= param par_end)
         (setq pts (append pts (vlax-curve-getpointatparam ent param))
               param (1+ param)));while
       (if (= (vla-get-objectname ent) "AcDbPolyline")
         (setq pts (vl-remove-if '(lambda (x) (= x 0.0)) pts)
               add vla-addLightWeightPolyline)
         (setq add vla-addPolyline));if
       (add asp (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length pts)))) pts)))
       (vla-delete ent)) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Программа работает вперед и назад, kpblc'овские фрагменты оставилены без изменения.
Лентяй вне форума  
 
Непрочитано 15.03.2008, 11:18
#114
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Получил такое сообщение:
Код:
[Выделить все]
 
Команда: MOD-BREAK
Укажите полилинию <Отмена> :
Команда: Отрезать [Начало/Конец] <Конец>: Н
Команда: Ошибка Automation. Недопустимый аргумент coordinates в Coordinates 
property
Команда:
AutoCAD 2006 РУС.
Программа Алексея работает нормально.
Profan вне форума  
 
Непрочитано 15.03.2008, 11:57
#115
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Лентяй, ну побереги уж себя, нам и так без тебя скучно
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.03.2008, 18:31
#116
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Кулик Алексей aka kpblc, Работает, спасибо.


Лентяй,
Код:
[Выделить все]
Command:
MOD-BREAK
Укажите полилинию <Отмена> :
Command: Отрезать [Начало/Конец] <Конец>: Н

Command: bad argument type: symbolp ""
Command:
Command:
MOD-BREAK
Укажите полилинию <Отмена> :
Command: Отрезать [Начало/Конец] <Конец>: К

Command: bad argument type: symbolp ""
Command:
Вот что пишет у меня при использовании твоего варианта. Задумка для меня осталась тайной.
Red Nova вне форума  
 
Непрочитано 16.03.2008, 04:28
#117
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,148


Profan, я по скудости личного кошелька пользуюсь все еще AutoCAD-2005, поскольку на работе мне АвтоКад не положен. А посему. активно пользуюсь удобства ради одним собственноручно открытым багом - заменой имени функции именем переменной. В данном случае, например,
Код:
[Выделить все]
(setq add vla-addLightWeightPolyline)
и
Код:
[Выделить все]
(setq add vla-addPolyline)
Иногда это позволяет сэкономить довольно длинные идентичные куски кода. Видимо, в версиях выше 2005-й этот фокус уже не проходит. Сочувствую всем от этого бага излеченным. В качестве утешения примите "правильный" код.
Код:
[Выделить все]
 (defun c:mod-break (/ *error* adoc util ent pt asp param par_end pts)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        util (vla-get-utility adoc))
  (vla-startundomark adoc)
  (if (not (vl-catch-all-error-p (vl-catch-all-apply
               '(lambda () (vla-getEntity util 'ent 'pt "\nУкажите полилинию <Отмена> : ")))));not
     (progn
       (setq asp (vla-ObjectIDToObject adoc (vla-get-OwnerID ent))
             pt (vlax-curve-getclosestpointto ent (vlax-safearray->list pt)))             
       (vla-InitializeUserInput util 128 "Начало Конец")
       (setq kw (vla-getKeyword util "Отрезать [Начало/Конец] <Конец>: "))
       (if (= kw "") (set kw "Конец")) 
       (if (= kw "Конец") (setq param 0 par_end (vlax-curve-getparamatpoint ent pt))
         (setq param (1+ (fix (vlax-curve-getparamatpoint ent pt)))
               par_end (vlax-curve-getendparam ent)));if
       (while (<= param par_end)
         (setq pts (append pts (vlax-curve-getpointatparam ent param))
               param (1+ param)));while
       (if (= (vla-get-objectname ent) "AcDbPolyline")
         (progn (setq pts (vl-remove-if '(lambda (x) (= x 0.0)) pts))
           (vla-addLightWeightPolyline asp
             (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble
                                                       (cons 0 (1- (length pts)))) pts))));progn
         (vla-addPolyline asp
             (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble
                                                       (cons 0 (1- (length pts)))) pts))));if
       (vla-delete ent)) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Последний раз редактировалось Лентяй, 16.03.2008 в 04:37.
Лентяй вне форума  
 
Непрочитано 16.03.2008, 04:48
#118
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Лентяй, мой личный кошелек тоже скуден, поэтому дома я работаю на чем попало, хоть на 2009. На работе мне продукт положен, однако, из-за скудости кошелька руководителя конторы приходится тоже работать на чем попало, хоть на 2009. Но это временное явление. Стремясь стать независимым служащим, я уже приобрел две коробки с Windows XP HE.

Последний раз редактировалось Profan, 16.03.2008 в 04:56.
Profan вне форума  
 
Непрочитано 25.03.2008, 17:34
#119
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 3,307
Отправить сообщение для Cfytrr с помощью Skype™


Приветствую вас, а можно сделать так чтоб после запуска команда PL-CSE с допуском например 3.5, при повторном запуске сохраняла ранее введенное значение допуска <3.5>, а не сбрасывала его на <0>?
И незнаю, насколько это возможно, сделать алгоритм соединения зависимым не только от "допуска", но и от min величины "угла" примыкания соединительного отрезка.
Cfytrr вне форума  
 
Автор темы   Непрочитано 25.03.2008, 17:44
#120
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Про запоминание значения не проблема, а про "угол" надо подумать. Вся проблема в алгоритме.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 28.03.2008, 11:06
#121
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


По просьбе отсюда
Утилита объединения набора линий в полилинию
Должна выбирать все (сначала и с конца) найденные примитивы в цепочку
см. #140
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 03.04.2008 в 10:38.
VVA вне форума  
 
Непрочитано 28.03.2008, 11:32
#122
Tonic


 
Регистрация: 26.06.2007
Воронеж
Сообщений: 135


У меня в AutoCAD 2005 (и в 2008) всё равно не хочет объединять все сегменты, даже если первый или последний выбрать! То часть сегментов определит, то только слева направо от выделенного. Ну а Bricscad вообще отказался работать =)

Последний раз редактировалось Tonic, 28.03.2008 в 12:31.
Tonic вне форума  
 
Автор темы   Непрочитано 28.03.2008, 13:16
#123
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Изменил код в #121 Пробуй снова. BricsCad не поддерживает Visual LISP
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 28.03.2008, 13:22
#124
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Цитата:
Сообщение от VVA Посмотреть сообщение
Изменил код в #121 Пробуй снова. BricsCad не поддерживает Visual LISP
Не совсем так. 8-ка ActiveX уже поддерживает. Правда, не в полном объеме, там надо практически построчно проходить выполнение.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.03.2008, 14:11
#125
Tonic


 
Регистрация: 26.06.2007
Воронеж
Сообщений: 135


Заработало! Спасибо!
Tonic вне форума  
 
Непрочитано 28.03.2008, 19:36
#126
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA, Мне просто стало интересно, ты время от времени пополняешь PLTools такими лиспами, как на #121, или нет? Если да, то мне давно пора сделать апгрейт.
Red Nova вне форума  
 
Непрочитано 31.03.2008, 02:04
#127
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Запускаем:
Command: css

Выбрать линию в цепи :
Значение допуска < 0.01 >:
_.redraw
Command: _pedit Select polyline or [Multiple]: _M
Select objects: 10 found

Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]: _j
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: _j
Enter join type [Extend/Add/Both] <Both>: _b
Join Type = Both (Extend or Add)
Enter fuzz distance or [Jointype] <0.010>: 0.010000000000000
9 segments added to polyline

Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Undo]:
Command: ._select
Select objects: 1 found

Select objects:
Command:


Мур-мур бы убрать...
И в добавок. Гораздо интереснее было бы соединять в полилинию только те объекты, которые ближе к выбранному концу объекта, а с другого конца объекта их игнорировать.
Или может быть оформить это опциями (All по умолчанию, Next - только ближайшие к концу).
И по окончанию работы программы - статистику (сколько объединено объектов).
p.s. В PL-CSE (pltools) то же было бы неплохо "загрипсовать объект".
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 31.03.2008, 10:56
#128
bonnata


 
Регистрация: 21.03.2008
Сообщений: 1


Спасибо авторам за ОЧЕНЬ нужные программы!
А возможно ли такое? Сгруппировать полилинию с пересекающими ее объектами (отрезками, блоками). при этом разворачивая углы полилинии на 180 (очень бы помогло для построения развернутого плана трубопроводов).
bonnata вне форума  
 
Автор темы   Непрочитано 31.03.2008, 15:06
#129
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


В №121 обновил команду CSS. По моему получилось неплохо. Можно рассатривать как кандидат на замену PL-CSE.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 31.03.2008, 16:35
#130
Tonic


 
Регистрация: 26.06.2007
Воронеж
Сообщений: 135


Bricscad то вылетает, то зависает =)
Tonic вне форума  
 
Автор темы   Непрочитано 31.03.2008, 18:49
#131
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Tonic см. #124. Я пока ориетнируюсь на Автокад.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.04.2008, 01:42
#132
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>>VVA
А где _VXGRDRAW?

Выбрать линию в цепи :; error: no function definition: _VXGRDRAW

Добавьте, пожалуйста!
p.s. Опции устраивают.
p.p.s. А когда будет обновление сборки pltools. Народ любит обновления любимых программ.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 01.04.2008, 10:11
#133
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


_vxgrdraw mip_grdraw добавил в #121. Если устраивают опции, их содержание и вид, то обновлю функционал PL-CSE.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.04.2008, 16:47
#134
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 3,307
Отправить сообщение для Cfytrr с помощью Skype™


Цитата:
Сообщение от VVA Посмотреть сообщение
команду CSS... Можно рассатривать как кандидат на замену PL-CSE.
Лично меня PL-CSE устраивает больше.
1. CSS прекращает соединять элементы в цепочку после соединения "разрыва".
2. В CSS очень муторно высматривать куда ткнуть мышой чтоб угадать ближайшую вершину в отрезке, в PL-CSE просто указываешь первый и все.
Cfytrr вне форума  
 
Непрочитано 02.04.2008, 02:13
#135
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA (не сочтите занудой, но...)
Теперь потерялась функция pl(двоеточие)DTR
(извини, вставил сам для просмотра)
1. По умолчанию лучше дать опцию "Обе"
2. Строить цепочку от ближайшей точки [Ближайшая/Противоположная/Обе] <Ближайшая>: - здесь чуть-чуть не по русски. Может так:
Соединять от ближайшей точки [Ближайшей/Противоположной/Все]
3. Застарелая проблема. Пока 2 раза не нажмешь U - действие команды не отменится.
4. Строить цепочку от ближайшей точки [Ближайшая/Противоположная/Обе]
<Ближайшая>:
Нажимае Esc, далее:
*Cancel*
; error: Function cancelled
Это уже лишнее, пользователь и так ее явно прервал.
5. Выбрать линию в цепи :
Строить цепочку от ближайшей точки [Ближайшая/Противоположная/Обе] <Ближайшая>: G
Invalid option keyword. (Но тем не менее все идет далее...)
Значение допуска < 0.01 >:
6. Значение допуска лучше задать 0.0 (будем приучать пользователей к точности).
7. Рисуем несколько линий, у одних задаем в общем узле отметку Z отличную от 0. Запускаем программу по опции "Обе". Грипсы по всей цепочке линий (пользователь думает, что соединено!), но соединяет, естественно только линии с Z=0.
8. И наконец, было бы неплохо, если последняя опция, выбранная пользователем, сохраналась, например, он выбрал "Ближайшая", вот и пусть при повторном запуске программы ему и была предложена эта опция.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 02.04.2008, 22:02
#136
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA, По поводу #121. У меня не работает.
Запускаю команду CSS

Цитата:
Command: css

Выбрать линию в цепи :; error: no function definition: PLTR

Command:
А как должно в правильном варианте быть?
Я путаю что должна делать CSS, а что DTR.
При команде DTR

Цитата:
Command: dtr

DS> Pick Starting Point:
DS> Angle/Close/Flip/Intersect/Left/Right/North/South/East/West <Distance>:

Command:
Я не могу понять что там к чему.

Как я понял основная задумка в том, чтобы нажав скажем на линию, все объекты которые концами образуют с ней цепочку соединялись. Я правильно понял? У меня так не выходит.
Red Nova вне форума  
 
Непрочитано 02.04.2008, 22:05
#137
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Написал и обнаружил что PL : DTR отображается как PLTR. Забавно
Red Nova вне форума  
 
Автор темы   Непрочитано 03.04.2008, 09:27
#138
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


> Red Nova Я добавил эти ф-ции в #121. А вообще они все есть в pltools, поэтому достаточно вызвать любую команду pltools, а затем CSS. У меня все грузится автоматом, поэтому кое-какие библиотечные ф-ции вечно забываю.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2008, 09:53
#139
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA, Ты меня только запутал.
Цитата:
А вообще они все есть в pltools, поэтому достаточно вызвать любую команду pltools, а затем CSS.
Что конкретно есть в pltools.
Что должна делать команда CSS? У меня pltools есть, вызываю любую команду потом CSS, и нечего

Цитата:
Command: PL-VxAdd

Укажите точку разрыва [отмени U/выход X] <выход> : css

Point or option keyword required.
А как соеденить находящиеся в цепочке объекты я так и не понял.
Red Nova вне форума  
 
Автор темы   Непрочитано 03.04.2008, 10:37
#140
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Новая версия CSS. С учетом замечаний KAI кроме №7 и Red NOva #145
Код:
[Выделить все]
;;* Утилита объединения набора линий в полилинию*
;;* Должно выбирать все (сначала и с конца) найденные примитивы в цепочку)
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - Список точек для выбранных примитивов в МСК !!!
;; fuzz - точность
;;Возвращает список vla объектов
(defun ChainSelectFromAny1 ( pt obj fuzz / chain_list couple line_lst ln ss cycl line_list )
(vl-load-com)
(if (setq ss (ssget "_I")
          ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))
    ) ;_ end of setq
  (progn
    (setq line_lst  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (list obj)
    ) ;_ end of setq
    (setq line_lst (vl-remove-if
                      '(lambda (x)
                         (eq "AcDb3dPolyline" (vla-get-objectname x))
                       ) ;_ end of lambda
                      line_lst
                    ) ;_ end of vl-remove-if
    ) ;_ end of setq
     (setq line_lst (vl-remove obj line_lst))
    (setq cycl 0 line_list line_lst)
    (foreach pt_Pattern pt
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (vlax-curve-getStartPoint x)
                                        pt_Pattern
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        pt_Pattern
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
       (if couple
           (progn
             (setq chain_list (cons (car couple) chain_list))
             (setq ln (car chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq pt_Pattern (if (equal pt_Pattern (vlax-curve-getStartPoint ln) 1e-6)
                                (vlax-curve-getEndPoint ln)
                                (vlax-curve-getStartPoint ln)
                                )
                   )
           ) ;_ end of progn
         ) ;_ end of if
      )
   )
  ) ;_ end of progn
) ;_ end of if
chain_list
)
;;;Ф-ция переводит градусы в радианы
;;;( pl:DTR a)
(defun pl:DTR (a)(* pi (/ a 180.0)))
;;;---------------------------------------------
;;;Ф-ция переводит радианы в градусы
;;;( R2D a)
(defun pl:RTD (a)(/ (* a 180.0) pi))
(defun mip_grdraw ( ptdraw ang color / pt1 pt2 )
  (setq pt1 (polar ptdraw (+ ang (pl:DTR 135)) (* 0.05 (getvar "VIEWSIZE"))))
  (setq pt2 (polar ptdraw (+ ang (pl:DTR 225)) (* 0.05 (getvar "VIEWSIZE"))))
  (grvecs (list color pt1 ptdraw ptdraw pt2))
  )
(defun _vxgrdraw ( ptdraw color / ang pt11 pt12 pt21 pt22 len )
  (setq len (* 0.03 (getvar "VIEWSIZE"))
       ang 0
       pt11 (polar ptdraw (+ ang (pl:DTR 225)) len)
       pt12 (polar ptdraw (+ ang (pl:DTR 45)) len)
       pt21 (polar ptdraw (+ ang (pl:DTR 315)) len)
       pt22 (polar ptdraw (+ ang (pl:DTR 135)) len))
  (grvecs (list color pt11 pt12 pt21 pt22))
  )
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:mark
;;;* Mark data base to allow KB:catch.
;;;*http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
   (setq val (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast))
      nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)
      )
   )
   (setvar "cmdecho" val)
   (princ)
)
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:catch
;;;* returns selection set of entities since last KB:mark.
;;;*
(defun mip:get-last-ss (/ ss tmp)
   (if *mip:mark
      (progn (setq ss (ssadd))
             (while (setq *mip:mark (entnext *mip:mark)) (ssadd *mip:mark ss))
             (command "._select" ss "")
             (setq tmp ss)
      )
      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
   )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
 
(defun C:CSS ( / ss en fuzz obj pt pt1 len dst ptother what lst *error*)
 (vl-load-com)
 (defun *error* (msg)(princ msg)
   (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))(princ))
 (vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object))) 
 (setvar "cmdecho" 0) 
 (if (and (setq en (entsel "\nВыбрать линию в цепи :"))
          (wcmatch (cdr(assoc 0 (entget (car en)))) "ARC,LINE,*POLYLINE")
          (setq obj (vlax-ename->vla-object (car en)))
          (cond ((=(vla-get-ObjectName obj) "AcDb3dPolyline")
                 (princ "\n3d Полилиния. ") nil)
                ((and (=(vla-get-ObjectName obj) "AcDbLine")
                      (not(equal (last(cdr(assoc 10 (entget(car en)))))
                             (last(cdr(assoc 11 (entget(car en)))))
                             1e-9
                             )
                          )
                      )
                 (princ "\nОтрезок. Разные координаты Z. ") nil)
                ((and (=(vla-get-ObjectName obj) "AcDb2dPolyline")
                     (member (vla-get-Type obj) '(1 2 3)))
                 (princ "\n2d сглаженная полилиния. ") nil)
                (t t)
                )
          )
 (progn
 (setq pt1 (trans (cadr en) 1 0))  
 (setq pt1 (vlax-curve-getclosestpointto obj pt1))
 (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
 (setq dst (vlax-curve-getDistAtPoint obj pt1))
 (if (<= dst (- len dst))
   (setq pt (vlax-curve-getStartPoint obj) ptother (vlax-curve-getEndPoint obj))
   (setq pt (vlax-curve-getEndPoint obj) ptother (vlax-curve-getStartPoint obj))
   )
  (_vxgrdraw (trans pt 0 1) -1)
(mip_grdraw (trans pt1 0 1)
  (angle (trans pt1 0 1)(trans pt 0 1)) 1)
 (initget "Ближайшая Противоположная Обе Nearest Opposite Both _Nearest Opposite Both Nearest Opposite Both")
 (princ "\nСтроить цепочку от ближайшей точки [Ближайшая/Противоположная/Обе] <Обе>:")
 (setq what (getkword))
 (cond ((= what "Opposite")
        (setq pt (list ptother))
        (vl-cmdf "_.redrawall")
        (_vxgrdraw (trans ptother 0 1) -1)
        (mip_grdraw (trans pt1 0 1)
  (angle (trans pt1 0 1)(trans ptother 0 1)) 1)
        )
       ((= what "Nearest") (setq pt (list pt)))
       (t (setq pt (list pt ptother)))
       )
 
 (if (null *FUZZ*)(setq *FUZZ* 0.0))
 (princ "\nЗначение допуска < ")(princ *FUZZ*)(princ " >: ")
 (if (null (setq fuzz  (getdist)))
   (setq fuzz *FUZZ*))
 (setq *FUZZ* fuzz)
 (vl-cmdf "_.redrawall")
 (setq ss nil ss (ssadd (car en)))
       
 (setq lst (ChainSelectFromAny1 pt obj (+ fuzz 1e-6)))
 (foreach item lst
      (ssadd (vlax-vla-object->ename item) ss)
    )
  (mip:mark)
  (vl-catch-all-apply '(lambda()
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    )
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))
  (setq ss nil)
  )
   (princ " Невожможно преобразовать в полилинию")
   )
 (vla-EndUndoMark(vla-get-ActiveDocument(vlax-get-acad-object)))
  (princ)
  )
(princ "\nНаберите CSS в командной строке")
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 09.04.2008 в 13:48. Причина: Новая версия
VVA вне форума  
 
Непрочитано 03.04.2008, 10:47
#141
nastasja

инженер
 
Регистрация: 03.04.2008
СПб
Сообщений: 45
<phrase 1=



Мне нужно преобразовать полилинию в дуговой сегмент. ПРоги я отсюда скачала, сделала, как написано в сопроводиловке txt, но что значит "активировать панель" я не поняла. Раньше я программированием и 3D не занималась, но теперь диплом делаю, так что приходится осваивать..
nastasja вне форума  
 
Непрочитано 03.04.2008, 20:36
#142
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 3,307
Отправить сообщение для Cfytrr с помощью Skype™


VVA, у меня по прежнему после соединения разрыва между отрезками #140 останавливатся и остальные отрезки не соединят
AutoCad 2005, 2009

Последний раз редактировалось Cfytrr, 03.04.2008 в 23:11.
Cfytrr вне форума  
 
Автор темы   Непрочитано 04.04.2008, 09:50
#143
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>nastasja "активировать панель" - значит сделать панельку с кнопками видимой.
Цитата:
Мне нужно преобразовать полилинию в дуговой сегмент
требует дополнительного разъяснения. Что-то мне подсважывает, что для твоих задач _pedit'a за глаза хватит
>Cfytrr Кинь примерчик на почту.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.04.2008, 14:56
#144
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA лисп с #140 работает нормально. Спасибо.

P.S. Отлично придумано с допуском
Red Nova вне форума  
 
Непрочитано 07.04.2008, 15:30
#145
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA, Есть пожелание по поводу CSS. Обычно когда соединяют объект к другому, то свойства первого передаются второму. Только что пробовал соединить дугу к полилиние (первый объект - дуга). Так в этом случае соединенная полилиния принимает свойства второго объекта. Лучше бы было если бы тут все было как в обычном join.
Red Nova вне форума  
 
Автор темы   Непрочитано 09.04.2008, 13:51
#146
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Здесь обсуждаются предложения. Это не значит что я немедленно брошусь все исправлять/дописывать. У меня тоже есть работа. Предложения берутся на заметку и исправляются/доделываются в следующей версии. Если это действительно очень важно, то обновил код в #140 с учетом твоих пожеланий и замечаний KAI #135, кроме №7
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.04.2008, 16:06
#147
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Не стреляй, здаюсь. Просто думал ты не счел это важным, раз не ответил.
Удалил постыдное сообщение, раз оно тебя так разозлило.
Лисп опробовал, все работает.
Большое спасибо.

Последний раз редактировалось Red Nova, 10.04.2008 в 12:34.
Red Nova вне форума  
 
Непрочитано 04.06.2008, 09:51
#148
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


да эти PLTOOLS,у меня 2006 КАД,эти все функции у меня работали в один прекрасный момент перестали работать,из за чего не пойму
Nikolays вне форума  
 
Автор темы   Непрочитано 04.06.2008, 10:17
#149
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Nikolays,
1. Что выдает при попытке вызвать команду?
2. Попробуй в командной строке набрать _appload и загрузить pltools.fas из папки PLTOOLS, потом вызвать какую-либо команду
3. Тоже самое по п.2, только загрузи файл pltools.lsp из подпапки LISP папки PLTOOLS
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 05.06.2008, 09:14
#150
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


это всё я сделал,но при выполнении команд выдаёт сообщение:ERRNO # 0: no function definition: nil,Выберите Полилинию, Сплайн или Отрезок для реверса <хватит>:ERRNO # 2: no
function definition: VLAX-ENAME->VLA-OBJECT,*error* functionAutoCAD variable setting rejected: "CMDECHO" nil
Nikolays вне форума  
 
Автор темы   Непрочитано 05.06.2008, 09:58
#151
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


В PLTOOLS (vl-load-com) грузится автоматом при загрузке файла.
Nikolays,
1. Скопируй или набери в командной строке (vl-load-com)
2. Затем (vlax-get-acad-object)
Должно возвращать что-то типа #<VLA-OBJECT IAcadApplication 00c2eb8c>
А у тебя что пишет?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.06.2008, 12:09
#152
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


при запуске команды"vl-load-com"выдаёт сообщение:Команда: vl-load-com
Unknown command "VL-LOAD-COM". Press F1 for help
при запуске команды"vlax-get-acad-object":выдаёт сообщение:Unknown command "VLAX-GET-ACAD-OBJECT". Press F1 for help.
Nikolays вне форума  
 
Непрочитано 06.06.2008, 12:58
#153
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


при копировании и вставке (vlax-get-acad-object)
выдаёт:
#<VLA-OBJECT IAcadApplication 00c2db8c>
Nikolays вне форума  
 
Автор темы   Непрочитано 06.06.2008, 13:49
#154
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Что еще могу посоветовать:
1. Попробуй скачай последнюю версию
2. Создай новую учетную запись и попробуй в ней
3. попробуй pltools на другой машине
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.06.2008, 18:42
#155
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


У меня последняя версия pltools,на других машинах работает без проблем,да и на этой машине работали все команды,а потом перестали
Nikolays вне форума  
 
Непрочитано 07.06.2008, 02:44
#156
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Цитата:
Сообщение от Nikolays Посмотреть сообщение
У меня последняя версия pltools,на других машинах работает без проблем,да и на этой машине работали все команды,а потом перестали
Мистика, однако!
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 07.06.2008, 10:03
#157
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


VVA,
Цитата:
Попробуй скачай последнюю версию
Кстати, а где ее качать?
__________________
Блог
Red Nova вне форума  
 
Автор темы   Непрочитано 09.06.2008, 10:03
#158
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Red Nova, см. пост #1
Nikolays, Еще пара советов в порядке предпостения:
1. Попробуй на своей машине завести новую учетную запись и попробывать там pltools (рекомендация #154 №2)
2. Попробывать удалить Автокад и поставить снова.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 09.06.2008, 10:05
#159
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Offtop: Теперь 1-й пост прикрепляется вверху каждой страницы. Удобно
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 12.06.2008, 08:55
#160
Nikolays

INJENER
 
Регистрация: 03.05.2007
Kazakhstan
Сообщений: 152


с новой учётной записью Pltools тоже не работает
Nikolays вне форума  
 
Автор темы   Непрочитано 12.06.2008, 10:21
#161
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


А п.2 из #158 ?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.06.2008, 08:47
#162
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


а такое добавить не хотите?
бывает нужно провести часть полилинии по уже существующему контуру/контурам
хотелось бы нечто очень юзер-френдли - рисую полилинию стандартной командой, нужно провести по существующему контуру, запускаю команду, тыкаю начальную точку, тыкаю конечную, продолжаю рисовать полилинию.
Будете такое добавлять?)
Димас вне форума  
 
Непрочитано 17.06.2008, 08:40
#163
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
Подумал-подумал, посоветовался с гл.геологом, и решил: действительно, будет полезно иметь в PLTOOLS такую штуку.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 17.06.2008, 09:17
#164
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


Забыл ТУ:
Координаты начала новой полилинии по первой точке исходной полилинии (координаты в UCS).
Далее точки новой полилинии должны идти в плоскости UCS, естественно, что если прежняя полилиния не находится в этой плоскости, то ее точки должны проецироваться на плоскость UCS.
Для нас дуги на исходной полилинии можно игнорировать, но лучше их сохранять, мало-ли кому это важно.
Начало не мешало-бы пометить крестиком.
Привязка при указании 1-й и 2-й точки на исходноий полилинии по умолчанию - END, но возможны и другие, выбираемые пользователем (NEA, MID и др.)
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Автор темы   Непрочитано 17.06.2008, 17:25
#165
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Димас, KAI, Вычлинить из готовой полилинии набор сегментов не проблема. По принципу PL-CLONE, только там выделяешь сегменты, а здесь начало и конец. Я пока не знаю как "скрестить" стандартную команду рисования полилинии, возможность добавления некоторого количеста вершин и затем опять продолжения рисования полилинии ?
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 22.06.2008 в 11:04. Причина: Орфография
VVA вне форума  
 
Непрочитано 18.06.2008, 04:35
#166
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>>VVA
А если немного упростить вышесказанное (кстати, на это и указывал Димас):
1. Начинаем на исходной полилинии.
2. Задаем 2-ю точку на исходной полилинии.
3. Дальнейшее указание точек новой полилинии (опции команды PLINE не нужны, показ новой виртуальной полилинии весьма приветствуется), то есть только прямые сегменты для новой полилинии , + опция 'Замкнуть'.
4. При отказе от новой точки или по Close отрисовывается новая полилиния (сначала от 1-й до 2-й точки исходной, а затем, по заданным пользователем точкам). Можно по Esc (+ опция Exit) сделать так, чтобы новая полилиния не отрисовывалась.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 22.06.2008, 02:24
#167
MIP

инженер
 
Регистрация: 13.12.2004
Минск
Сообщений: 496


VVA сейчас в отпуске отвечу за него.
1. Мое мнение всунуть эту возможность в именно в стандартную команду отрисовки полилинии не получется, я видел как это работает в другой программе, там собственная команда создания полилиний (контуров) с возможностью трассировки по другому контуру.
2. Скорее всего прийдется писать заменитель стандартной команды. Выглядеть он будет примерно так:
- Будут запрашиватся точки вершин будущей полилинии, с опциями полилинии, но в место полилинии создавть временную геометрию (отрезки, дуги) с включением их в набор
- Будет опция трассировки по существующему контуру, т.е. от точки начала трассировки по контуру до точки конца трассировки по контуру
- В случае замкнутого контура дополнительно прийдется задать сторону по которой пройдет трассировка, создается временное построение трассировки по контуру включаемое в набор
- далее продолжаем ввод координат вершин полилинии с опциями полилинии или трассировку по другому контуру, опять же со временными построениями с включениями в набор.
- по окончанию построений все объединяется в одну полилинию.
В качетсве настроек цвет временных построений и толщина (вес) линий для визуального наблюдения.
Сложности будут при переходе трассировки с одного контура на другой в точке их пересечения (может быть точкой пересечения множества контуров), возможно дополнительно прийдется указать тот контур по которому будет осуществлятся трассирование далее. Кроме того возможно понадобится трассировка по контуру блока, сплайна и т.п.
Но в общем цель ясна, покожу VVA на примерах.
Кто хочет или знает как лучше дополняйте.
MIP вне форума  
 
Непрочитано 15.08.2008, 13:28
#168
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


В выложенном архиве нет такого файла:
pltools.cui -- меню для подгрузки в AutoCAD с 2006 включительно
Do$ вне форума  
 
Автор темы   Непрочитано 18.08.2008, 19:55
#169
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Do$, Спасибо, выйду из отпуска - исправлю. А пока можно делать так, как написано в readme.txt:
Цитата:
========= Как пользоваться =========
1. Поместите файлы в папку, прописанную в путе доступа к вспомогательным файлам
(Сервис->Настройка->Файлы->Путь доступа к вспомогательным файлам)
2. командой _menuload подгрузить файл pltools.mnu, активизировать панель pltools
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.08.2008, 20:03
#170
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Цитата:
>VVA
Я пока не знаю как "скрестить" стандартную команду рисования полилинии, возможность добавления некоторого количеста вершин и затем опять продолжения рисования полилинии ?
>MIP
Мое мнение всунуть эту возможность в именно в стандартную команду отрисовки полилинии не получется
Собственно это решается (использование стандартной команды "_pline") с помощью простейшей конструкции
Код:
[Выделить все]
 
(command "_pline")
(apply 'command lst)
А язык LISP позволяет создать практически любые списки...
Пример ниже показывает, что это возможно. Акцентирую внимание - это пример, а не готовая функция, т.к. в нем пока не решен вопрос, какую часть полилинии брать если точка выбрана в пересечении сегментов полилинии, ну и не стал заморачиваться с выбором первой точки - новая полилиния строиться от начала и до точки указанной пользователем с продолжением рисования...
Код:
[Выделить все]
(defun c:test (/ test test1 sys_var pl lst)
  (defun test1 (str)
    (if str
      (cons (car str) (test1 (cdr str)))
      (test (cdr lst) "_a")
    ) ;_ end of if
  ) ;_ end of defun
  (defun test (lst l-or-a)
    (cond
      ((null lst) nil)
      ((listp (car lst))
       (cons (car lst) (test (cdr lst) l-or-a))
      )
      ((and (= (car lst) 0.0) (= l-or-a "_l"))
       (test (cdr lst) l-or-a)
      )
      ((and (= (car lst) 0.0) (/= l-or-a "_l"))
       (cons "_l" (test (cdr lst) "_l"))
      )
      ((and (/= (car lst) 0.0) (= l-or-a "_l"))
       (cons "_a"
      (test1 (list "_a" (/ (* 180 4.0 (atan (car lst))) pi)))
       ) ;_ end of cons
      )
      (t (test1 (list "_a" (/ (* 180 4.0 (atan (car lst))) pi))))
    ) ;_ end of cond
  ) ;_ end of defun
  (setq sys_var (mapcar 'getvar '("cmdecho" "cecolor")))
  (setvar 'cmdecho 0)
  (setvar 'cecolor "1")
  (setq pl (car (entsel "\nВыберите pline: ")))
  (if (and pl
    (setq pl (vlax-ename->vla-object pl))
    (= (vla-get-ObjectName pl) "AcDbPolyline")
      ) ;_ end of and
    (vl-catch-all-apply
      (function
 (lambda ()
   (command "_pline")
   (apply 'command
   (test
     ((lambda (p)
        (repeat (+ 2 (fix p))
   (setq lst
          (cons
     (list
       (vlax-curve-getpointatparam pl p)
       (cond
         ((equal (type p) 'REAL)
          (setq temp
          ((lambda (x)
      (/ (sin x) (cos x))
           ) ;_ end of lambda
            (* (rem p 1)
        (atan (vla-getbulge
         pl
         (fix p)
       ) ;_ end of vla-getbulge
        ) ;_ end of atan
            ) ;_ end of *
          )
          ) ;_ end of setq
          0.0
         )
         ((and temp
        (not (equal (vla-getbulge pl p) 0.0))
          ) ;_ end of and
          ((lambda (x) (setq temp nil) x) temp)
         )
         (t (setq temp nil) (vla-getbulge pl p))
       ) ;_ end of cond
     ) ;_ end of list
     lst
          ) ;_ end of cons
   ) ;_ end of setq
   (if (equal (type p) 'REAL)
     (setq p (fix p))
     (setq p (1- p))
   ) ;_ end of if
        ) ;_ end of repeat
        (setq lst (vl-remove nil (apply 'append lst)))
      ) ;_ end of lambda
       (vlax-curve-getparamatpoint
         pl
         (getpoint "\nТочка на полилинии: ")
       ) ;_ end of vlax-curve-getparamatpoint
     )
     "_l"
   ) ;_ end of test
   ) ;_ end of apply
 ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
    (princ
      "\nВыбранный объект не полилиния или не выбран вообще..."
    ) ;_ end of princ
  ) ;_ end of if
  (mapcar 'setvar '("cmdecho" "cecolor") sys_var)
  (princ)
) ;_ end of defun
CB вне форума  
 
Непрочитано 01.09.2008, 10:58
#171
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Решил внести в PLTOOLS и свой вклад...
Прошу потестировать программу, сделанную по мотивам #162 :
Код:
[Выделить все]
(defun c:test (/ test sys_var pl)
  (defun test (lst l-or-a temp)
    (cond
      ((null lst) nil)
      (temp
       (if (equal (car temp) "")
  (test lst l-or-a (cdr temp))
  (cons (car temp) (test lst l-or-a (cdr temp)))
       ) ;_ end of if
      ) ;_ end of temp
      ((null (caddr lst))
       (if (equal l-or-a "_l")
  (list (car lst))
  (list (car lst) "_l")
       ) ;_ end of if
      )
      ((equal (cadr lst) 0.0)
       (if (equal l-or-a "_a")
  (test (cddr lst) "_l" (list (car lst) "_l"))
  (cons (car lst) (test (cddr lst) l-or-a temp))
       ) ;_ end of if
      )
      (t
       (test
  (cddr lst)
  "_a"
  (list
    (car lst)
    (if (equal l-or-a "_a")
      ""
      "_a"
    ) ;_ end of if
    "_s"
    (trans
      (vlax-curve-getpointatparam
        pl
        (/
   (+ (vlax-curve-getparamatpoint
        pl
        (trans (caddr lst) 1 0)
      ) ;_ end of vlax-curve-getparamatpoint
      (vlax-curve-getparamatpoint pl (trans (car lst) 1 0))
   ) ;_ end of -
   2.
        ) ;_ end of /
      ) ;_ end of vlax-curve-getpointatparam
      0
      1
    ) ;_ end of trans
  ) ;_ end of list
       ) ;_ end of test
      ) ;_ end of t
    ) ;_ end of cond
  ) ;_ end of defun
  (setq sys_var (mapcar 'getvar '("cmdecho" "cecolor")))
  (setvar 'cmdecho 0)
  (setvar 'cecolor "1")
  (setq pl (car (entsel "\nВыберите pline: ")))
  (if (and pl
    (setq pl (vlax-ename->vla-object pl))
    (= (vla-get-ObjectName pl) "AcDbPolyline")
      ) ;_ end of and
    (vl-catch-all-apply
      (function
 (lambda ()
   (vl-cmdf "_pline")
   (apply 'vl-cmdf
   (test
     (apply
       '(lambda (p1 p2)
   ((lambda (lst)
      (if (apply '< (list p1 p2))
        lst
        (mapcar '(lambda (y)
     (if (numberp y)
       (- y)
       y
     ) ;_ end of if
          ) ;_ end of lambda
         ((lambda (x)
     (cdr (reverse x))
          ) ;_ end of lambda
           lst
         )
        ) ;_ end of mapcar
      ) ;_ end of if
    ) ;_ end of lambda
     ((lambda (param act n / lst)
        (while (<= n param)
          (setq lst
          (append
     lst
     (cons (trans
      (vlax-curve-getpointatparam
        pl
        (if ((eval act) n param)
          param
          n
        ) ;_ end of if
      ) ;_ end of vlax-curve-getpointatparam
      0
      1
           ) ;_ end of trans
           (list (vla-getbulge pl n))
     ) ;_ end of cons
          ) ;_ end of append
          ) ;_ end of setq
          (setq param (max p1 p2)
         act   '>=
          ) ;_ end of setq
          (if (and (equal n (fix param))
     (not (equal n param))
       ) ;_ end of and
     (setq n param)
     (setq n (1+ n))
          ) ;_ end of if
        ) ;_ end of while
        lst
      ) ;_ end of lambda
       (min p1 p2)
       '<
       (fix (min p1 p2))
     )
   )
        ) ;_ end of lambda
       (mapcar
         '(lambda (x / pt p)
     (setq pt (trans (getpoint x) 1 0))
     (while (not (setq p
          (vlax-curve-getparamatpoint
            pl
            pt
          ) ;_ end of vlax-curve-getparamatpoint
          ) ;_ end of setq
     ) ;_ end of not
       (setq pt
       (trans
         (getpoint
           "\rТочка не на полилинии. Повторите выбор: "
         ) ;_ end of getpoint
         1
         0
       ) ;_ end of trans
       ) ;_ end of setq
     ) ;_ end of while
     p
   ) ;_ end of lambda
         (list
    "\nПервая точка на полилинии: "
    "\nВторая точка на полилинии: "
         ) ;_ end of list
       ) ;_ end of mapcar
     ) ;_ end of apply
     "_l"
     nil
   ) ;_ end of test
   ) ;_ end of apply
 ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
    (princ
      "\nВыбранный объект не полилиния или не выбран вообще..."
    ) ;_ end of princ
  ) ;_ end of if
  (mapcar 'setvar '("cmdecho" "cecolor") sys_var)
  (princ)
) ;_ end of defun
PS: Наверняка надо что-то делать с толщиной создаваемой полилинии, т.е. чтобы она повторяла толщины исходной...

Последний раз редактировалось CB, 01.09.2008 в 16:00. Причина: Теперь можно работать и в UCS, а не только в WCS...
CB вне форума  
 
Автор темы   Непрочитано 01.09.2008, 11:36
#172
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Это мой тестовый чертеж для pltools. Прислал в свое время KAI. Ругается на синюю полилинию, что точка не на ней.
Вложения
Тип файла: dwg
DWG 2004
test KAI.dwg (190.7 Кб, 3542 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 01.09.2008 в 16:08.
VVA вне форума  
 
Непрочитано 01.09.2008, 16:05
#173
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>VVA
Исправлено в #171 - забыл про trans...
CB вне форума  
 
Непрочитано 04.12.2008, 10:19
#174
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 3,307
Отправить сообщение для Cfytrr с помощью Skype™


сегодня заметил что в 2009 Акаде x64 не работают команды:
PL-VxAdd, ConvTo3d,
пишет:
; warning: unwind skipped on unknown exception.
Остальные команды вроде работают... На 32 битной версии все работает нормально
Cfytrr вне форума  
 
Автор темы   Непрочитано 04.12.2008, 12:48
#175
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


К сожалению пока не на чем проверить, но возьму на заметку.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 05.12.2008, 02:30
#176
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>> VVA
А помнится, кто-то обещал "намедни" выложить обновленный pltools с исправленными багами и дополнениями?
Переписку напомнить?
Народ ждет давно. Это семейство программ им очень нравится.
p.s. А командировки только в Москву? А в Магадан? Готов поделиться комнатой и даже сдать в аренду Мурзика (для сугрева и сняния напряжения).
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 15.12.2008, 20:41
#177
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,970
Отправить сообщение для Red Nova с помощью Skype™


Про PL-VxAdd
Единственное что мне в этой команде раньше казалось неправильным было то что привязка во время работы команды отключалась, по моему это создает лишнее неудобство, но со временем, освоив азы лиспа, я это у себя подправил, поменяв в коде строку с osmode на ("osmode" 16383), чего всем и рекомендую, в таком случае будут включены все привязки. Ну или можно вообще не трогать привязки, и удалить соответствующие строки из кода. Хотелось бы чтобы код изначально был таким.
__________________
Блог
Red Nova вне форума  
 
Непрочитано 13.03.2009, 14:07
#178
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,453


2VVA
Посмотри пожалуйста в команде PL-VxAdd - какая-то ошибка bad argument type: listp #<variant 8197 ...>
2) а нельзя ли добавить в команде PL-Div обработчик ошибок, а то привязки при отмене по Esc не восстанавливаются.
Sleekka вне форума  
 
Автор темы   Непрочитано 13.03.2009, 15:10
#179
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Sleekka, Ты файлик покажи (или пришли на почту) где эта ошибка появляется.
2. Помсмотрю
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 13.03.2009, 15:29
#180
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,453


А не извиняюсь - это я чего-то накосячил =) пятницца

Последний раз редактировалось Sleekka, 13.03.2009 в 15:41.
Sleekka вне форума  
 
Непрочитано 17.03.2009, 15:37
#181
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, а вот скажи, 3D полилинию в сплайн переделывать надо? В смысле с радиусами в вершинах? Я тут сплайны расковырял и в принципе уже могу и дуги и прямолинейные участки делать через entmake сплайнами. Погрешность очень не велика и ее можно сокращать увеличением количества точек на дугах. Вот сижу и ломаю голову, надо это, или не надо.
Supermax вне форума  
 
Непрочитано 17.03.2009, 15:51
#182
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,453


Вообще-то конвертация полилинии в сплайн решает задачу сглаживания, но сколько я не глядел как отцы подходят к этой задаче, они получают точки как для сплайна а потом по ним все равно полилиния делается видимо обосновано простотой примитивов.
Sleekka вне форума  
 
Автор темы   Непрочитано 17.03.2009, 17:58
#183
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Supermax, Это у народа нужно спрашивать. Но раз ты расковырял сплайн, то может будет интересна еще и задача апроксимации сплайна полилинией с дуговыми сегментами.
Sleekka, Да, сплайн "тяжелый" для Автокада примитив.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 17.03.2009, 18:06
#184
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 3,307
Отправить сообщение для Cfytrr с помощью Skype™


Извиняюсь, но можно ли подправить работу в AutoCad 2009 64х(описанние в #174)
__________________
...переменная FILEDIA создана для привлечения пользователей к форумам.
Cfytrr вне форума  
 
Автор темы   Непрочитано 17.03.2009, 19:28
#185
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Cfytrr, Скоро на работе поставят поставят Висту 64 для ананализа работоспособности наших программ по ней. Тогда посмотрю в чем там дело.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.03.2009, 10:39
#186
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, перевести сплайн в 3D полилинию можно, поскольку имея представление как строится сплайн Автокадом, можно высчитать ряд точек и провести но ним 3D полилинию, но вот имея ряд точек, определить нужна ли там дуга или нет? - Так можно на каждые три точки, которые не лежат на одной прямой дуги лепить.
Короче, с дугами затык.
Потом, сплайн очень коварная штука. В любой момент может выскочить "холмик", который можно описать только очень большим количеством точек, а все остальное может быть просто прямой.

Но, мне кажеться, я где-то уже видел такую прогу.
Supermax вне форума  
 
Непрочитано 29.03.2009, 21:06
#187
Денис Флюстиков


 
Регистрация: 20.07.2005
СПб
Сообщений: 89


VVA,

Программа получения полилиний с дуговыми сегментами при выборе сплайнов или эллипсов. Правда, особо не гонял.
Вложения
Тип файла: rar To_pline_Den.rar (4.6 Кб, 136 просмотров)
Денис Флюстиков вне форума  
 
Автор темы   Непрочитано 29.03.2009, 22:04
#188
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Денис Флюстиков, Спасибо, посмотрю.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.03.2009, 12:34
#189
Денис Флюстиков


 
Регистрация: 20.07.2005
СПб
Сообщений: 89


VVA,
Тестирование программы из поста #187, показало, что для более корректной работы необходимо заменить строчку:
z6 (sin (- (angle (nth (1- z3) z2)(nth z3 z2))
на:
z6 (sin (- (angle (nth (cadr z4) z2)(nth z3 z2))
Денис Флюстиков вне форума  
 
Непрочитано 31.03.2009, 23:46
#190
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Сложный прямоугольник
Может это под автокад возможно заточить:
« При создании объекта способом "Сложный прямоугольник" вначале вводятся две точки - самая длинная боковая сторона создаваемого объекта, а затем - остальные вершины прямоугольника (через одну). Точки указываются на экране курсором и вводятся нажатием левой кнопки мыши. Промежуточные точки создаются автоматически на пересечении прямой, параллельной первой линии (и проходящей через текущую точку) и перпендикуляра к первой линии, проходящего через предыдущую точку. Таким образом, перпендикулярность всех граней создаваемого объекта (в том числе и последней, замыкающей) отслеживается автоматически.»
Я так и не понял, как замыкать этот прямоугольник, вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани
Миниатюры
Нажмите на изображение для увеличения
Название: сложный_прямо.gif
Просмотров: 135
Размер:	3.0 Кб
ID:	18163  
Neznayka вне форума  
 
Автор темы   Непрочитано 01.04.2009, 10:19
#191
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Neznayka,
Цитата:
вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани
По мне так не хватает точки 5 на перечении линии А и перпендикуляра к 1. Можно сделать как в команде Облако (_revcloud)ю Там команда завершается, кодга мышкой придешь в исходную точку. А здесь отслеживать , что при указании точки (в данном случае 5) перпендикуляр от нее попадает в точку 1 с некоторым допуском.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.04.2009, 12:51
#192
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


C точкой 5 имхо плохо, т.к точности не будет (ну если только объектное отслеживание включить).
По принципу "облака" то же хорошо, но будет лишний клик (по т.1) и точка 5 будет "плавать", т.е. её привязкой точно не посадишь, ведь точка 5 все равно будет на перпендикуляре к стороне 1-2. Я чётко излагаю или надо детальный чертеж в районе т.5.
Надо реализовать вариант незамкнутости, и что делать с методом т.5 если надо чтоб продолжить полилинию за грань 1-5, т.е полигон будет с самопересечением (это для тех кто не только домики рисует)
И самый главный вопрос: ВОЗЬМЁТЕСЬ за это?
Neznayka вне форума  
 
Непрочитано 01.04.2009, 14:06
#193
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,429
<phrase 1=


Хороший набор команд. но ENTREVS теряет расширенные данные полилинии, это сложно поправить?
zamtmn вне форума  
 
Автор темы   Непрочитано 01.04.2009, 15:24
#194
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


zamtmn, Уже исправил. Постараюсь на днях выложить новую версию.
Neznayka, Буду думать
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 02.04.2009, 15:55
#195
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Neznayka, В качестве первого приближения
Код:
[Выделить все]
;_Dificult RECtangle
(defun C:DREC ( / *error* ss BasePt1 BasePt2 tmp  ang0 ang90 CurrentPt LastPt U_M usr_list eLast)
  (vl-load-com)
  (defun *error* (msg / )
    (while (> (getvar "CMDACTIVE") 0)(command))
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (princ msg)
    (if elast
    (progn
      (setq ss nil ss (ssadd))
      (while (setq eLast (entnext eLast)) (ssadd eLast ss))
      (if (= (sslength ss) 0);_ Пустой набор
	(setq ss nil)
	)
      )
    )
  (if ss (command "_.ERASE" ss ""))
     (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (princ)
    )
  (setq usr_list (mapcar '(lambda (x) (cons x (getvar x)))
    '("USERR1"  "USERR2"))
  )
    (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  )
  ;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
     )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All") 
     )
    (t nil)
  ) ;_ end of cond
    (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO
  ;;; Запоминаем в eLast последний примитив 
    (if (null (setq eLast (entlast)))
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
      (setq eLast (entlast))
      (entdel eLast)
      )
    )

  (initget 1)(setq BasePt1 (getpoint "\nПервая базовая точка: "))
  (initget 1)(setq BasePt2 (getpoint BasePt1 "\nВторая базовая точка: "))
  (setq ang0 (angle BasePt1 BasePt2))
  (setq ang90 (+ ang0 (* 0.5 PI)))
  (setq LastPt BasePt2)
  (command "_LINE" "_non" BasePt1 "_non" BasePt2 "")
  (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
  (while (and (setq CurrentPt (getpoint "\nВершина прямоугольника [Отмени/Замкни] <замкни>: "))
	      (setq CurrentPt (if (= CurrentPt "Close") nil CurrentPt))
	      )
    (cond ((listp CurrentPt)
    (setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      LastPt
		      (polar LastPt ang90 100)
		      nil
		      )
	  )
    (if tmp
      (progn
        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
        (setvar "USERR2" (cadr LastPt));_Запоминаем Y точки
        (command "_.UNDO" "_M") ;_Ставим метку UNDO 
	(command "_LINE" "_non" LastPt "_non" tmp "_non" CurrentPt "")
	(setq LastPt CurrentPt)
	(setq U_M (1+ U_M))
	)
      )
    )
((= CurrentPt "Undo")
      (if (> U_M 0) ;_ Если есть что отменять 
        (progn
   (command "_.UNDO" "_B")
   (setq U_M (1- U_M))
   (setq LastPt (list (getvar "USERR1") (getvar "USERR2")))
   (setvar "LASTPOINT" LastPt)
        )
        (alert "Отменять больше нечего")
      )
     )
	   )
    (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
    )
  (initget 1)(setq CurrentPt (getpoint "\nТочка удаления замыкающей грани: "))
  (if (and
	(setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      LastPt
		      (polar LastPt ang90 100)
		      nil
		      )
	  )
	(setq CurrentPt tmp)
	(setq tmp (inters CurrentPt
		      (polar CurrentPt ang0 100)
		      BasePt1
		      (polar BasePt1 ang90 100)
		      nil
		      )
	  )
	)
    (progn
      	(command "_LINE" "_non" LastPt "_non" CurrentPt "")
      	(command "_LINE" "_non"  CurrentPt  "_non" tmp "")
      	(command "_LINE" "_non"  tmp  "_non" BasePt1 "")
      )
    )
  (if elast
    (progn
      (setq ss nil ss (ssadd))
      (while (setq eLast (entnext eLast)) (ssadd eLast ss))
      (if (= (sslength ss) 0);_ Пустой набор
	(setq ss nil)
	)
      )
    )
  (if ss
    (progn
      (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
	(command "_pedit" "_Multiple" ss "" "_Join" 0 "")
	(command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
	)
      (setq ss nil)
      )
    )
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    )
  (princ)
 )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.04.2009, 21:44
#196
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Ура!!! Вот счастье-то какое.
Пока оттестировать досконально нечем, серьёзных замечаний я не вижу, так только по мелочи:

1. Нажатие на esc во время выполнения команды УДАЛЯЕТ ВСЕ ранее созданное. А не прерывает команду.
2. Очень желательно чтоб во время отрисовки перекрестье было временно повернуто согласно грани 1-2.
3. Не помешало бы видеть саму полилинию во время создания «колена», а не наблюдать её появления как свершившийся факт после клика.
4. Почему Вы решили, что замыкание по нажатию на пробел более удобно чем просто правый клик, если потому что реализовать программно правый клик труднее, то у меня вопросов нет. Впрочем правый клик это на любителя

Последний раз редактировалось Neznayka, 02.04.2009 в 22:27.
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 10:53
#197
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Neznayka Посмотреть сообщение
Ура!!! Вот счастье-то какое.
Пока оттестировать досконально нечем, серьёзных замечаний я не вижу, так только по мелочи:

1. Нажатие на esc во время выполнения команды УДАЛЯЕТ ВСЕ ранее созданное. А не прерывает команду.
Да, так было и задумано, но можно передумать. Надо?
2. Очень желательно чтоб во время отрисовки перекрестье было временно повернуто согласно грани 1-2.
Это можно попробывать
3. Не помешало бы видеть саму полилинию во время создания «колена», а не наблюдать её появления как свершившийся факт после клика.
Это сложнее. Не обещаю.
4. Почему Вы решили, что замыкание по нажатию на пробел более удобно чем просто правый клик, если потому что реализовать программно правый клик труднее, то у меня вопросов нет. Впрочем правый клик это на любителя
"Дерусь, потому что просто дерусь" © Портос. Я решил что так удобнее. Но можно передумать. Надо?
Кстати правый клик тоже обрабатыватся. И что делать тогда по нажатию на пробел.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 12:21
#198
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


ЕСЛИ ЭТО НЕ трудозатратно, то, пожалуйста. На пробел - завершение команды на том, где мы остановились и запуск команды по-новому.
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 14:08
#199
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вариант 2
Код:
[Выделить все]
 ;_Dificult RECtangle
(defun C:DREC (/	*error*	 ss	  BasePt1  BasePt2  tmp
	       ang0	ang90	 CurrentPt	   LastPt   U_M
	       usr_list	eLast
	      )
  (vl-load-com)
  (defun *error* (msg /)
    (while (> (getvar "CMDACTIVE") 0) (command))
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (princ msg)
    (if	elast
      (progn
	(setq ss nil
	      ss (ssadd)
	) ;_ end of setq
	(while (setq eLast (entnext eLast)) (ssadd eLast ss))
	(if (= (sslength ss) 0) ;_ Пустой набор
	  (setq ss nil)
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
;;;  (if ss (command "_.ERASE" ss ""))
    (if	(and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
      (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
      (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
    ) ;_ end of if
    (setq ss nil)
    (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-EndUndoMark
    (princ)
  ) ;_ end of defun
  (setq	usr_list (mapcar '(lambda (x) (cons x (getvar x)))
			 '("USERR1" "USERR2")
		 ) ;_ end of mapcar
  ) ;_ end of setq
  (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
    )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All")
    )
    (t nil)
  ) ;_ end of cond
;;; Запоминаем в eLast последний примитив 
  (if (null (setq eLast (entlast)))
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
	   (setq eLast (entlast))
	   (entdel eLast)
    ) ;_ end of progn
  ) ;_ end of if
  (while
    (and (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO
	 (setq BasePt1 (getpoint "\nПервая базовая точка <выход>: "))
    ) ;_ end of and
     (initget 1)
     (setq BasePt2 (getpoint BasePt1 "\nВторая базовая точка: "))
     (setq ang0 (angle BasePt1 BasePt2))
     (setq ang90 (+ ang0 (* 0.5 PI)))
     (setq LastPt BasePt2)
     (command "_LINE" "_non" BasePt1 "_non" BasePt2 "")
     (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
     (while (and (setq CurrentPt
			(getpoint
			  "\nВершина прямоугольника [Отмени/Замкни] <выход>: "
			) ;_ end of getpoint
		 ) ;_ end of setq
		 (/= CurrentPt "Close")
	    ) ;_ end of and
       (cond
	 ((listp CurrentPt)
	  (setq	tmp (inters CurrentPt
			    (polar CurrentPt ang0 100)
			    LastPt
			    (polar LastPt ang90 100)
			    nil
		    ) ;_ end of inters
	  ) ;_ end of setq
	  (if tmp
	    (progn
	      (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	      (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	      (command "_.UNDO" "_M") ;_Ставим метку UNDO 
	      (command "_LINE"	 "_non"	   LastPt    "_non"
		       tmp	 "_non"	   CurrentPt ""
		      ) ;_ end of command
	      (setq LastPt CurrentPt)
	      (setq U_M (1+ U_M))
	    ) ;_ end of progn
	  ) ;_ end of if
	 )
	 ((= CurrentPt "Undo")
	  (if (> U_M 0) ;_ Если есть что отменять 
	    (progn
	      (command "_.UNDO" "_B")
	      (setq U_M (1- U_M))
	      (setq LastPt (list (getvar "USERR1") (getvar "USERR2")))
	      (setvar "LASTPOINT" LastPt)
	    ) ;_ end of progn
	    (alert "Отменять больше нечего")
	  ) ;_ end of if
	 )
       ) ;_ end of cond
       (initget "Отмени Undo Замкни Close _Undo Undo Close Close")
     ) ;_ end of while
     (if (= CurrentPt "Close")
       (progn
	 (initget 1)
	 (setq
	   CurrentPt (getpoint "\nТочка удаления замыкающей грани: ")
	 ) ;_ end of setq
	 (if (and
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 LastPt
				 (polar LastPt ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	       (setq CurrentPt tmp)
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 BasePt1
				 (polar BasePt1 ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	     ) ;_ end of and
	   (progn
	     (command "_LINE" "_non" LastPt "_non" CurrentPt "")
	     (command "_LINE" "_non" CurrentPt "_non" tmp "")
	     (command "_LINE" "_non" tmp "_non" BasePt1 "")
	   ) ;_ end of progn
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (setq ss nil)
     (if elast
       (progn
	 (setq ss nil
	       ss (ssadd)
	 ) ;_ end of setq
	 (while (setq eLast (entnext eLast)) (ssadd eLast ss))
	 (if (= (sslength ss) 0) ;_ Пустой набор
	   (setq ss nil)
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (if ss
       (progn
	 (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
	   (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
	   (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
	 ) ;_ end of if
	 (setq ss nil)
       ) ;_ end of progn
     ) ;_ end of if
     (setq eLast (entlast))
  ) ;_ end of while
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (vla-EndUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
  (princ)
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 16:22
#200
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


стало хуже: по правому клику появляется контектное меню и в нём надо выбрать ЗАМКНИ, тогда только можно замкнуть прямоугольник.Необходимо блокировать контекстное меню и правый клик должен сразу активировать ЗАМКНИ
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 16:28
#201
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Neznayka, Тогда не будет опции Отмени.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 17:13
#202
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


э-э... т.е ctrl+z, даже и не знаю что лучше, но как во 2 варианте тоже плохо, может ну её (опцию Отмени)
Neznayka вне форума  
 
Автор темы   Непрочитано 03.04.2009, 17:28
#203
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Neznayka, Ctrl+Z будет. Не будет отмены, если не устраивает указанная вершина.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 03.04.2009, 21:50
#204
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


ок.
Neznayka вне форума  
 
Автор темы   Непрочитано 06.04.2009, 12:22
#205
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Еще один вариант: замкни пробелу или выбор опции по ПКМ, ESC - выход (на предыдущий уровень).
Код:
[Выделить все]
 ;_Dificult RECtangle
(defun C:DREC (/	*error*	 ss	  BasePt1  BasePt2  tmp
	       ang0	ang90	 CurrentPt	   LastPt   U_M
	       usr_list	eLast Reg
	      )
  (vl-load-com)
  (defun *error* (msg /)
    (while (> (getvar "CMDACTIVE") 0) (command))
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
    (princ msg)
    (if	elast
      (progn
	(setq ss nil
	      ss (ssadd)
	) ;_ end of setq
	(while (setq eLast (entnext eLast)) (ssadd eLast ss))
	(if (= (sslength ss) 0) ;_ Пустой набор
	  (setq ss nil)
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
;;;  (if ss (command "_.ERASE" ss ""))
    (if	(and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
      (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
      (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
    ) ;_ end of if
    (setq ss nil)
    (vla-EndUndoMark
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-EndUndoMark
    (princ)
  ) ;_ end of defun
  (setq	usr_list (mapcar '(lambda (x) (cons x (getvar x)))
			 '("USERR1" "USERR2" "CMDECHO")
		 ) ;_ end of mapcar
  ) ;_ end of setq
  (setvar "CMDECHO" 0)
  (vla-StartUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL"))
  (cond
    ((= (logand U_M 1) 0) ;_ Отключено UNDO
     (command "_.UNDO" "_All")
    )
    ((= (logand U_M 3) 3) ;_ Разрешена отмена одной операции
     (command "_.UNDO" "_Control" "_All")
    )
    (t nil)
  ) ;_ end of cond
;;; Запоминаем в eLast последний примитив 
  (if (null (setq eLast (entlast)))
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
	   (setq eLast (entlast))
	   (entdel eLast)
    ) ;_ end of progn
  ) ;_ end of if
  (while
    (and (setq U_M 0) ;_VVA Устанавливаем счетчик отмен UNDO
	 (setq BasePt1 (getpoint "\nПервая базовая точка <выход>: "))
    ) ;_ end of and
     (initget 1)
     (setq BasePt2 (getpoint BasePt1 "\nВторая базовая точка: "))
     (setq ang0 (angle BasePt1 BasePt2))
     (setq ang90 (+ ang0 (* 0.5 PI)))
     (setq LastPt BasePt2)
     (command "_LINE" "_non" BasePt1 "_non" BasePt2 "")
     (initget "Отмени Undo Замкни Close Дуга Arc Произвольно Free _Undo Undo Close Close Arc Arc Free Free")
     (vl-catch-all-apply
       '(lambda	()
	  (while (and (setq CurrentPt
			     (getpoint
			       "\nВершина прямоугольника (Esc - выход) [Отмени/Дуга/Произвольно/Замкни] <замкни>: "
			     ) ;_ end of getpoint
		      ) ;_ end of setq
		      (/= CurrentPt "Close")
		 ) ;_ end of and
	    (cond
	      ((listp CurrentPt)
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 LastPt
				 (polar LastPt ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	       (if tmp
		 (progn
		   (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
		   (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
		   (command "_.UNDO" "_M") ;_Ставим метку UNDO 
		   (command "_LINE"   "_non"	LastPt	  "_non"
			    tmp	      "_non"	CurrentPt ""
			   ) ;_ end of command
		   (setq LastPt CurrentPt)
		   (setq U_M (1+ U_M))
		 ) ;_ end of progn
	       ) ;_ end of if
	      )
	      ((= CurrentPt "Arc")
	        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	        (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	        (command "_.UNDO" "_M") ;_Ставим метку UNDO
	        (setvar "CMDECHO" 1)
	        (command "_ARC" "_non" LastPt)
	        (while (> (getvar "CMDACTIVE") 0) (command pause))
	        (setvar "CMDECHO" 0)
	        (setq LastPt (getvar "LASTPOINT"))
	        (setq U_M (1+ U_M))
	       )
	      ((= CurrentPt "Free")
	        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	        (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	        (command "_.UNDO" "_M") ;_Ставим метку UNDO
	        (setvar "CMDECHO" 1)
	        (command "_Line" "_non" LastPt)
	        (while (> (getvar "CMDACTIVE") 0) (command pause))
	        (setvar "CMDECHO" 0)
	        (setq LastPt (getvar "LASTPOINT"))
	        (setq U_M (1+ U_M))
	       )
	      ((= CurrentPt "Undo")
	       (if (> U_M 0) ;_ Если есть что отменять 
		 (progn
		   (command "_.UNDO" "_B")
		   (setq U_M (1- U_M))
		   (setq
		     LastPt (list (getvar "USERR1") (getvar "USERR2"))
		   ) ;_ end of setq
		   (setvar "LASTPOINT" LastPt)
		 ) ;_ end of progn
		 (alert "Отменять больше нечего")
	       ) ;_ end of if
	      )
	    ) ;_ end of cond
           (initget "Отмени Undo Замкни Close Дуга Arc Произвольно Free _Undo Undo Close Close Arc Arc Free Free")
	  ) ;_ end of while
	) ;_ end of lambda
     ) ;_ end of vl-catch-all-apply
     (if (or (null CurrentPt) (= CurrentPt "Close"))
       (progn
	 (initget 1)
	 (setq
	   CurrentPt (getpoint "\nТочка удаления замыкающей грани: ")
	 ) ;_ end of setq
	 (if (and
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 LastPt
				 (polar LastPt ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	       (setq CurrentPt tmp)
	       (setq tmp (inters CurrentPt
				 (polar CurrentPt ang0 100)
				 BasePt1
				 (polar BasePt1 ang90 100)
				 nil
			 ) ;_ end of inters
	       ) ;_ end of setq
	     ) ;_ end of and
	   (progn
	     (command "_LINE" "_non" LastPt "_non" CurrentPt "")
	     (command "_LINE" "_non" CurrentPt "_non" tmp "")
	     (command "_LINE" "_non" tmp "_non" BasePt1 "")
	   ) ;_ end of progn
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (setq ss nil)
     (if elast
       (progn
	 (setq ss nil
	       ss (ssadd)
	 ) ;_ end of setq
	 (while (setq eLast (entnext eLast)) (ssadd eLast ss))
	 (if (= (sslength ss) 0) ;_ Пустой набор
	   (setq ss nil)
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
     (if ss
       (progn
	 (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
	   (command "_pedit" "_Multiple" ss "" "_Join" 0 "")
	   (command "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "")
	 ) ;_ end of if
	 (setq ss nil)
       ) ;_ end of progn
     ) ;_ end of if
     (setq eLast (entlast))
  ) ;_ end of while
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) usr_list)
  (vla-EndUndoMark
    (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
  (princ)
) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 06.04.2009 в 17:03. Причина: Изменено по предложению #206
VVA вне форума  
 
Непрочитано 06.04.2009, 13:58
#206
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Все супер, но тут сейчас коллега вносит предложение…
(я конечно понимаю, что наглость второе счастье
Короче коллега говорит, а нельзя ли сделать, чтоб можно было дуги рисовать и или произвольные (неортогональные линии) рисовать. Типа кликнул правой и выбрал в контекстном меню пункт «дуга», нарисовал её и дальше в прежнем режиме или нажал шифт и рисуй линии под любыми углами , а как отпустил снова автоматом включается нормальная работа лиспа.
p/s по-русски drec это вкус
СПАСИБО!!!
Neznayka вне форума  
 
Автор темы   Непрочитано 06.04.2009, 17:03
#207
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Neznayka, Изменил #205
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.04.2009, 00:10
#208
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 305


Все. У меня и придраться не к чему.
ОГРОМНОЕ ВАМ СПАСИБО!
p/s помните, я просил лисп для отрисовки прямоугольника по 3 точкам. так этот новый лисп заменяет тот старый, только на пробел придется жать.

добавлю после активного юзанья лиспа:
во-первых (извиняюсь за фразу) я "кипяточком писаю" от drec, но вплыло пару мелких недочетов.
2. в лиспе нужно предусмотреть "реверс" иногда он "колено" не в ту сторону заворачивает, типа нажал клавишу и "колено" перевернулось. Если непонятно о чём я. то могу скриншот выложить.
3. лисп во время отрисовки любит прятать полилинию под растр, неудобно когда не контролируешь что чертишь.
4 иногда (когда еще не понял) создаются полилинии нулевой длинны
еще раз спасибо.

Последний раз редактировалось Neznayka, 08.04.2009 в 23:36.
Neznayka вне форума  
 
Непрочитано 18.05.2009, 17:53
#209
MeshIN

Изыскания и САПР
 
Регистрация: 05.07.2008
Ижевск
Сообщений: 295


VVA, а программы могут быть переделаны под Bricscad???

Начальство купило 20 мест, и без этих команд, как без рук
MeshIN вне форума  
 
Автор темы   Непрочитано 18.05.2009, 18:39
#210
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


MeshIN, Все зависит, настколько полно BricsCad поддерживает vla-методы и объектную модель. Пока что я знаю, что именно при использовании VLA-* были проблемы. Хотя в BricsCad V9 заявляют
Быстрое ядро LISP с поддержкой более 450 VLAX функций Но все равно нужно пробовать
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.05.2009, 20:58
#211
MeshIN

Изыскания и САПР
 
Регистрация: 05.07.2008
Ижевск
Сообщений: 295


Цитата:
Сообщение от VVA Посмотреть сообщение
MeshIN, Все зависит, настколько полно BricsCad поддерживает vla-методы и объектную модель. Пока что я знаю, что именно при использовании VLA-* были проблемы. Хотя в BricsCad V9 заявляют
Быстрое ядро LISP с поддержкой более 450 VLAX функций Но все равно нужно пробовать
Я конечно уже пробывал, загружал в Brics V9.2, *.cui файл прочитало нормально, работает реверс полилинии, построение прямоугольника по 3 точкам, остальные функции к сожалению не работают (хотя я может что то и пропустил)
MeshIN вне форума  
 
Непрочитано 20.05.2009, 14:44
#212
alex8888

Инженер
 
Регистрация: 27.04.2009
Deutschland
Сообщений: 207


В 2010-м автокаде под вистой 64х проблема-не вставляются панели и кнопки, команды обрабатывается только при их тупом вводе в командной строке после тупой же загрузки исходного лиспа.
В 2009-м была проблема с установкой, но там надо было влоб ткнуть на фас-приложение при загрузке и потом выбрать уже в настройках меню и команд, и все встало на свои места кроме файла помощи.
Кто-нибудь сталкивался с такой проблемой?

И второе, в версии автокада Lite будут работать эти команды или там табу на лисп-приложения?
alex8888 вне форума  
 
Непрочитано 20.05.2009, 15:04
#213
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Первое. См. http://forum.dwg.ru/showthread.php?p=398240#post398240
Второе. Не будет. LISP в AutoCAD LT не поддерживается и поддерживаться не будет.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.05.2009, 15:26
#214
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


VVA, привет! Официяльное обращение.
Нужна функция, которая делает обратное CVPOLY, превращает 2D полилинию в 3D полилинию. И еще нужна функция, добавляющая в 3D полилинию вертикальный участок.
Вот есть на 3D полилинии узел, надо ткнув в него и определив знак "+" или "-" добавить либо со строны конца 3D полилинии, либо со стороны начала еще один узел. Его координаты по X и Y такие же как и у прежнего узла, а по Z строится отрезок заданной длинны.
Если смотреть на план с геоподосновой, то ткнув в узел как-бы ничего не произойдет, просто в этом месте появится вертикальный участок, где два узла окажутся друг над другом.
Данная функция нужна всем, кто прокладываетнаружные сети.
Supermax вне форума  
 
Непрочитано 20.05.2009, 15:31
#215
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


Supermax, ты только уточни - а какая-нибудь часть полилинии поднимается / опускается или нет? И если да, то как определять?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.05.2009, 17:47
#216
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Нужна функция, которая делает обратное CVPOLY, превращает 2D полилинию в 3D полилинию.
А это для сего делалось?
Цитата:
ConvTo3d -Преобразование линейных объектов в 3D полилинии
По поводу добавления сегмента Алексей вопрос уже задал
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.05.2009, 18:05
#217
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Ну, дык, я ж написал про "+" и "-"

VVA, так не честно! С утра в первом посте совсем другой список был, а лезть в библиотеку функций мне было лень, понадеялся на соответствие.

Кулик Алексей aka kpblc,
Цитата:
Supermax, ты только уточни - а какая-нибудь часть полилинии поднимается / опускается или нет? И если да, то как определять?
Считаю, что надо тупо прибавлять к существующему значению Z длинну участка. по ходу полилинии. Всегда добавляем узел между выбранным узлом и следующим (+1) и Z определяем суммируя введенное значение длинны со знаком.

Последний раз редактировалось Supermax, 20.05.2009 в 18:18.
Supermax вне форума  
 
Автор темы   Непрочитано 20.05.2009, 19:18
#218
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,795
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Давай так. Есть 3d полилиния с началом в т. 0,0,0 и координатами вершин: (0 0 0) (10 10 10) (30 20 0)
Я указал 2 вершину (10 10 10) и набрал +30. Получаем полилинию с координатами вершин (0 0 0) (10 10 10) (10 10 40) (30 20 0)
Я указал 2 вершину (10 10 10) и набрал -30. Получаем полилинию с координатами вершин: ?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.05.2009, 19:23
#219
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,694


VVA, возможны варианты: при вводе хоть "+", хоть "-" можно получить разные значения:
'((0. 0. 0.) (10. 10. 10.) (10. 10. 40.) (30. 20. 0.))
'((0. 0. 0.) (10. 10. 10.) (10. 10. 40.) (30. 20. 30.))
Какой из них будет верным?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.05.2009, 20:07
#220
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


Цитата:
Я указал 2 вершину (10 10 10) и набрал +30. Получаем полилинию с координатами вершин (0 0 0) (10 10 10) (10 10 40) (30 20 0)
Я указал 2 вершину (10 10 10) и набрал -30. Получаем полилинию с координатами вершин: ?
(0 0 0) (10 10 10) (10 10 -20) (30 20 0)

Все правильно. Добавляем точку только вперед по ходу полилинии.
Supermax вне форума  
 
Непрочитано 20.05.2009, 20:39
#221
ALEXGVOZ


 
Регистрация: 23.08.2008
Сообщений: 38


привет а есть команда которая делает от множества полилиний паралельные полилинии в обе стороны??????помогите
ALEXGVOZ вне форума  
 
Автор темы   Непрочитано 20.05.2009, 20:46
#222