Schöck
dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

Новые команды для работы с полилинией

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 14.09.2006, 13:30 3 |
Новые команды для работы с полилинией
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,717
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™

VVA на форуме Вставить имя

Данный набор программ является коллективным продуктом участников форумов autocad.ru и dwg.ru с моими доработками.
Захотелось собрать все программы для работы с полилиниями воедино и оформить как полагается.

=========== Доступные команды PLTOOLS=================
Редакция 17.06.2014
PL-JOIN -Объединение выбранных полилиний
PL-VFI -вставка вершин в выбранной полилинии в местах пересечения с
указанными полилиниями, линиями, дугами
PL-JOIN3D -Объединение 3D полилиний
PL-A2L -Замена линейного сегмента в полилинии дуговым сегментом.
PL-L2A -Замена дугового сегмента в полилинии линейным сегментом.
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
Просмотров: 7282
Размер:	30.3 Кб
ID:	21079  


Последний раз редактировалось VVA, 20.07.2015 в 19:42. Причина: Реверс дуговых сегментов полилинии
Просмотров: 260601
 
Непрочитано 22.06.2018, 11:49
#581
Nike

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


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


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


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

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

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

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

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


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


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

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


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


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

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

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

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


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

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


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

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


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


Цитата:
Сообщение от 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
Сообщений: 198


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

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


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


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


Прогрессирующий вариант построения прямоугольника по 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
Санкт-Петербург
Сообщений: 614


Autocad 2015 SP2. При использовании PL-VxRdc Autocad предлагает заменить "command" на "command-s". Использую вариант с панелями поэтому нет возможности внести изменения в файл pltools.fas
Цитата:
Невозможно вызвать (command) из *error* без предварительного вызова (*push-error-using-command*).
Рекомендуется преобразовать (command) в (command-s).
kacugu вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Новые команды для работы с полилинией

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

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

Быстрый переход

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||