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

Вернуться   Форум 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. Причина: ссылка на иконки для темной темы
Просмотров: 367880
 
Автор темы   Непрочитано 12.06.2008, 10:21
#161
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<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,990
<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,702
Отправить сообщение для Do$ с помощью Skype™


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

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


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

Последний раз редактировалось 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
Питер
Сообщений: 4,811
Отправить сообщение для 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,990
<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,980
Отправить сообщение для Red Nova с помощью Skype™


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

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


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,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


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

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


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

Последний раз редактировалось Sleekka, 13.03.2009 в 15:41.
Sleekka вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

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

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