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

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

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

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

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

=========== Доступные команды PLTOOLS=================
Редакция 17.06.2014
PL-JOIN -Объединение выбранных полилиний
PL-VFI -вставка вершин в выбранной полилинии в местах пересечения с
указанными полилиниями, линиями, дугами
PL-JOIN3D -Объединение 3D полилиний
PL-L2A -Замена линейного сегмента в полилинии дуговым сегментом.
PL-A2L -Замена дугового сегмента в полилинии линейным сегментом.
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
Просмотров: 15345
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 08.09.2023 в 13:25. Причина: ссылка на иконки для темной темы
Просмотров: 367878
 
Автор темы   Непрочитано 14.03.2008, 09:21
#101
VVA

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


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

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для 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
С.-Петербург
Сообщений: 39,787


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

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


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

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


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

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


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

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


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

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


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

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


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

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


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

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для 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
С.-Петербург
Сообщений: 39,787


Ну если сильно хочется одним кликом, попробуйте:
Код:
[Выделить все]
(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
Код особо не гонял, предупреждаю сразу.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.03.2008, 09:47
#113
Лентяй

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


Когда 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,627


Получил такое сообщение:
Код:
[Выделить все]
 
Команда: 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
С.-Петербург
Сообщений: 39,787


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

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,980
Отправить сообщение для 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,392


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,627


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

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

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


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

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


Про запоминание значения не проблема, а про "угол" надо подумать. Вся проблема в алгоритме.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск