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

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

Вроде бы все хорошо, но простите за назойливость, мне не нужно каждую вершину редактировать, а, переходя по полилинии корректировать некоторые из них, не выходя из команды.

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

Не досмотрел. Так устроит. Большое спасибо.

[Profan]

Объясните, пожалуйста, а чем ручки-то плохи? Выделил полилинию и выбирай любую ручку, если нет ножки.

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

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

[Profan]

Для VVA.
А это почему?

Код:

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

Команда: PL-VXMOVE

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

Команда:

Программа не может работать автономно?

[VVA]

>Игорь Богаченко В № 38 писал

Возможность редактирования при включенных ручках - мне нравится. Будет включена во все команды по аналогу этой, то же и с undo.

PL-VxAdd с ручками уже готова, допишу отмену и выложу обновления. На этой (PL-VxMove) команде можно посмотреть как будет. Чуточку терпения.

Если применять резинувую нить, то для двух смежных вершин, а не для одной с направлением

В лиспе такое нельзя, по крайней мере я не знаю как.
Я тоже сомневаюсь в практической ценности PL-VxMove и согласен с Profan №43 Хотел написать на Profan №45

в №32 писал, здесь забыл Дополнительные ф-ции по ссылке с поста №1.

Но подправлю VVA №38, сделаю ф-цию автономной.

[Profan]

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

[Neznayka]

Спасибо за прогу, но почему не добавляется вершина в полилинии с глобальной шириной, пишет ничего типа не выбранно, очень редко проскакивает. и в 2007 не пашет эта команда, чего-тот не хватает

[VVA]

Пользуясь случаем обновил программы. Исправленные ошибки:
- 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. Там чистый Лисп. От версии не должно зависеть.

[Neznayka]

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

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

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

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

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


а может еще такую фишку с геоникса добавить, типа есть замкнутый контур (здание обведено с растра, например) внутренние углы стремятся к 90 градусам, но у них это не получается из-за того не пользовались ф8 . Так вот щелкнул по линии и она трансформировалась в фигуру с углами в 90 гр. , за основу берется самая длиная сторона
возможно ли такое ?

[VVA]

>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)
)

[Neznayka]

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

[ShaggyDoc]

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

Для того, чтобы предотвратить ситуацию с неправильным указанием широкой (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.

[VVA]

>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")

[Lizzy]

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

В одном файле после использования команды flatten objekts изменилось отбражение вновь проводимых полилиний. Толщина их стало отбражаться в абсолютных величинах, а не относительно экрана. мне удалось только выяснить, что это зависит от величин global width. Где можно это значение "обнулить"? Пока приходится делать это вручную в свойствах... :?:

[Neznayka]

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

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

ОГРОМНОЕ СПАСИБО

[VVA]

>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 градусов

[Кочетков Андрей]

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

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

программа выдает ошибку

Код:

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

Command: PL-VxRdc
25 found

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

Command: *Cancel*

Снимаю атрибут Замкнута.
Программа работает корректно.

[VVA]

Спасибо проверю

[VVA]

>Кочетков Андрей Исправил. Выложил в download