[Ingpro]

Всем доброго дня и с наступающим!
Программа строит линии перпендикулярные к выбранной ("POLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE") .
Как можно добавить в лисп включение привязки (к конточке, к середине, к пересечению, к квадранту)? Спасибо.

Код:

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

 ;;; Draw perpendicular line
;;; Alan J. Thompson, 10.15.09
(defun c:LPer (/ #Ent #Read)
(and
(setq #Ent (car (entsel "\nSelect curve: ")))
(vl-position (cdr (assoc 0 (entget #Ent))) '("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE"))
(while (not (eq 25 (car (setq #Read (grread T 15 0)))))
(princ "\rSpecify point for line: ")
(redraw)
(if (vl-consp (cadr #Read))
(grdraw (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T)


(trans (cadr #Read) 1 0) 1 ) ;_ grdraw
) ;_ if
(if (eq 3 (car #Read))
(entmake (list '(0 . "LINE")
(cons 10 (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
(cons 11 (trans (cadr #Read) 1 0))
) ;_ list
) ;_ entmake
) ;_ if
) ;_ while
) ;_ and
(redraw)
(princ)
) ;_ defun

[Krieger]

По-моему, в grdraw никак, только если свою такую функцию как-то сочинить.

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

[zenon]

может это поможет
http://www.lee-mac.com/objectalign.html

[Ingpro]

Сообщение от zenon может это поможет http://www.lee-mac.com/objectalign.html

Это совсем другое, objectalign выравнивает выбранные объекты по выбранной кривой, кстати тоже без привязок...

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

Попробуй использовать getpoint - интерактивности не будет, но (возможно) будет результат.

----- добавлено через ~26 мин. -----
Если решишься использовать библиотеку:

Код:

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

 (defun per (/ selset point)
  (if (setq selset (car (_kpblc-conv-selset-to-ename
                          (_kpblc-selset-msg
                            "Select curve"
                            (function (lambda () (ssget "_+.:S:E" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
                          ) ;_ end of _kpblc-selset-msg
                        ) ;_ end of _kpblc-conv-selset-to-ename
                   ) ;_ end of car
      ) ;_ end of setq
    (progn
      (while (and (= (type (setq point (vl-catch-all-apply (function (lambda () (getpoint "\nPick point <Cancel> : ")))))
                     ) ;_ end of type
                     'list
                  ) ;_ end of =
                  point
             ) ;_ end of and
        (entmake (list '(0 . "LINE")
                       (cons 10 point)
                       (cons 11 (vlax-curve-getclosestpointto selset point))
                 ) ;_ end of list
        ) ;_ end of entmake
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

[===AAA===]

Сорри, а что означает конструкция "_+." в параметрах ssget ?

"подчерк" - понятно, "точка" - видимо, тоже самое, что и в командах
(или нет?), а вот "плюсик" - теряюсь в догадках.

Сам такую конструкцию не сооружал ни разу... Вдруг и мне пригодится? :-)

[Сергей812]

плюсик

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Если решишься использовать библиотеку: Код: [Выделить все] (defun per

Алексей, Вы супер, спасибо! Работает и без библиотеки. Если укажешь точку привязки, перпендикуляр ставится к ней, не указываешь точку привязки, перпендикуляр ставится в произвольном месте. В одном сеансе можно поставить несколько перпендикуляров...

[Ingpro]

Чё-то с привязками не очень корректно работает...
Алексей, если не слишком, немного уточню, можно перпендикуляр начинать строить из точки,
которая расположена на линии, к которой строится перпендикуляр.
Т.е. когда мы строим отрезок перпендикулярный к линии (обычным способом), то ведем отрезок и ловим привязку "перпендикуляр" на линии. Хотелось бы наоборот, на линии выбрать точку и строить от неё перпендикуляр. Спасибо.

[Boxa]

В C# можно попросить у автокада ближайшую точку.... но в общем виде: по имеющемся координатам линии получаете уравнения прямой, из этого уравнения, меняя местами коэффициенты при неизвестных получаете уравнение перпендикулярной прямой, а там по имеющимся коэффициентам и координатам одной точки найдете коэффициент С и потом надо просто найти точку пересечения двух прямых и проверить ее принадлежность отрезку...
Написал пояснение наверное длине, чем это все в коде воплотить =) , Вот тут есть все формулы: https://ru.wikipedia.org/wiki/%D0%9F...BC%D0%B0%D1%8F

[Ingpro]

Сообщение от Boxa Вот тут есть все формулы

Boxa, спасибо. Наверное, не смогу эти формулы куда надо вставить...

[Krieger]

А _xline чем не устроил?

https://youtu.be/A1dPvuZhSsU

[Ingpro]

Сообщение от Krieger А _xline чем не устроил? https://youtu.be/A1dPvuZhSsU

Задача наоборот: перпендикуляр строится от линии, точнее от точки привязки на этой же линии...

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

На видео все показано )))

[Krieger]

Ну дык и тыкай по линии:

https://youtu.be/nO-GQijBcmY

[Ingpro]

Сообщение от Krieger Ну дык и тыкай по линии: https://youtu.be/nO-GQijBcmY

Эти бесконечные двухсторонние перпендикуляры неудобны...

[Krieger]

Сообщение от Ingpro Подозреваю, что "per xline" (и где он?) не на лисп?.. Ну и эти бесконечные двухсторонние перпендикуляры неудобны... имхо...

Это не лисп, _xline - это штатная команда автокада. Зачем изобретать велосипед, если и так работает? Почему не удобны? Обрежь. А как определить их конечность? А как по одной точке на кривой можно сделать что-то кроме прямой?
Я уже писал, что далее это можно сварганить в лисп. Сначала строится прямая перпендикулярная кривой (известна первая точка на кривой), еще одной точкой определяется конечность на этой прямой, получаем вторую точку - строим отрезок по двум точкам, удаляем прямую. И визуалити есть, и привязки работают и отрезок построили.

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

Потом в крайнем случае _trim (возможно, с опцией _f)

[Ingpro]

Сообщение от Krieger _xline - это штатная команда автокада

_xline (ПРЯМАЯ) не совсем то, что в лиспе.

[koMon]

Сообщение от Ingpro Задача наоборот: перпендикуляр строится от линии, точнее от точки привязки на этой же линии...

Код:

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

 
(setq curve_not_selected t)
(while curve_not_selected
	(setq origin_point_perpendicular (getpoint "\Точка на кривой: "))
	(if (setq nentselp_data (nentselp origin_point_perpendicular))
			(progn
				(setq curve_object (vlax-ename->vla-object (car nentselp_data))
		  			  1st_derivative (vlax-curve-getfirstderiv curve_object (vlax-curve-getparamatpoint curve_object (trans origin_point_perpendicular 1 0)))
		  			  1st_derivative_angle (angle (trans '(0 0 0) 0 1) (trans 1st_derivative 0 1))
		  			  target_direction_point (getpoint origin_point_perpendicular "\nНаправление перпендикуляра: ")
		  			  target_direction (angle origin_point_perpendicular target_direction_point)
		  			  normalized_target_direction (if (< (- (angle origin_point_perpendicular target_direction_point) 1st_derivative_angle) 0)
		  														(+ (- target_direction 1st_derivative_angle) (* 2 pi))
		  														(- target_direction 1st_derivative_angle)
		  											  )
				)
				(setq target_distance (if (> pi normalized_target_direction) +100 -100))
				(command "_line" "_non" origin_point_perpendicular "_non" (polar origin_point_perpendicular (+ (* 0.5 pi) 1st_derivative_angle) target_distance) "")
				(setq curve_not_selected nil)
			)
	)
)

[Ingpro]

Комоn, спасибо, только какой командой вызывать, или, если это часть кода, то куда добавить?..

[koMon]

нужно в самом начале добавить, например:
(defun c:set_perpendicular ()
и в самом конце закрывающую скобку
) .

[Ingpro]

Сообщение от koMon нужно в самом начале добавить, например: (defun c:set_perpendicular () и в самом конце закрывающую скобку ) .

Код:

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

 (defun c:set_perpendicular ()
(setq curve_not_selected t)
	(while curve_not_selected
	    (setq origin_point_perpendicular (getpoint "\Точка на кривой: "))
	    (if (setq nentselp_data (nentselp origin_point_perpendicular))
	            (progn
	                (setq curve_object (vlax-ename->vla-object (car nentselp_data))
	                      1st_derivative (vlax-curve-getfirstderiv curve_object (vlax-curve-getparamatpoint curve_object (trans origin_point_perpendicular 1 0)))
	                      1st_derivative_angle (angle (trans '(0 0 0) 0 1) (trans 1st_derivative 0 1))
	                      target_direction_point (getpoint origin_point_perpendicular "\nНаправление перпендикуляра: ")
	                      target_direction (angle origin_point_perpendicular target_direction_point)
	                      normalized_target_direction (if (< (- (angle origin_point_perpendicular target_direction_point) 1st_derivative_angle) 0)
	                                                                (+ (- target_direction 1st_derivative_angle) (* 2 pi))
	                                                                (- target_direction 1st_derivative_angle)
	                                                      )
	                )
	                (setq target_distance (if (> pi normalized_target_direction) +100 -100))
	                (command "_line" "_non" origin_point_perpendicular "_non" (polar origin_point_perpendicular (+ (* 0.5 pi) 1st_derivative_angle) target_distance) "")
	                (setq curve_not_selected nil)
	            )
	    )
	)
(princ)
)

Вот так добавляю, вызываю команду, привязка к линии есть, а сам перпендикуляр не строится...
В КС пишет: "Команда: SET_PERPENDICULAR
Точка на кривой:
Направление перпендикуляра: _line
Первая точка: _non
Следующая точка или [оТменить]: _non
Следующая точка или [оТменить]:
Команда: nil"
А перпендикуляр может быть только от кривой? От линии, полилинии, круга... нет?..

[koMon]

к любой кривой...и прямой...

----- добавлено через ~8 мин. -----
м. б. размеры гигантские, перпендикуляр просто не виден. он рисуется отрезком в 100 единиц.

----- добавлено через ~9 мин. -----
и перед последней закрывающей скобкой хорошо бы добавить
(princ)
чтобы не выводить nil.

[Ingpro]

Да, действительно, рисуются отрезком в 100 ед. и к любой кривой...и прямой...
Эту строку

Код:

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

 (setq target_distance (if (> pi normalized_target_direction) +100 -100))

можно заменить, например, на

Код:

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

 (setq target_distance (if (> pi normalized_target_direction) +500 -500))

koMon, огромная Вам благодарность, успехов в Новом Году!
А фиксированная длина перпендикуляра - это неизменно? Или возможно указать первую и последнюю точку?..

[koMon]

Сообщение от Ingpro Или возможно указать первую и последнюю точку?..

возможно...

Код:

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

 
(defun c:set_perpendicular (/ model_space_object curve_selected origin_point_perpendicular nentselp_data curve_object 1st_derivative 1st_derivative_angle
							  xline_object 2nd_point_perpendicular 2nd_point_perpendicular_direction normalized_2nd_point_perpendicular_direction
			   			   )
	(setq model_space_object (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
	(while (not curve_selected)
		(setq origin_point_perpendicular (getpoint "\Точка на кривой (первая точка перпендикуляра): "))
		(if (setq nentselp_data (nentselp origin_point_perpendicular))
				(progn
					(setq curve_object (vlax-ename->vla-object (car nentselp_data))
			  		      1st_derivative (vlax-curve-getfirstderiv curve_object (vlax-curve-getparamatpoint curve_object (trans origin_point_perpendicular 1 0)))
			  		      1st_derivative_angle (angle (trans '(0 0 0) 0 1) (trans 1st_derivative 0 1))
					      xline_object (vla-addxline model_space_object
					  	      			 			(vlax-3d-point (trans origin_point_perpendicular 1 0))
					  	      			 			(vlax-3d-point (trans (polar origin_point_perpendicular (+ (* 0.5 pi) 1st_derivative_angle) 1) 1 0))
							   		   )
					)
					(vla-put-color xline_object 1)
					(setq 2nd_point_perpendicular (vl-catch-all-apply 'getpoint (list origin_point_perpendicular "\nВторая точка перпендикуляра: ")))
					(if (or
							(null 2nd_point_perpendicular)
							(vl-catch-all-error-p 2nd_point_perpendicular)
						)
							(setq curve_selected t)
							(progn
				  				(setq 2nd_point_perpendicular_direction (angle origin_point_perpendicular 2nd_point_perpendicular)
			  					      normalized_2nd_point_perpendicular_direction (if (< (- (angle origin_point_perpendicular 2nd_point_perpendicular) 1st_derivative_angle) 0)
			  																				(+ (- 2nd_point_perpendicular_direction 1st_derivative_angle) (* 2 pi))
			  																				(- 2nd_point_perpendicular_direction 1st_derivative_angle)
			  											   						   )
				    			)
				  				(if (or
								      	(equal (* 0.5 pi) normalized_2nd_point_perpendicular_direction 1e-6)
								  		(equal (* 1.5 pi) normalized_2nd_point_perpendicular_direction 1e-6)
								    )
				  					(vla-addline model_space_object
												(vlax-3d-point (trans origin_point_perpendicular 1 0))
												(vlax-3d-point (trans 2nd_point_perpendicular 1 0))
									)
								  	(vla-addline model_space_object
												(vlax-3d-point (trans origin_point_perpendicular 1 0))
												(vlax-3d-point (trans (polar origin_point_perpendicular
																	  		 (+ (* 0.5 pi) 1st_derivative_angle)
																	  		 (if (> pi normalized_2nd_point_perpendicular_direction)
																	  		 		(distance origin_point_perpendicular 2nd_point_perpendicular)
																	  		 		(* -1 (distance origin_point_perpendicular 2nd_point_perpendicular))
																	  		 )
																	  )
																1 0
															   )
												)
									)
				  				)
				  				(vla-erase xline_object)
								(setq curve_selected t)
						)
					)
				)
		)
	)
  	(princ)
)

[Ingpro]

koMon, не удалось протестировать лисп из поста #26...
; ошибка: неверно сформированный список на входе
Неизвестная команда...
Лисп из поста #23 отлично работает...

[koMon]

лисп любит парность скобок в коде, копируемом ч/з буфер обмена)

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

[Ingpro]

Сообщение от koMon лисп любит парность скобок в коде, копируемом ч/з буфер обмена)

Спасибо, koMon, буду знать, теперь работает. Очень удобно пользоваться.