Get point on another polyline perpendicular from a point on a polyline

[gsc]

Hi,

 

From a given point on a given (black line) polyline, I want to get the point on another polyline (red) perpendicular (magenta lines) from the polyline (black).

 

For most part of the red polyline, the getclosestpointto function will return the correct point:

 (setq ins_pt2 (vlax-curve-getclosestpointto poly1 ins_pt1)) 

 

But not where the red polyline changes its direction, then the blue line is the closest point, which is not what i want

In my main function I have already selected both polylines and calculated the point on the first polyline, so i only need a subfunction to calculate the point on the second polyline

any ideas how to solve this?


 

[mhupp]

Could you upload a drawing with those lines.

 

[gsc]

43 minutes ago, mhupp said:

Could you upload a drawing with those lines.

 

 

Here you go.
The idea is that the black route is a route where a Cable has to be buried by a trencher
The red route is the route that the Barge (which deploys the Trencher on top of the Cable) follows after the trencher is deployed
The point on the red route is where a dynamic block of the barge is inserted, but the KP of this barge is perpendicular/relative to the KP of the trencher at the Cable route

 

 

Test.dwg

Edited October 14, 2022 by gsc

[Tsuky]

This?

(defun c:raise_perp ( / js ent-sel ent pt_sel obj_curv old_osmd old_snp old_orth param deriv pt_tmp p_from p_to)
	(vl-load-com)
	(princ "\nRaise perpendicular to?: ")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY"))))))
	(setq
		ent-sel (ssnamex js 0)
		ent (cadar ent-sel)
		pt_sel (cadar (cdddar ent-sel))
		obj_curv (vlax-ename->vla-object ent)
	)
	(cond
		((member
			(vlax-get-property obj_curv 'ObjectName)
			'("AcDbPolyline" "AcDb2dPolyline" "AcDbLine" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbSpline" "AcDbRay" "AcDbXline")
		 )
			(setq
				old_osmd (getvar "osmode")
				old_snp (getvar "snapang")
				old_orth (getvar "orthomode")
				pt_sel (vlax-curve-getClosestPointTo obj_curv pt_sel)
				param (vlax-curve-getparamatpoint obj_curv pt_sel)
				deriv (vlax-curve-getfirstderiv obj_curv param)
			)
			(setq pt_tmp (polar pt_sel (+ (atan (cadr deriv) (car deriv)) (/ pi 2)) 100.0))
			(setvar "snapang" (angle (trans pt_sel 0 1) (trans pt_tmp 0 1)))
			(setvar "orthomode" 1)
			(if (null (setq p_from (getpoint "\nPoint ? <last> ")))
				(setq p_from (trans pt_sel 0 1))
			)
			(setvar "osmode" 0)
			(initget 9)
			(setq p_to (getpoint p_from "\nUp to point ?: "))
			(command "_.line" p_from p_to "")
			(setvar "osmode" old_osmd)
			(setvar "orthomode" old_orth)
			(setvar "snapang" old_snp)
		)
		(T (princ "\nInvalid object!"))
	)
	(prin1)
)

 

[marko_ribar]

@Tsuky

No, that's not it...

Look into (vlax-curve-getclosestpointtoprojection) function and study it...

[mhupp]

Went a different way. works well but could be errors in the future like if the red line comes back on itself their could be two or more points generated.

Also the draw order affects how this works. if the white polyline isn't "above" or top draw order over the blocks it wont work. because nentselp will pick the block instead of the polyline.

 

--EDIT

to exit command either right click when asking for point or hit Esc

 

;;----------------------------------------------------------------------------;;
;; Extend Perpendicular From a Point on a Polyline
(defun C:foo ( / to pt ent polypt seg pt1 pt2 ang pt3 line pt4)
  (setq to (vlax-ename->vla-object (car (entsel "\nExtend to: "))))
  (while (setq pt (getpoint "\nSelect Point: ")) ;pick point on block/polyline
    (if (and (setq ent (car (nentselp pt))) (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")) ;used to select polyline from point draworder matters will pick the top entity
      (progn
        (setq polypt (vlax-Curve-GetClosestPointTo ent pt)) ;makes sure point is on polyline
        (setq seg (fix (vlax-curve-getParamAtPoint ent polypt))) ;find the segment of polyline
        (setq pt1 (vlax-Curve-GetPointAtParam ent seg))
        (setq pt2 (vlax-Curve-GetPointAtParam ent (1+ seg)))
        (setq ang (+ (/ pi 2) (angle pt1 pt2))) ;use the two vertices of polyline to calculate angle of segment and add 90 deg
        (setq pt3 (polar pt ang 1)) ;calculate 3rd point
        (setq line (vlax-ename->vla-object (entmakex (list (cons 0 "LINE")(cons 10 polypt)(cons 11 pt3))))) ;use new point to make temp line
        (if (setq pt4 (vlax-invoke line 'intersectwith to acextendthisentity)) ;find intersection of temp line extining to 2nd polyline
          (entmakex (list (cons 0 "LINE")(cons 10 polypt)(cons 11 pt4))) ;if point is found draw new line
        )
        (vla-delete line)  ;delete temp line
      )
      (prompt "\nNot a Polyline")
    )
  )
  (princ)
)

 

 

Edited October 14, 2022 by mhupp

[gsc]

On 10/14/2022 at 5:43 PM, marko_ribar said:

@Tsuky

No, that's not it...

Look into (vlax-curve-getclosestpointtoprojection) function and study it...

I will try to figure this out first, thanx!

[marko_ribar]

1 hour ago, gsc said:

I will try to figure this out first, thanx!

 

Its absolutely good to discover functionality LISP can offer, still maybe I overlooked situation task was formulated... I've coded something similar recently and strongly suggest you to look at it - it's very similar to what you need...

https://www.cadtutor.net/forum/topic/76178-extend-line-inside-closed-polygon/?do=findComment&comment=602124

 

HTH., M.R.

[gsc]

On 10/17/2022 at 5:52 PM, marko_ribar said:

 

Its absolutely good to discover functionality LISP can offer, still maybe I overlooked situation task was formulated... I've coded something similar recently and strongly suggest you to look at it - it's very similar to what you need...

https://www.cadtutor.net/forum/topic/76178-extend-line-inside-closed-polygon/?do=findComment&comment=602124

 

HTH., M.R.

I have studied it can't figure out what goes wrong here with the vlax-curve-getclosestpointtoprojection function.

 

((/= ss2 nil)
	(progn
		(setq intval (getreal "\nSpecify Barge Start Position by distance from Pipe or Cable Route at KP 0.0 (m): "))
		(while (> intval pl_leng )
			(progn
				(setq intval (getreal "\nStart Position outside KP range, Specify Start Position by distance from Pipe or Cable Route at KP 0.0 (m) again: "))
			)
		)
		(setq ins_pt1 (vlax-curve-getPointAtDist pl_route intval))
		(setq param1 (vlax-curve-getParamAtPoint pl_route ins_pt1))
		(setq deriv1 (vlax-curve-getFirstDeriv pl_route param1))
		
		;(setq ang (- (angle '(0 0) deriv1) (* pi (/ 90 180.0)))) ; Variable just for testing
		(setq ang (+ (angle '(0 0) deriv1) (* pi (/ 90 180.0)))) ; Variable just for testing
		(setq normal (polar ins_pt1 ang 10)) ; Variable ust for testing
											
		(setq ins_pt2 (vlax-curve-getclosestpointto sail_route ins_pt1))
		(setq ins_pt3 (vlax-curve-getClosestPointToProjection sail_route ins_pt1 normal [extend])) ; Variable just for testing
		
		(setq sto_dist (rtos (distance ins_pt1 ins_pt2) 2 0))									
		(setq ins_ang2 (atof (angtos (- (angle '(0 0) deriv1) (* pi (/ 90 180.0))) 0 2)))
		(alert (strcat "Selected Point is " sto_dist "m Stand-off from Pipeline or Cable Route at KP " (rtos (/ intval 1000) 2 3)))
	)
)

The function is: (vlax-curve-getClosestPointToProjection curve-obj givenPnt normal [extend]) 

I have added a snippet of my code (see "Variable just for testing") and want to calculate ins_pt3

curve-obj = sail_route (red dashed line)
givenPnt = ins_pt1
normal = normal

 

Resulting location on sail_route is ins_pt3

The normal result is a coordinate extended 10 units from ins_pt1 with direction ang (for the function it doesn't matter on which side of the polyline the normal is calculated)
You can see in the picture that the ins_pt3 result is not an extension between the ins_pt1 and normal points

Note: the selected polylines may be curved or not, this case it is a non-curved object

What Am I doing wrong here?
 

Dynamic Example - Sailing Route_test.dwg

Edited November 1, 2022 by gsc

[Tsuky]

To get your point ins_pt3 try this

((lambda ( / js sail_route pl_route ins_pt1 param1 deriv1 alpha ins_pt3)
	(princ "\nSelect sail_route")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(setq sail_route (ssname js 0))
	(princ "\nSelect pl_route")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(setq pl_route (ssname js 0))
	(initget 1)
	(setq
		ins_pt1 (getpoint "\nGive point on pl_route")
		param1 (vlax-curve-getParamAtPoint pl_route ins_pt1)
		deriv1 (vlax-curve-getFirstDeriv pl_route param1)
		alpha (+ (atan (cadr deriv1) (car deriv1)) (* 0.5 pi))
		ins_pt3
		(vlax-invoke
			(vlax-ename->vla-object sail_route)
			"intersectwith"
			(vlax-ename->vla-object (entmakex (list '(0 . "LINE") (cons 10 ins_pt1) (cons 11 (polar ins_pt1 alpha 10.0)))))
			acExtendOtherEntity
		)
	)
	(entdel (entlast))
	ins_pt3
))

 

[gsc]

9 hours ago, Tsuky said:

To get your point ins_pt3 try this

((lambda ( / js sail_route pl_route ins_pt1 param1 deriv1 alpha ins_pt3)
	(princ "\nSelect sail_route")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(setq sail_route (ssname js 0))
	(princ "\nSelect pl_route")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(setq pl_route (ssname js 0))
	(initget 1)
	(setq
		ins_pt1 (getpoint "\nGive point on pl_route")
		param1 (vlax-curve-getParamAtPoint pl_route ins_pt1)
		deriv1 (vlax-curve-getFirstDeriv pl_route param1)
		alpha (+ (atan (cadr deriv1) (car deriv1)) (* 0.5 pi))
		ins_pt3
		(vlax-invoke
			(vlax-ename->vla-object sail_route)
			"intersectwith"
			(vlax-ename->vla-object (entmakex (list '(0 . "LINE") (cons 10 ins_pt1) (cons 11 (polar ins_pt1 alpha 10.0)))))
			acExtendOtherEntity
		)
	)
	(entdel (entlast))
	ins_pt3
))

 

Thanx, this is working perfectly!