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

[VVA]

Neznayka, Тогда не будет опции Отмени.

[Neznayka]

э-э... т.е ctrl+z, даже и не знаю что лучше, но как во 2 варианте тоже плохо, может ну её (опцию Отмени)

[VVA]

Neznayka, Ctrl+Z будет. Не будет отмены, если не устраивает указанная вершина.

[Neznayka]

ок.

[VVA]

Еще один вариант: замкни пробелу или выбор опции по ПКМ, ESC - выход (на предыдущий уровень).

Код:

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

 ;_Dificult RECtangle
(defun C:DREC (/	*error*	 ss	  BasePt1  BasePt2  tmp
	       ang0	ang90	 CurrentPt	   LastPt   U_M
	       usr_list	eLast Reg
	      )
  (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" "CMDECHO")
		 ) ;_ end of mapcar
  ) ;_ end of setq
  (setvar "CMDECHO" 0)
  (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 Дуга Arc Произвольно Free _Undo Undo Close Close Arc Arc Free Free")
     (vl-catch-all-apply
       '(lambda	()
	  (while (and (setq CurrentPt
			     (getpoint
			       "\nВершина прямоугольника (Esc - выход) [Отмени/Дуга/Произвольно/Замкни] <замкни>: "
			     ) ;_ 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 "Arc")
	        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	        (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	        (command "_.UNDO" "_M") ;_Ставим метку UNDO
	        (setvar "CMDECHO" 1)
	        (command "_ARC" "_non" LastPt)
	        (while (> (getvar "CMDACTIVE") 0) (command pause))
	        (setvar "CMDECHO" 0)
	        (setq LastPt (getvar "LASTPOINT"))
	        (setq U_M (1+ U_M))
	       )
	      ((= CurrentPt "Free")
	        (setvar "USERR1" (car LastPt)) ;_Запоминаем X точки
	        (setvar "USERR2" (cadr LastPt)) ;_Запоминаем Y точки
	        (command "_.UNDO" "_M") ;_Ставим метку UNDO
	        (setvar "CMDECHO" 1)
	        (command "_Line" "_non" LastPt)
	        (while (> (getvar "CMDACTIVE") 0) (command pause))
	        (setvar "CMDECHO" 0)
	        (setq LastPt (getvar "LASTPOINT"))
	        (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"))
		   ) ;_ end of setq
		   (setvar "LASTPOINT" LastPt)
		 ) ;_ end of progn
		 (alert "Отменять больше нечего")
	       ) ;_ end of if
	      )
	    ) ;_ end of cond
           (initget "Отмени Undo Замкни Close Дуга Arc Произвольно Free _Undo Undo Close Close Arc Arc Free Free")
	  ) ;_ end of while
	) ;_ end of lambda
     ) ;_ end of vl-catch-all-apply
     (if (or (null CurrentPt) (= 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]

Все супер, но тут сейчас коллега вносит предложение…
(я конечно понимаю, что наглость второе счастье
Короче коллега говорит, а нельзя ли сделать, чтоб можно было дуги рисовать и или произвольные (неортогональные линии) рисовать. Типа кликнул правой и выбрал в контекстном меню пункт «дуга», нарисовал её и дальше в прежнем режиме или нажал шифт и рисуй линии под любыми углами , а как отпустил снова автоматом включается нормальная работа лиспа.
p/s по-русски drec это вкус
СПАСИБО!!!

[VVA]

Neznayka, Изменил #205

[Neznayka]

Все. У меня и придраться не к чему.
ОГРОМНОЕ ВАМ СПАСИБО!
p/s помните, я просил лисп для отрисовки прямоугольника по 3 точкам. так этот новый лисп заменяет тот старый, только на пробел придется жать.

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

[MeshIN]

VVA, а программы могут быть переделаны под Bricscad???

Начальство купило 20 мест, и без этих команд, как без рук

[VVA]

MeshIN, Все зависит, настколько полно BricsCad поддерживает vla-методы и объектную модель. Пока что я знаю, что именно при использовании VLA-* были проблемы. Хотя в BricsCad V9 заявляют
Быстрое ядро LISP с поддержкой более 450 VLAX функций Но все равно нужно пробовать

[MeshIN]

Сообщение от VVA MeshIN, Все зависит, настколько полно BricsCad поддерживает vla-методы и объектную модель. Пока что я знаю, что именно при использовании VLA-* были проблемы. Хотя в BricsCad V9 заявляют Быстрое ядро LISP с поддержкой более 450 VLAX функций Но все равно нужно пробовать

Я конечно уже пробывал, загружал в Brics V9.2, *.cui файл прочитало нормально, работает реверс полилинии, построение прямоугольника по 3 точкам, остальные функции к сожалению не работают (хотя я может что то и пропустил)

[alex8888]

В 2010-м автокаде под вистой 64х проблема-не вставляются панели и кнопки, команды обрабатывается только при их тупом вводе в командной строке после тупой же загрузки исходного лиспа.
В 2009-м была проблема с установкой, но там надо было влоб ткнуть на фас-приложение при загрузке и потом выбрать уже в настройках меню и команд, и все встало на свои места кроме файла помощи.
Кто-нибудь сталкивался с такой проблемой?

И второе, в версии автокада Lite будут работать эти команды или там табу на лисп-приложения?

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

Первое. См. http://forum.dwg.ru/showthread.php?p=398240#post398240
Второе. Не будет. LISP в AutoCAD LT не поддерживается и поддерживаться не будет.

[Supermax]

VVA, привет! Официяльное обращение.
Нужна функция, которая делает обратное CVPOLY, превращает 2D полилинию в 3D полилинию. И еще нужна функция, добавляющая в 3D полилинию вертикальный участок.
Вот есть на 3D полилинии узел, надо ткнув в него и определив знак "+" или "-" добавить либо со строны конца 3D полилинии, либо со стороны начала еще один узел. Его координаты по X и Y такие же как и у прежнего узла, а по Z строится отрезок заданной длинны.
Если смотреть на план с геоподосновой, то ткнув в узел как-бы ничего не произойдет, просто в этом месте появится вертикальный участок, где два узла окажутся друг над другом.
Данная функция нужна всем, кто прокладываетнаружные сети.

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

Supermax, ты только уточни - а какая-нибудь часть полилинии поднимается / опускается или нет? И если да, то как определять?

[VVA]

Нужна функция, которая делает обратное CVPOLY, превращает 2D полилинию в 3D полилинию.

А это для сего делалось?

ConvTo3d -Преобразование линейных объектов в 3D полилинии

По поводу добавления сегмента Алексей вопрос уже задал

[Supermax]

Ну, дык, я ж написал про "+" и "-"

VVA, так не честно! С утра в первом посте совсем другой список был, а лезть в библиотеку функций мне было лень, понадеялся на соответствие.

Кулик Алексей aka kpblc,

Supermax, ты только уточни - а какая-нибудь часть полилинии поднимается / опускается или нет? И если да, то как определять?

Считаю, что надо тупо прибавлять к существующему значению Z длинну участка. по ходу полилинии. Всегда добавляем узел между выбранным узлом и следующим (+1) и Z определяем суммируя введенное значение длинны со знаком.

[VVA]

Давай так. Есть 3d полилиния с началом в т. 0,0,0 и координатами вершин: (0 0 0) (10 10 10) (30 20 0)
Я указал 2 вершину (10 10 10) и набрал +30. Получаем полилинию с координатами вершин (0 0 0) (10 10 10) (10 10 40) (30 20 0)
Я указал 2 вершину (10 10 10) и набрал -30. Получаем полилинию с координатами вершин: ?

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

VVA, возможны варианты: при вводе хоть "+", хоть "-" можно получить разные значения:
'((0. 0. 0.) (10. 10. 10.) (10. 10. 40.) (30. 20. 0.))
'((0. 0. 0.) (10. 10. 10.) (10. 10. 40.) (30. 20. 30.))
Какой из них будет верным?

[Supermax]

Я указал 2 вершину (10 10 10) и набрал +30. Получаем полилинию с координатами вершин (0 0 0) (10 10 10) (10 10 40) (30 20 0) Я указал 2 вершину (10 10 10) и набрал -30. Получаем полилинию с координатами вершин: ?

(0 0 0) (10 10 10) (10 10 -20) (30 20 0)

Все правильно. Добавляем точку только вперед по ходу полилинии.