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

Вернуться   Форум 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
Просмотров: 15347
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 08.09.2023 в 13:25. Причина: ссылка на иконки для темной темы
Просмотров: 367925
 
Непрочитано 22.06.2018, 11:49
#581
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


Хочу избавиться от лишнего ручного щелчка.
Вот что надо:
Миниатюры
Нажмите на изображение для увеличения
Название: 1.gif
Просмотров: 158
Размер:	59.6 Кб
ID:	203792  
Nike вне форума  
 
Непрочитано 22.06.2018, 11:54
#582
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Offtop:
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
впадает в панику и ступор?)

Offtop: скорее в иронический чёрный сарказм)))

Цитата:
Сообщение от Nike Посмотреть сообщение
А можно ли программно зацепить среднюю ручку сегмента полилинии для последующего его смещения
я думаю, что сегмент можно выбрать и тащить его также можно, вопрос только как сделать грамотное слежение?) grread обрубает привязки.

опа. так тут тащить ничего по ходу не нужно будет..

Последний раз редактировалось koMon, 22.06.2018 в 12:00.
koMon вне форума  
 
Непрочитано 22.06.2018, 12:11
#583
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


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

----- добавлено через ~5 ч. -----
Offtop:
Цитата:
Сообщение от koMon Посмотреть сообщение
прозвучало так, как будто компилятор C# штатно встроен в автокад)
вы не поверите - не то что в акад, а в сам windows компилятор встроен)
Сергей812 вне форума  
 
Непрочитано 22.06.2018, 22:07
#584
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Offtop:
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
вы не поверите - не то что в акад, а в сам windows компилятор встроен)

не поверю, боюсь что эта встройка обеспечивается лишь после инсталяции Visual Studio

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Тут скорее указывается полилиния и затем блоки
Nike, я бы так и делал бы
koMon вне форума  
 
Непрочитано 09.07.2018, 11:37
#585
Frigate

КИП, АСУ ТП, слаботочка
 
Регистрация: 02.09.2010
Москва-Тюмень
Сообщений: 422


Цитата:
Сообщение от koMon Посмотреть сообщение
выбор вершин секрамкой. уточнение - выбираются конечно же полилинии.
Здорово! огромное спасибо!

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


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

Последний раз редактировалось Frigate, 09.07.2018 в 12:07.
Frigate вне форума  
 
Непрочитано 09.07.2018, 17:15
#586
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Frigate Посмотреть сообщение
А можете немного подправить…
Цитата:
Сообщение от Frigate Посмотреть сообщение
Еще одна просьба…
Цитата:
Сообщение от Frigate Посмотреть сообщение
И вопрос всем…
Обрабатываются, только предварительно или выбранные после запуска команды полилинии. Размер опоясывающей рамки меняется движением мыши, перемещение опоясывающей рамки - однократное нажатие пробела, возврат к изменению размера - однократное нажатие пробела.

Код:
[Выделить все]
 
;***************************************************************************************************************************************************

;															 MOVE_MULTIPLE_VERTEX

;															  koMon, 16.07.2018

;***************************************************************************************************************************************************

(alert "\tКоманда  MOVE_MULTIPLE_VERTEX позволяет переместить
	несколько вершин выбранных предварительно или
	после запуска команды полилиний в выбранную точку.
	Нужные вершины опоясываются рамкой, изменение
	размера которой осуществляется движением мыши.
	Однократное нажатие пробела позволяет переместить
	рамку в другое место. Последующее однократное
	нажатие пробела возвращает рамку в режим изменения
	размера. Если внутри рамки нет вершин полилиний,
	она переключается в режим перемещения.

	\t\t\t\tkoMon, 16.07.2018"
)
(princ)

;***************************************************************************************************************************************************

																(vl-load-com)

;***************************************************************************************************************************************************

