Create a Polyline tangent to a Curve

June 24, 2023

Please help write a LISP program to create a Polyline 2 tangent to a given Polyline 1 (curve) under the following conditions:

- Select the given Polyline 1 on the drawing.

- Enter the length L (in the example 120).

- Enter the length of the segments A (in the example is 20).

- Pick and select the Starting point to draw. At this point, the program adjusts forward or backward a distance < A, so that the curve's beginning matches the middle point of a line segment on Polyline 2.

Result: As shown in the attached picture.

Sincerely thank you!

Tangent.dwg

June 25, 2023

On the right side you have a kink without an arc. Is that correct ?

If you look at the formula for an arc & chord you can work out the tangent points, given a R radius. You have a 10-10 IP calc.

Pythagoras and a/sin a=b/sin b=c/sin c so can work out angle by rearranging the sine formula, as one angle is 90 degrees, but hypotenuse has to be calculated.

Edited June 25, 2023 by BIGAL

June 25, 2023

Hello BIGAL.

On the right side you have a kink without an ARC?

Right! Because Polyline 1 is a curve (CURVE) consisting of straight lines and arcs. From any point on it, I want to draw a Polyline 2 line of given length L, consisting of segments of Length A. Depending on length L but at the right point as you said, polyline 2 will not tangent the curve. On Polyline 1, outside of the curve range, Polyline 2 are segments that coincide with the line segment of Polyline 1.

If you need more information I will be more than happy to provide it.

Thank you! (sorry for my English not good).

June 25, 2023

@Huuthanh As I understand, the task to do is to draw a partial POLYGON, 20 units sides and 120 units length , following the original Polyline1 path.

June 26, 2023

I want to use LISP to determine the above polyline 2 is in tangent with polyline 1 to arrange concrete retaining walls for roads. It is necessary to determine the tangent at the curvilinear positions to always have enough width of the road surface! (see illustration)

Tangent.dwg

June 27, 2023

Ok understand makes lots of sense think about motor racing where this is done for street circuits.

July 2, 2023

Try this hopeful can follow prompts expects a Line Arc Line, NOT PLINE. Very much a 1st attempt, limited testing.

Code removed for update

Edited July 3, 2023 by BIGAL

July 2, 2023

BIGAL

Thank you very much. This is very meaningful. I will check and report back to you. Once again thank you very much!

July 2, 2023

One start with this, will that be enough?

