[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

[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, буду знать, теперь работает. Очень удобно пользоваться.