[VVA]

Данный набор программ является коллективным продуктом участников форумов 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
Иконки для темной темы здесь
Обсуждаем, критикуем, предлагаем

[AleX]

Наверно более актуально преобразование SPLINE в 2D_POLYLINE.Как-то начинал, но результата так и нет.

[VVA]

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

[AleX]

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

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

[luser]

vva.
спасибо огромное за ваш труд, очень облгечает рутинные операции.
пожелание можна ли дополнить функциями копирования сегментов,
т.е по указанным пользователем сегментам pline создавался новый
объект-копия включающий в себя только указанные сегменты.
еще раз спасибо.

[VVA]

>AleX

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

Я не знаю другого математического решения кроме как апроксимация 2d/3d линейными сегментами заданной длины. Даже здесь это делают так (и за деньги).

Что-то вроде имеющейся возможности определить элипс участками полилинии.

А про системную переменную PELLIPSE знаешь?

В 3d polyline полилинию через точки наверно банально и просто

А зачем искать трудности? :wink:
>luser Сейсас готовится обновление с найденными багами KAI, попробую учесть и твое предложение.

[luser]

VVA.
спасибо, ждем новых версий.

[AleX]

А про системную переменную PELLIPSE знаешь?

Обижаешь.

[ilka_t]

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

[VVA]

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

[P_S]

Поскольку я только начинаю разбираться с 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)
)
)
)

[Profan]

А это что такое:

Код:

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

Команда: CON_ED

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

Команда:

[VVA]

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) обновлять одну вершину. Надо обновлять все координаты.Вот здесь с этим боролись.

[KAI]

По интерфейсу:
не мешало бы добавить опции "вперед" и "назад" (или как в 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:

[Игорь Богаченко]

Прекрасный набор команд. Удобно оформлен. Хотя это не ново. В ToolPac это уже есть, да и не мешало бы посмотреть создателю, как реализовано это все в GeoniCS. Намного удобней.
Если возможно, то добавьте, пожалуйста, в функцию "добавления вершин в полилинию" возможность редактирования при включенных ручках, или подсвеченных вершин. А то добавляешь вершину, а рядом уже есть. Приходится корректировать.

[Кулик Алексей aka kpblc]

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

[Игорь Богаченко]

Я совсем не хочу уменьшить значение твоей программы, но, некоторые моменты в Геониксе реализованы гораздо удобней. И если бы была возможность вытащить в Автокад из Геоникса набор команд по редактированию полилинии, то меня бы все устроило. Имелась в виду концепция решения.

[MIP]

>>Игорь Богаченко

Я совсем не хочу уменьшить значение твоей программы, но, некоторые моменты в Геониксе реализованы гораздо удобней. И если бы была возможность вытащить в Автокад из Геоникса набор команд по редактированию полилинии, то меня бы все устроило. Имелась в виду концепция решения.

В GeoniCS многие вещи сделаны удобно, но реализовать некоторые приятные возможности на лисп просто не возмжно, а вот извлечь ARX библиотеки, без помощи разработчика врядли получиться и насколько я его знаю они пока это делать не собираются. Написать аналог можно, но кто этим займеться?
Поэтому пользуемся тем что есть! И низкий поклон VVA за собраную до кучки информацию и всем авторам любезно предоставленных программ.

[VVA]

Новый АВТОНОМНЫЙ вариант 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.

Добавлено
Команда сделана автономной

[P_S]

VVA

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

.

Какие были мысли относительно этой команды: указывается направление редактирования, и резиновая нить цепляется за предыдущую вершину, обозначая положение линейного сегмента полилинии после изменения положения вершины. Таким образом, для пользователя процесс схож с вычерчиванием заново участка полилинии.

[VVA]

>P_Sуказывается направление редактирования - пробуй послений вариант

резиновая нить цепляется за предыдущую вершину

- не введет ли это пользователя в заблуждение.