(vl-load-com)
(defun c:Retain_Wall ( / js AcDoc Space dlt ename obj pr dist_start dist_end pt_start pt_end alpha seg_len seg_bulge rad ang_vtx pt_cen pt_vtx pt_lst inc_ang tmp ang dir nw_cir l_int nw_pl)
  (princ "\nSelect the polyline.")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (initget 7)
  (setq
    dlt (* 0.5 (getdist "\nLength of segment?: "))
    ename (ssname js 0)
    obj (vlax-ename->vla-object ename)
    pr -1
  )
  (repeat (fix (vlax-curve-getEndParam ename))
    (setq
      dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
      dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
      pt_start (vlax-curve-GetPointAtParam ename pr)
      pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
      alpha (angle pt_start pt_end)
      seg_len (- dist_end dist_start)
      seg_bulge (vla-GetBulge obj pr)
    )
    (if (not (zerop seg_bulge))
      (progn
        (setq
          rad (/ seg_len (* 4.0 (atan seg_bulge)))
          ang_vtx (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
          pt_cen (polar pt_start ang_vtx rad)
          pt_vtx (polar pt_start (- ang_vtx (* pi 0.5)) dlt)
          pt_lst (cons pt_vtx (cons (polar pt_start (+ ang_vtx (* pi 0.5)) dlt) pt_lst))
          inc_ang
          (if (< rad 0)
            (- (angle pt_cen pt_start) (angle pt_cen pt_vtx))
            (+ (angle pt_cen pt_start) (angle pt_cen pt_vtx))
          )
        )
        (repeat (fix (/ (abs (* 4.0 (atan seg_bulge))) (* 2 inc_ang)))
          (setq
            ang
            (if (< rad 0)
              (- (angle pt_cen pt_vtx) inc_ang)
              (+ (angle pt_cen pt_vtx) inc_ang)
            )
            tmp (polar pt_cen ang (abs rad))
            dir (angle pt_vtx tmp)
          )
          (set 'pt_vtx tmp)
          (setq
            pt_vtx (polar pt_vtx dir dlt)
            pt_lst (cons pt_vtx pt_lst)
          )
        )
        (setq
          nw_cir (vlax-invoke Space 'AddCircle pt_vtx 20.0)
          l_int
          (vlax-invoke
            nw_cir
            'IntersectWith
            obj
            acExtendThisEntity
          )
        )
        (entdel (entlast))
        (setq nw_pl
          (vlax-invoke Space 'AddLightWeightPolyline
            (apply 'append
              (reverse
                (cons
                  (list (car (cdddr l_int)) (cadr (cdddr l_int)))
                  (mapcar
                    '(lambda (x) (list (car x) (cadr x)))
                    pt_lst
                  )
                )
              )
            )
          )
        )
        (vlax-Put nw_pl 'Color 1)
        (vlax-Put nw_pl 'ConstantWidth 0.4)
      )
    )
  )
  (prin1)
)

July 2, 2023

I tested the program:

The program does not draw the end line segment (the endpoint of the tangent line to the intersection of the circle and the line). I'm not sure it's probably because of this command line:

(setq obj1 (vlax-ename->vla-object (car ent2)))

...

(setq intpt (vlax-invoke objc 'intersectWith obj1 acExtendnone))

I think obj1 should be obj2.

And one more thing: If the program works with PLINE then great. Thanks

July 3, 2023

Nice tsuky did as line arc just to get a starting method around arc.

Tested again and doing something wierd was working perfect. Code removed whilst I test more.

Edited July 3, 2023 by BIGAL

July 3, 2023

Tsuki

Thank you for your time and intellectual support. Your program runs very well and it will greatly assist in the design of retaining walls.

Please adjust so that the program allows you to choose the Start point to draw the retaining wall and the Retaining ưall will start drawing from the starting point.

The program will calibrate the Start point within the length of one segment so that the point of contact with the curve of the next segment is in the middle of the segment.

July 3, 2023

I tried to answer your request.
This seems correct to me, but I admit that there may be bad resolutions in some cases.
Your request turns out to be complicated, I noticed that your request only concerned the case of a convex curve.
I thought this was insufficient so I included the concave curve case.
I don't think I will go further in development without remuneration...
So you will have to settle for this last proposition.
You have the source code, if you want to try to improve.
Good luck!

Retain_Wall.lsp

July 4, 2023

Tsuki! Thank you very much. From your source code I will try to improve more. Once again thank you for your support! What else would I ask for your help?

July 5, 2023

Thanks to your help, I have basically managed to get a small program to determine the tangent polyline. However, there are still some things that need further improvement. Thank you for watching and contributing to improving more. Thank you!

(vl-load-com)
(defun c:tangent ( / 

	   acdoc ang_tt_p_sc			 bulge		circle_i   dist_p_e_0
	   dist_p_e_next		 di_p_e		e		   ent
	   l2		  len_next	 l_all		l_p		   p
	   para_p_int_e			 para_p_i_e	pa_p_e	   pa_p_ec
	   pa_p_next  pa_p_sc	 p_e		p_ec	   p_fix
	   p_i		  p_ints	 p_int_e	p_i_e	   p_next
	   p_sc		  space		 ss
	  )

  
  (princ "\nSelect the polyline.")
  (while
    (null (setq ss (ssget "_+.:E:S" '( (0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>")))))
		(princ "\nSelect is empty, or isn't POLYLINE!")
  );_while
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  ) 
	(vla-startundomark AcDoc)
	(initget 7)
	(setq
		ent (ssname ss 0)
		e (vlax-ename->vla-object ent)
	)
  	;;(setq l_all 100)
    (setq l_all (getdist "Total lenght L: "))
	;;(setq l 10)
    (setq l2 (getdist "Lenght section: "))
	;;(setq l2 (/ l 2))  
	(setq p (getpoint "Pick start Point:"))
	(setq l_p '())  
	(setq p_e (vlax-curve-getClosestPointTo e p))
	(setq dist_p_e_0 (vlax-curve-getdistatpoint e p_e))
  	(setq dist_p_e_next dist_p_e_0)
  
	(while (>= (+ l_all l2) (- dist_p_e_next dist_p_e_0))	  
		(setq pa_p_e (vlax-curve-getParamAtPoint e p_e))
		(setq di_p_e (vlax-curve-getDistAtPoint e p_e))
		(setq p_fix (fix pa_p_e))
	  
		;;(setq bulge (vla-GetBulge e p_fix))
		(setq bulge (vla-GetBulge e pa_p_e))
		(setq len_next (+ di_p_e l2 ))
	  	(setq p_next (vlax-curve-getpointatdist e len_next))
	  	(setq pa_p_next (vlax-curve-getParamAtPoint e p_next))
		
		(cond
			((= bulge 0)
			 	(setq l_p (append l_p (list p_e)))
			 	(cond ((< pa_p_next (1+ (fix pa_p_e)))
					   (setq p_e p_next)
					   (setq dist_p_e_next (vlax-curve-getdistatpoint e p_e));;
				))
			 	(cond ((>= pa_p_next (1+ (fix pa_p_e)))
					   (setq p_e (vlax-curve-getpointatparam e (1+ (fix pa_p_e))))
					   (setq dist_p_e_next (vlax-curve-getdistatpoint e p_e))
				))
			 );_bulge 0

			((/= bulge 0)

			 
				;;(setq p_sc (vlax-curve-GetPointAtParam e p_fix))
			 	(setq p_sc p_e)
				(setq p_ec (vlax-curve-GetPointAtParam e (+ 1 p_fix)))
				(setq pa_p_ec (vlax-curve-getparamatpoint e p_ec))
			 
			 
				(while (and (/= p_sc nil) (>= (+ l_all l2)(- dist_p_e_next dist_p_e_0)));_**
							 
					(setq l_p (append l_p (list p_sc)))
					(setq pa_p_sc (vlax-curve-getparamatpoint e p_sc))				  
				  
				  	(cond ((< pa_p_sc pa_p_ec)
						   
				                (setq ang_tt_p_sc (AT:AngleAtPoint e  p_sc))
				                (setq p_i 			(polar p_sc ang_tt_p_sc l2))  
				                (setq l_p 			(append l_p (list p_i)))
						   		;; 
								(setq p_i_e 			(vlax-curve-getClosestPointTo 	e 	p_i))
								(setq para_p_i_e        (vlax-curve-getParamAtPoint 	e	p_i_e))
						   
								(make_circle_2 p_i l2)
						   
							  	(setq circle_i (vlax-ename->vla-object (entlast)))
						   
							  	(if (setq p_ints (LM:intersections e circle_i acextendnone))
							        (foreach p_int p_ints
									  
									    (setq p_int_e      (vlax-curve-getClosestPointTo e p_int))
									  
										(setq para_p_int_e (vlax-curve-getParamAtPoint   e p_int_e))

									    ;; 
									  	(cond  (( >  para_p_int_e para_p_i_e)
												(setq p_sc p_int)
												(setq dist_p_e_next (vlax-curve-getdistatpoint e p_sc))
										))

									  
							        ) ;_foreach
	                    
							     );_if
	                			(vla-erase circle_i)						   
				  	)) ;_cond
				  
				  	;; 
				  	(cond ((>= pa_p_sc pa_p_ec)
						   (setq p_e p_sc)
						   (setq dist_p_e_next (vlax-curve-getdistatpoint e p_e))
						   (setq p_sc nil)
					))

				  
				) ;_while p_sc
			 
			);_/= bulge 0
			
		);_cond
	  
	);_while
	(cre-poly_2 l_p)
);_end defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun AT:AngleAtPoint (e p)
;; ALAN J. THOMPSON, 11.04.10
  (angle '(0. 0. 0.)
	 (vlax-curve-getFirstDeriv e (vlax-curve-getParamAtPoint e p))))



;; INTERSECTIONS  -  LEE MAC 
(defun LM:intersections (ob1 ob2 mod / lst rtn) 
  (if 
    (and (vlax-method-applicable-p ob1 'intersectwith) 
         (vlax-method-applicable-p ob2 'intersectwith)
         (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
    )
    (repeat (/ (length lst) 3) 
      (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
            lst (cdddr lst))))      
  (reverse rtn)
)


;; DRAW CIRCLE
(defun make_circle_2 (cen ra) 
  (entmake 
    (list (cons 0 "CIRCLE") 
          (cons 10 (trans cen 0 1))
          (cons 40 ra))))

;; DRAW POLYLINE BY ENTMAKE 
;; https://www.theswamp.org
(defun cre-poly_2 (lst-pt)
  (entmakex
	(apply
	  (function append)
	  (cons
		(list
		  '(0 . "LWPOLYLINE")
		  '(100 . "AcDbEntity")
		  '(67 . 0)
		  '(410 . "Model")

		  '(100 . "AcDbPolyline")
		  (cons 90 (length lst-pt))
		  '(70 . 0)
		)
		(mapcar
		  (function list)
		  (mapcar (function (lambda (a) (cons 10 a))) lst-pt))))))

Create a Polyline tangent to a Curve

Recommended Posts

Huuthanh

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

Tsuky

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

Huuthanh

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity