Perpendicular angle

Thoughts, comments, suggestions?

;Finds perpendicular angle from
;a point to selected line/segment
;Ken A. 7/20/04.
;in_pnt= anypoint
;s_pnt= end point of segment
(defun find_perp_ang (ent in_pnt s_pnt / vlaobj cls_pnt seg_ang in_ang
f_ang l1 perp_pnt perp_ang)
(vl-load-com)
(setq vlaobj (vlax-ename->vla-object (car ent))
cls_pnt (vlax-curve-getClosestPointTo vlaobj (cadr ent))
seg_ang (angle cls_pnt s_pnt)
in_ang (angle in_pnt s_pnt)
f_ang (abs (- seg_ang in_ang))
l1 (* (cos f_ang) (distance in_pnt s_pnt))
perp_pnt (polar s_pnt (- seg_ang pi) l1)
perp_ang (angle in_pnt perp_pnt))
)

--
Ken Alexander
Acad2004
Windows XP

"We can't solve problems by using the same kind
of thinking we used when we created them."
--Albert Einstein

 

Hmm. Would there ever be a condition when 'cls_pnt' returns nil ?

Bob

 

I think this will cover that and more:

;Finds perpendicular angle from
;a point to selected line/segment
;Ken A. 7/20/04.
;in_pnt= anypoint
;s_pnt= end point of segment
;returns nil or angle.
(defun find_perp_ang (ent in_pnt s_pnt / vlaobj cls_pnt seg_ang
in_ang f_ang l1 perp_pnt perp_ang)
(vl-load-com)
(and
ent
(vl-consp in_pnt)
(vl-consp s_pnt)
(>= 3 (vl-list-length in_pnt) 2)
(>= 3 (vl-list-length s_pnt) 2)
(vl-every 'numberp in_pnt)
(vl-every 'numberp s_pnt)
(not (vl-catch-all-error-p
(setq vlaobj (vl-catch-all-apply
'vlax-ename->vla-object
(list (car ent))))))
(not (vl-catch-all-error-p (setq cls_pnt (vl-catch-all-apply
'vlax-curve-getclosestpointto
(list vlaobj (cadr ent))))))
(setq seg_ang (angle cls_pnt s_pnt)
in_ang (angle in_pnt s_pnt)
f_ang (abs (- seg_ang in_ang))
l1 (* (cos f_ang) (distance in_pnt s_pnt))
perp_pnt (polar s_pnt (- seg_ang pi) l1)
perp_ang (angle in_pnt perp_pnt)
)
)
perp_ang
)
--
Ken Alexander
Acad2004
Windows XP

"We can't solve problems by using the same kind
of thinking we used when we created them."
--Albert Einstein

 

Hi Ken,

A suggestion: (trans (cadr ent) 1 0) since entsel returns a UCS point, while the
vlax-curve functions expect and return WCS. Notice, John's SegmentPts function does
this.

Regards
Joe Burke

 

Thanks Joe. I'll make that change. I haven't studied John's
function yet.
I know....I didn't even have to clean the fish....I just ate it. <g>

--
Ken Alexander
Acad2004
Windows XP

"We can't solve problems by using the same kind
of thinking we used when we created them."
--Albert Einstein