(defun c:Move_Multiple_Vertex ( /
									Coordinates_List Coordinates_List_Modified Crossing_Point_1 Crossing_Point_2 Current_Pline
									Entering_Crossing_Point_2 Move_Vertex_To_Point Nearest_Point
									Pline_Parameter Pline_Point_At_Parameter Points_List Point_Of_Interest
									Rect_Data Rect_Height Rect_Width Selecting_Plines Space_Pressed
									ssget_plines Gread_Data Plines_Pickset Plines_Pickset_Index
									Document_Object Getpoint_Data
							  )
	(setq selecting_plines t
		  acad_Object (vlax-get-acad-object)
	      document_object (vla-get-ActiveDocument acad_Object)
		  vlax_executed (vla-startUndoMark document_object)
	)

	;***************************************************************************************

	(defun ssget_plines ( / selecting_plines)
		(setq selecting_plines t)
		(while selecting_plines
			(setq plines_pickset (vl-catch-all-apply 'ssget (list '((0 . "LWPOLYLINE")))))
			(cond
				(
					(= 'PICKSET (type plines_pickset))
						(setq selecting_plines nil)
				)
				(
					(or
						(= 'VL-CATCH-ALL-APPLY-ERROR (type plines_pickset))
				        t
					)
				)
			)
		)
	)

	;***************************************************************************************

	(if (cadr (ssgetfirst))
		(progn
			(setq plines_pickset (cadr (ssgetfirst))
				  plines_pickset_index 0
			)
			(while (ssname plines_pickset plines_pickset_index)
				(if (not (equal '(0 . "LWPOLYLINE") (assoc 0 (entget (ssname plines_pickset plines_pickset_index)))))
					(ssdel (ssname plines_pickset plines_pickset_index) plines_pickset)
				)
				(setq plines_pickset_index (1+ plines_pickset_index))
			)
			(if (= 0 (sslength plines_pickset))
				(progn
					(sssetfirst nil)
					(ssget_plines)
				)
			)
		)
		(ssget_plines)
	)
	(sssetfirst nil plines_pickset)
	(setq crossing_point_1 (progn
		  							(while
		  						  			(or
		  						  				(not (setq getpoint_data (vl-catch-all-apply 'getpoint (list "\nВыберите рамкой вершины для перемещения: "))))
								  				(= 'VL-CATCH-ALL-APPLY-ERROR (type getpoint_data))
								  			)
									)
									getpoint_data
							)
		  crossing_point_2 nil
		  entering_crossing_point_2 t
		  space_pressed nil
	)
	(while entering_crossing_point_2
		(setq error_ocurred (if (vl-catch-all-error-p (setq gread_data (vl-catch-all-apply 'grread (list t 8 0)))) t nil))
    	(cond
			(
				error_ocurred
			)
			(
			   	(= 5 (car gread_data))
					(if crossing_point_2
						(grvecs (append (list 256) (cdr rect_data)))	;erasing color of holding frame
					)
					(setq crossing_point_2 (cadr gread_data))
					(if space_pressed
						(setq crossing_point_1 (list (- (car crossing_point_2) rect_width)
												   	 (- (cadr crossing_point_2) rect_height)
											   )
						)
					)
					(setq rect_data (list 256	;initial holding frame color
								  		  (list (car crossing_point_1) (cadr crossing_point_1))
								  		  (list (car crossing_point_1) (cadr crossing_point_2))

			       				  		  (list (car crossing_point_1) (cadr crossing_point_2))
			       				  		  (list (car crossing_point_2) (cadr crossing_point_2))

			       				  		  (list (car crossing_point_2) (cadr crossing_point_2))
			       				  		  (list (car crossing_point_2) (cadr crossing_point_1))

			       				  		  (list (car crossing_point_2) (cadr crossing_point_1))
			       				  		  (list (car crossing_point_1) (cadr crossing_point_1))
							 		)
					)
					(grvecs rect_data)
			)
			(
			 	(= 3 (car gread_data))
					(setq plines_pickset_index 0)
					(while (and
								(< plines_pickset_index (sslength plines_pickset))
								entering_crossing_point_2
							)
								(setq point_of_interest (polar crossing_point_1 (angle crossing_point_1 crossing_point_2) (/ (distance crossing_point_1 crossing_point_2) 2.0))
									  current_pline (vlax-ename->vla-object (ssname plines_pickset plines_pickset_index))
									  nearest_Point (vlax-curve-getClosestPointTo current_pline (trans point_of_interest 1 0))
									  pline_parameter (atoi (rtos (vlax-curve-getParamAtPoint current_pline nearest_Point) 2 0))
									  pline_point_at_parameter (trans (vlax-curve-getpointatparam current_pline pline_parameter) 0 1)
								)
								(if (and
										(>= (car pline_point_at_parameter) (min (car crossing_point_1) (car crossing_point_2)))
										(<= (car pline_point_at_parameter) (max (car crossing_point_1) (car crossing_point_2)))
										(>= (cadr pline_point_at_parameter) (min (cadr crossing_point_1) (cadr crossing_point_2)))
										(<= (cadr pline_point_at_parameter) (max (cadr crossing_point_1) (cadr crossing_point_2)))
									)
										(progn
											(setq entering_crossing_point_2 nil)
											(grvecs (append (list 256) (cdr rect_data)))	;erasing color of holding frame
										)
								)
								(setq plines_pickset_index (1+ plines_pickset_index))
					)
					(if entering_crossing_point_2
						(setq space_pressed t
							  rect_width (- (car crossing_point_2) (car crossing_point_1))
							  rect_height (- (cadr crossing_point_2) (cadr crossing_point_1))
						)
					)
			)
			(
				(equal gread_data (quote (2 32)))
					(if (null space_pressed)
						(setq space_pressed t
							  rect_width (- (car crossing_point_2) (car crossing_point_1))
							  rect_height (- (cadr crossing_point_2) (cadr crossing_point_1))
						)
						(setq space_pressed nil)
					)
			)
			(
			 	t
			)
		)
	)
	(setq point_of_interest (polar crossing_point_1 (angle crossing_point_1 crossing_point_2) (/ (distance crossing_point_1 crossing_point_2) 2.0))
		  move_vertex_to_Point
		  						(progn
		  								(while
		  							  			(or
		  							  				(not (setq getpoint_data (vl-catch-all-apply 'getpoint (list point_of_interest "\nУкажите точку для перемещения выбранных вершин: "))))
									  				(= 'VL-CATCH-ALL-APPLY-ERROR (type getpoint_data))
									  			)
										)
										getpoint_data
								)
	)
	(while (> (sslength plines_pickset) 0)
		(setq current_pline (vlax-ename->vla-object (ssname plines_pickset 0))
			  nearest_Point (vlax-curve-getClosestPointTo current_pline (trans point_of_interest 1 0))
			  pline_parameter (atoi (rtos (vlax-curve-getParamAtPoint current_pline nearest_Point) 2 0))
			  pline_point_at_parameter (trans (vlax-curve-getpointatparam current_pline pline_parameter) 0 1)
		)
		(if (and
				(>= (car pline_point_at_parameter) (min (car crossing_point_1) (car crossing_point_2)))
				(<= (car pline_point_at_parameter) (max (car crossing_point_1) (car crossing_point_2)))
				(>= (cadr pline_point_at_parameter) (min (cadr crossing_point_1) (cadr crossing_point_2)))
				(<= (cadr pline_point_at_parameter) (max (cadr crossing_point_1) (cadr crossing_point_2)))
			)
				(progn
					(setq coordinates_list (vlax-get current_pline 'coordinates)
						  points_list '()
					)
					(while (cddr coordinates_list)
	  					(setq points_list (cons (list (car coordinates_list) (cadr coordinates_list)) points_list)
	  						  coordinates_list (cddr coordinates_list)
	  					)
        			)
  					(setq points_list (reverse (cons (list (car coordinates_list) (cadr coordinates_list)) points_list))
  						  coordinates_list_modified '()
					)
  					(foreach pline_point (subst (list (car (trans move_vertex_to_Point 1 0)) (cadr (trans move_vertex_to_Point 1 0))) (nth pline_parameter points_list) points_list)
						(setq coordinates_list_modified (append coordinates_list_modified pline_point))
					)
  					(vl-catch-all-apply 'vlax-put (list current_pline 'coordinates coordinates_list_modified))
				)
		)
		(setq plines_pickset (ssdel (ssname plines_pickset 0) plines_pickset))
	)
	(vla-EndUndoMark document_object)
	(princ)
)

;***************************************************************************************************************************************************

Последний раз редактировалось koMon, 27.07.2018 в 09:07. Причина: Модификация выбора полилиний, рамки для опоясывания вершин
koMon вне форума  
 
Непрочитано 13.07.2018, 18:06
#587
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


GIFы
Миниатюры
Нажмите на изображение для увеличения
Название: MMV_1.gif
Просмотров: 131
Размер:	1.38 Мб
ID:	204439  Нажмите на изображение для увеличения
Название: MMV_2.gif
Просмотров: 107
Размер:	1.82 Мб
ID:	204440  
koMon вне форума  
 
Непрочитано 22.09.2018, 10:43
#588
Cfytrr

Балка на балку, кирпич на кирпич...
 
Регистрация: 09.10.2007
Питер
Сообщений: 4,811
Отправить сообщение для Cfytrr с помощью Skype™


Цитата:
Сообщение от VVA Посмотреть сообщение
пока не смогу проверить
С ошибочной отрисовкой прямоугольников в 2019 акаде ничего не сдвинулось? Очень расстраивает меня эта ошибка
__________________
...переменная FILEDIA создана для привлечения пользователей к форумам.
Cfytrr вне форума  
 
Непрочитано 26.09.2018, 14:08
#589
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Прогрессирующий вариант построения прямоугольника по 2-м диагональным точкам.

Код:
[Выделить все]
 
;***************************************************************************************************************************************************

;														  		2_Points_Rectangle

;												Рисуется прямоугольник по двум диагональным точкам
; 												в ТЕКУЩЕМ НЕЗАБЛОКИРОВАННОМ слое.

;												1. Указывается первая диагональная точка.
;												2. Указывается направление прямоугольника.
;												3. Указывается вторая диагональная точка ЛКМ без привязки ("на глаз")
;													Или:
;														ПКМ - для указания 2-й диагональной точки
;														W,Ц - для указания ширины прямоугольника
;														H,Р - для указания высоты прямоугольника
;														A,Ф - для указания угла наклона прямоугольника
;														R,К - для указания площади, при указанной ширине или высоте
;														O,Щ - для указания 1-ой точки прямоугольника
;												4. Завершение команды при определённом прямоугольнике ЛКМ, ПКМ, Space, Enter

;															koMon, 26.09.2018 (1 yr m-ship)

;***************************************************************************************************************************************************

																(vl-load-com)

;***************************************************************************************************************************************************

(defun c:2_Points_Rectangle ( /
								Create_Pline rnil_to_string Calculate_Rect calculate_point_3 get_input_data write_prompt
								Acad_Object Angle_c1_c3 Distance_c1_c3 Document_Object getting_rect_point_3 Error_Ocurred
								Gread_Data Modelspace_Object Rect_Angle
								Vlax_Executed Lisp_Executed
								X_Rotated Y_Rotated Rect_Height Rect_Width
								pline_created
								Height_Fixed Rect_Area Width_Fixed
								ucs_X_Angle ucs_Y_Angle symmetry_multiplier
							)

	;***********************************************************************************************************************************************

	(defun create_pline (point_1 point_2 point_3 point_4 pline_exists / pline_coordinates_array Pline_Coordinates_List)
    	(setq pline_coordinates_array (vlax-make-safearray vlax-vbDouble (cons 1
																			   (length
																			   			(setq pline_coordinates_list
																													(append
																															(append (list (* symmetry_multiplier (car (trans point_1 1 0)))) (cdr (trans point_1 1 0)))
																															(append (list (* symmetry_multiplier (car (trans point_2 1 0)))) (cdr (trans point_2 1 0)))
																															(append (list (* symmetry_multiplier (car (trans point_3 1 0)))) (cdr (trans point_3 1 0)))
																															(append (list (* symmetry_multiplier (car (trans point_4 1 0)))) (cdr (trans point_4 1 0)))
																												  	)
																						)
																				)
																		 )
									  )
		)
    	(vlax-safearray-fill pline_coordinates_array pline_coordinates_list)
		(if (null pline_exists)
			(progn
    			(setq pline_Object (vla-AddPolyline modelSpace_object pline_coordinates_array)
					  pline_created t
				)
				(vla-put-closed pline_object :vlax-true)
			)
    		(vla-put-coordinates pline_Object pline_coordinates_array)
		)
	)

	;***********************************************************************************************************************************************

	(defun rnil_to_string (input_value is_radians /)
		(if (or (null input_value)
				(zerop input_value)
			)
				""
			(cond
				(
					is_radians
						(angtos input_value 0 (getvar 'auprec))
				)
				(
					t
						(rtos input_value)
				)
			)
		)
	)

	;***********************************************************************************************************************************************

	(defun calculate_rect (point_1 point_3 / angle_c1_c3 x_rotated y_rotated)
		(setq distance_c1_c3 (distance point_1 point_3)
			  angle_c1_c3 (angle point_1 point_3)
			  x_rotated (* distance_c1_c3 (cos (- angle_c1_c3 rect_angle)))
			  y_rotated (* distance_c1_c3 (sin (- angle_c1_c3 rect_angle)))
			  rect_point_2 (polar point_1 (+ rect_angle (* 0.5 pi)) y_rotated)
			  rect_point_4 (polar point_1 rect_angle x_rotated)
		)
	)

	;***********************************************************************************************************************************************

	(defun calculate_point_3 (base_point /)
		(cond
			(
				(and width_fixed (null height_fixed))
					(setq rect_point_3 (inters base_point
											   (polar base_point rect_angle 5.0)
											   (polar rect_point_1 rect_angle rect_width)
											   (polar (polar rect_point_1 rect_angle rect_width) (- rect_angle (* 0.5 pi)) 5.0)
											   nil
									   )
					)
			)
			(
				(and (null width_fixed) height_fixed)
					(setq rect_point_3 (inters base_point
											   (polar base_point (+ rect_angle (* 0.5 pi)) 5.0)
											   (polar rect_point_1 (+ rect_angle (* 0.5 pi)) rect_height)
											   (polar (polar rect_point_1 (+ rect_angle (* 0.5 pi)) rect_height) rect_angle 5.0)
											   nil
									   )
					)
			)
			(
				(and width_fixed height_fixed)
					(setq rect_point_3 (polar (polar rect_point_1 rect_angle rect_width) (+ rect_angle (* 0.5 pi)) rect_height))
			)
			(
				t
					(setq rect_point_3 base_point)
			)
		)
	)

	;***********************************************************************************************************************************************

	(defun get_input_data (parsed_function parsed_parameter_list / get_data)
		 (progn
		  		(while
		  				(or
		  					(not (setq get_data (vl-catch-all-apply parsed_function parsed_parameter_list)))
							(= 'vl-catch-all-apply-error (type get_data))
						)
				)
				get_data
		 )
	)

	;***********************************************************************************************************************************************

	(defun write_prompt (parsed_width_fixed parsed_height_fixed /)
		(if (and parsed_width_fixed parsed_height_fixed)
			(prompt "\nПрямоугольник определён. Завершите команду или обнулите один из размеров.")
			(prompt "\nУкажите 2-й угол прямоугольника: ")
		)
	)

	;***********************************************************************************************************************************************


	(setq acad_Object (vlax-get-acad-object)
	  	  document_object (vla-get-ActiveDocument acad_Object)
	      modelSpace_object (vla-get-ModelSpace document_object)
		  vlax_executed (vla-startUndoMark document_object)
		  rect_point_1 (get_input_data 'getpoint (list "\nУкажите 1-й угол прямоугольника: "))
		  rect_angle (get_input_data 'getangle (list rect_point_1 (strcat "\nУкажите угол наклона прямоугольника [" (rnil_to_string rect_angle t) "]: ")))
		  rect_point_3 nil
		  getting_rect_point_3 t
		  width_fixed nil
		  height_fixed nil
		  pline_created nil
		  rect_width nil
		  rect_area nil
		  ucs_X_Angle (if (zerop (setq ucs_X_Angle (angle '(0 0 0) (getvar 'ucsxdir)))) (* 2 pi) ucs_X_Angle)
		  ucs_Y_Angle_normalized (if (minusp (setq ucs_Y_Angle_normalized (- (setq ucs_Y_Angle (angle '(0 0 0) (getvar 'ucsydir))) ucs_X_Angle))) (+ (* 2 pi) ucs_Y_Angle_normalized) ucs_Y_Angle_normalized)
		  symmetry_multiplier (if (equal ucs_Y_Angle_normalized (* 0.5 pi) 1e-6) 1 -1)
	)
	(write_prompt width_fixed height_fixed)
	(while getting_rect_point_3
		(setq error_ocurred (if (vl-catch-all-error-p (setq gread_data (vl-catch-all-apply 'grread (list t 8 0)))) t nil))
    	(cond
			(
				error_ocurred
					(prompt "\nНеверно!")
			)
			(
			   	(= 25 (car gread_data))				;Mouse Right Click
					(if (and width_fixed height_fixed)
							(setq getting_rect_point_3 nil)
							(setq rect_point_3 (get_input_data 'getpoint (list rect_point_1 "\nУкажите 2-й угол прямоугольника: "))
								  getting_rect_point_3 nil
							)
					)
					(calculate_point_3 rect_point_3)
					(calculate_rect rect_point_1 rect_point_3)
					(create_pline rect_point_1 rect_point_2 rect_point_3 rect_point_4 pline_created)
			)
			(
			   	(= 5 (car gread_data))				;Mouse Moving
					(calculate_point_3 (cadr gread_data))
					(calculate_rect rect_point_1 rect_point_3)
					(create_pline rect_point_1 rect_point_2 rect_point_3 rect_point_4 pline_created)
			)
			(
			 	(= 3 (car gread_data))				;Mouse Left Click
					(setq getting_rect_point_3 nil)
					(if getting_rect_point_3
						(setq rect_width (- (car rect_point_3) (car rect_point_1))
							  rect_height (- (cadr rect_point_3) (cadr rect_point_1))
						)
					)
					(calculate_rect rect_point_1 rect_point_3)
					(create_pline rect_point_1 rect_point_2 rect_point_3 rect_point_4 pline_created)
			)
			(
				(or
					(equal gread_data (quote (2 111)))		;O
					(equal gread_data (quote (2 1097)))     ;Щ
				)
					(setq rect_point_1 (get_input_data 'getpoint (list rect_point_1 "\nУкажите точку 1-го угла прямоугольника: ")))
			)
			(
				(or
					(equal gread_data (quote (2 97)))		;A
					(equal gread_data (quote (2 1092)))     ;Ф
				)
					(setq rect_angle (get_input_data 'getangle (list rect_point_1 (strcat "\nУкажите угол наклона прямоугольника [" (rnil_to_string rect_angle t) "]: "))))
					(write_prompt width_fixed height_fixed)
			)
			(
				(or
					(equal gread_data (quote (2 119)))		;W
					(equal gread_data (quote (2 1094)))     ;Ц
				)
					(setq rect_width (get_input_data 'getdist (list rect_point_1 (strcat "\nУкажите длину прямоугольника [" (rnil_to_string rect_width nil) "]: "))))

					(if (zerop rect_width)
						(setq width_fixed nil)
						(setq width_fixed t
							  rect_width (abs rect_width)
						)
					)
					(write_prompt width_fixed height_fixed)
			)
			(
				(or
					(equal gread_data (quote (2 104)))		;H
					(equal gread_data (quote (2 1088)))     ;Р
				)
					(setq rect_height (get_input_data 'getdist (list rect_point_1 (strcat "\nУкажите высоту прямоугольника [" (rnil_to_string rect_height nil) "]: "))))

					(if (zerop rect_height)
						(setq height_fixed nil)
						(setq height_fixed t
							  rect_height (abs rect_height)
						)
					)
					(write_prompt width_fixed height_fixed)
			)
			(
				(or
					(equal gread_data (quote (2 114)))		;R
					(equal gread_data (quote (2 1082)))     ;К
				)
					(if
						(and
							(not (and width_fixed height_fixed))
							(or (null width_fixed) (null height_fixed))
							(or width_fixed height_fixed)
						)
							(progn
								(while (zerop (setq rect_area (get_input_data 'getreal (list (strcat "\nУкажите площадь прямоугольника [" (rnil_to_string rect_area nil) "]: "))))))
								(if width_fixed
									(setq rect_height (/ rect_area rect_width)
										  height_fixed t
									)
								)
								(if height_fixed
									(setq rect_width (/ rect_area rect_height)
										  width_fixed t
									)
								)
								(write_prompt width_fixed height_fixed)
							)
							(progn
								(prompt "\nДля указания площади должна быть задана ширина или высота прямоугольника")
								(write_prompt width_fixed height_fixed)
							)
					)
			)
			(
				(or
					(equal gread_data (quote (2 32)))		;Space
					(equal gread_data (quote (2 13)))     	;Enter
				)
					(if (and width_fixed height_fixed)
						(progn
							(setq getting_rect_point_3 nil)
							(calculate_point_3 rect_point_3)
							(calculate_rect rect_point_1 rect_point_3)
							(create_pline rect_point_1 rect_point_2 rect_point_3 rect_point_4 pline_created)
						)
						(prompt "\nНеверно!")
					)
			)
			(
			 	t
					(prompt "\nНеверно!")
			)
		)
	)
	(vla-EndUndoMark document_object)
	(foreach variable '(Rect_Point_1 Rect_Point_2 Rect_Point_3 Rect_Point_4 pline_object)
		(set variable nil)
	)
	(princ "\nКоманда завершена")
	(princ)
)

;***************************************************************************************************************************************************


Последний раз редактировалось koMon, 08.10.2018 в 11:26. Причина: Динамически изменяется созданный прямоугольник. Добавлены опции по заданию размеров прямоугольника.
koMon вне форума  
 
Непрочитано 09.10.2018, 14:15
#590
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 893


Autocad 2015 SP2. При использовании PL-VxRdc Autocad предлагает заменить "command" на "command-s". Использую вариант с панелями поэтому нет возможности внести изменения в файл pltools.fas
Цитата:
Невозможно вызвать (command) из *error* без предварительного вызова (*push-error-using-command*).
Рекомендуется преобразовать (command) в (command-s).
kacugu вне форума  
 
Непрочитано 25.01.2019, 16:47
#591
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от kacugu Посмотреть сообщение
нет возможности внести изменения в файл pltools.fas
но ведь можно внести изменения в лисп, который в шапке, да и компильнуть его?!

;******************************************
Это их худые черти бермутят воду во пруду,
Это все придумал Черчилль в восемнадцатом году.
Мы про взрывы, про пожары сочиняли ноту ТАСС,
Тут примчались саNETары и зафиксировали нас.
;******************************************

fas так fas)
check_pline.fas
проверка и оптимизация LW полилинии.
Миниатюры
Нажмите на изображение для увеличения
Название: Check_Pline.gif
Просмотров: 50
Размер:	879.1 Кб
ID:	210318  
Вложения
Тип файла: rar Check_Pline.fas.rar (11.9 Кб, 26 просмотров)
koMon вне форума  
 
Непрочитано 15.02.2019, 13:33
1 | #592
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Хочу примазаться к высокому искусству .
Недавно пришлось работать с чертежом, содержащим множество отрезков и полилиний с текстовым типом линий (например ----В---- или -----К----).
В результате всяких манипуляций на многих из них тип линий отображался "вверх ногами", что не есть хорошо. Т.к. команды ENTREV и ENTREVS сами не определяют, нормально ли отображается тип линии и нужен ли реверс, а выделять подлежащих реверсированию вручную неинтересно, написал небольшую модификацию Entrev. Она автоматически определяет отрезки, у которых тип линии "вверх ногами" и только для них выполняет реверс.
Работает только для отрезков - для полилиний из прямолинейных сегментов дуг и сплайнов бессмысленно, т.к. реверсируется весь объект целиком, а в случае поворота на 90 град. и более разные сегменты будут выглядеть по-разному - одни нормально, другие "вверх ногами". И реверсирование полилинии в таком случае для одних сегментов исправит ситуацию, а для других - испортит.
Поэтому в фильтр выбора включены только отрезки, строки для работы с полилиниями и сплайнами закомментированы.

Код:
[Выделить все]
(defun C:Entrev1 ( / int:i e1 ed list:pt *error* )
(setq *error* pltool-err)
  (or *kpblc-activedoc*
       (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  (vla-endundomark *kpblc-activedoc*)
  (vla-startundomark *kpblc-activedoc*)
    (kpblc-error-save-sysvar
      (list '("osmode")	'("CLAYER") '("QAFLAGS" 0) '("CMDECHO" 0)))
  (princ "\nВыберите Полилинии, Сплайны и Отрезки для реверса  ")
  (setq PICK1 nil
	PICK1 (ssget "_:L" '((0 . "LINE") )))
  (setq int:i 0)
  (while (and PICK1 (setq e1 (ssname PICK1 int:i)))
    (setq list:pt nil)
    (setq ed (entget e1))
    (cond ((and (>= (vla-get-angle (vlax-ename->vla-object (cdar ed))) (* pi 0.7501)) (<= (vla-get-angle (vlax-ename->vla-object (cdar ed))) (* pi 1.501)))
	   (setq e1 (vlax-ename->vla-object e1))
	   (setq list:pt (mapcar '(lambda (x) (vlax-get e1 x))
			   '(StartPoint EndPoint))
		 list:pt  (reverse list:pt))
	   (vla-put-StartPoint e1 (vlax-3d-point (car list:pt)))
	   (vla-put-EndPoint e1 (vlax-3d-point (cadr list:pt)))
	  )
;;;	  ((= (cdr(assoc 0 ed)) "LWPOLYLINE")
;;;	   (lib:plineLW-reverse e1)
;;;          ;(entdel e1)
;;;	   )
;;;	  ((= (cdr(assoc 0 ed)) "SPLINE")(vla-reverse (vlax-ename->vla-object e1))) 
;;;  	  ((= (cdr(assoc 0 ed)) "POLYLINE")
;;;	   (ru-geom-polyline-revers e1))
	  (t nil)
    )	  
    (setq int:i (1+ int:i))
  )
   (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
        (princ (strcat "\nВыполнен реверс " (itoa int:i) " объектов"))
        (princ (strcat "\nThe reverser of " (itoa int:i) " object is executed")))
  (setq PICK1 nil)
(kpblc-error-restore-sysvar)
(vla-endundomark *kpblc-activedoc*)
  (princ))

Последний раз редактировалось kp+, 19.02.2019 в 23:17.
kp+ вне форума  
 
Автор темы   Непрочитано 19.02.2019, 21:30
1 | #593
VVA

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


Цитата:
Сообщение от kp+ Посмотреть сообщение
для полилиний, дуг и сплайнов бессмысленно, т.к. реверсируется весь объект целиком, а в случае поворота на 90 град. и более разные сегменты будут выглядеть по-разному - одни нормально, другие "вверх ногами". И реверсирование полилинии в таком случае для одних сегментов исправит ситуацию, а для других - испортит.
Для полилиний не все так безрадостно. Почитай пост #79 (ссылка дана в #1)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 19.02.2019, 23:25
#594
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Спасибо, прочитал. Действительно работает для полилиний с дуговыми сегментами. А для полилиний с хитровыкрученными линейными сегментами - не очень.
kp+ вне форума  
 
Автор темы   Непрочитано 20.02.2019, 09:08
2 | #595
VVA

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


kp+, По моему, с 2010 Автокада есть другое решение. В описании типа линий появился параметр флаг поворота U ("вертикальный")
Загрузи этот тип линий и попробуй порисовать слева-направо, справа-налево и хитровыкрученными линейными сегментами
Цитата:
*-В1(7 ед),---- В1 ---- В1 (7 ед)
A,2.0,-1.0,["В1",STANDARD,S=1.6,Y=-0.8,U=0.0],-3.1
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.02.2019, 16:17
#596
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Хм, интересно. Жаль, что не с 2010 (на котором работаю), а только с 2011. 2010 ругается на неверное определение и сообщает, что "в выражении должны присутствовать R, A, S, X, или Y"

Последний раз редактировалось kp+, 20.02.2019 в 16:37.
kp+ вне форума  
 
Непрочитано 20.02.2019, 17:46
#597
posetitel


 
Регистрация: 16.10.2013
Сообщений: 323


товарищи, при установке архива с программами для работы с полилиниями загрузил меню, как написано в файле ридми, и у меня все мои менюшки слетели, а главное мое настроенное рабочее пространство я не могу загрузить.
что делать? как так получилось?
posetitel вне форума  
 
Непрочитано 21.02.2019, 09:22
#598
posetitel


 
Регистрация: 16.10.2013
Сообщений: 323


Прилагаю скриншот
Такого у меня еще не было, если слетает, то что-то одно. а тут вообще все слетело, даже меню только "файл" "окно" и "справка" доступны
Миниатюры
Нажмите на изображение для увеличения
Название: Автокад.jpg
Просмотров: 33
Размер:	153.1 Кб
ID:	211182  
posetitel вне форума  
 
Автор темы   Непрочитано 21.02.2019, 09:57
1 | #599
VVA

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


найди acad.cuix.bak и верни обратно. А вообще надо начинать с версии винды, прав, версии Автокада.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.02.2019, 10:14
#600
posetitel


 
Регистрация: 16.10.2013
Сообщений: 323


Уф, вроде восстановилось
Добавляю меню с помощью _menuload и выбираю файл .mnu (а то файлы .cuix сносят все нафик и опустошают настроенное пространство)
Но теперь в строке меню нет раздела pltools (см скриншот п.1, обвел куда нужно добавить меню работы с полилиниями)
Пытался сделать: сервис - адаптация - интерфейс - перевести, отдельно открыл файл pltools.cuix в правом окне, но в нем когда разворачиваю колонку "меню" ничего не раскрывается, т.е. перенести тупо нечего
(см скриншот п.2)
версия винды 8.1, автокад 2014.
Миниатюры
Нажмите на изображение для увеличения
Название: Настройка менюшек автокада.jpg
Просмотров: 39
Размер:	210.9 Кб
ID:	211200  

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

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

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