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

[Supermax]

VVA, а вот скажи, 3D полилинию в сплайн переделывать надо? В смысле с радиусами в вершинах? Я тут сплайны расковырял и в принципе уже могу и дуги и прямолинейные участки делать через entmake сплайнами. Погрешность очень не велика и ее можно сокращать увеличением количества точек на дугах. Вот сижу и ломаю голову, надо это, или не надо.

[Sleekka]

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

[VVA]

Supermax, Это у народа нужно спрашивать. Но раз ты расковырял сплайн, то может будет интересна еще и задача апроксимации сплайна полилинией с дуговыми сегментами.
Sleekka, Да, сплайн "тяжелый" для Автокада примитив.

[Cfytrr]

Извиняюсь, но можно ли подправить работу в AutoCad 2009 64х(описанние в #174)

[VVA]

Cfytrr, Скоро на работе поставят поставят Висту 64 для ананализа работоспособности наших программ по ней. Тогда посмотрю в чем там дело.

[Supermax]

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

Но, мне кажеться, я где-то уже видел такую прогу.

[Денис Флюстиков]

VVA,

Программа получения полилиний с дуговыми сегментами при выборе сплайнов или эллипсов. Правда, особо не гонял.

[VVA]

Денис Флюстиков, Спасибо, посмотрю.

[Денис Флюстиков]

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

[Neznayka]

Сложный прямоугольник
Может это под автокад возможно заточить:
« При создании объекта способом "Сложный прямоугольник" вначале вводятся две точки - самая длинная боковая сторона создаваемого объекта, а затем - остальные вершины прямоугольника (через одну). Точки указываются на экране курсором и вводятся нажатием левой кнопки мыши. Промежуточные точки создаются автоматически на пересечении прямой, параллельной первой линии (и проходящей через текущую точку) и перпендикуляра к первой линии, проходящего через предыдущую точку. Таким образом, перпендикулярность всех граней создаваемого объекта (в том числе и последней, замыкающей) отслеживается автоматически.»
Я так и не понял, как замыкать этот прямоугольник, вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани

[VVA]

Neznayka,

вероятно после клика №4 должен следовать правый клик, который задаёт удаление грани «А» от первоначальной грани

По мне так не хватает точки 5 на перечении линии А и перпендикуляра к 1. Можно сделать как в команде Облако (_revcloud)ю Там команда завершается, кодга мышкой придешь в исходную точку. А здесь отслеживать , что при указании точки (в данном случае 5) перпендикуляр от нее попадает в точку 1 с некоторым допуском.

[Neznayka]

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

[zamtmn]

Хороший набор команд. но ENTREVS теряет расширенные данные полилинии, это сложно поправить?

[VVA]

zamtmn, Уже исправил. Постараюсь на днях выложить новую версию.
Neznayka, Буду думать

[VVA]

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

[Neznayka]

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

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

[VVA]

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

"Дерусь, потому что просто дерусь" © Портос. Я решил что так удобнее. Но можно передумать. Надо?
Кстати правый клик тоже обрабатыватся. И что делать тогда по нажатию на пробел.

[Neznayka]

ЕСЛИ ЭТО НЕ трудозатратно, то, пожалуйста. На пробел - завершение команды на том, где мы остановились и запуск команды по-новому.

[VVA]

Вариант 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

[Neznayka]

стало хуже: по правому клику появляется контектное меню и в нём надо выбрать ЗАМКНИ, тогда только можно замкнуть прямоугольник.Необходимо блокировать контекстное меню и правый клик должен сразу активировать ЗАМКНИ