Find vertex tangent curves in polyline

[libarraSCXGZ]

Hello everyone,

With my basic knowledge of Lisp and a lot of searching in forums, I have managed to extract the vertices of a polyline with curves - start of curve, end of curve, etc. I have exported this to a CSV, but I am struggling to extract the projected vertex of the intersection of the tangents that form the curve.

I have tried using the "Inters" function but I am not able to make it work. Here's an image of what I have achieved and what I desire to achieve.

I would appreciate any guidance on this matter. Sorry for my English, it's not my strong suit.

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

(defun c:vtc (/ ent obj coords i ptActual numVerts tipoEnt)
(vl-load-com)

; Seleccionar polilínea
(setq ent (car (entsel "\nSelecciona una polilínea: ")))
(if (not ent) (exit))

; Obtener objeto VLA de la entidad
(setq obj (vlax-ename->vla-object ent))
(setq tipoEnt (vlax-get-property obj 'ObjectName))

; Verificar si es una polilínea
(if (not (member tipoEnt '("AcDb2dPolyline" "AcDbPolyline")))
(progn
(princ "\nLa entidad seleccionada no es una polilínea.")
(exit)
)
)

; Obtener coordenadas de la polilínea
(setq coords (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'Coordinates))))
(setq numVerts (/ (length coords) 2)) ; Cada vértice tiene dos coordenadas (x, y)

; Etiquetar cada vértice
(setq i 0)
(while (< i numVerts)
(setq ptActual (list (nth (* 2 i) coords) (nth (1+ (* 2 i)) coords)))
(etiquetarPunto ptActual i)
(setq i (1+ i))
)
(princ)
)

(defun etiquetarPunto (punto index / alturaTexto)
(setq alturaTexto 2.5)
(command "_POINT" punto)
(command "_TEXT" punto alturaTexto 0 (strcat "V-" (itoa index)))
)

(princ)

[Kent1Cooper · Accepted solution]

First question:  Can you ensure that all arc segments in a Polyline will always be between line segments that meet them tangentially at both ends?  Never like [for example] these, with either non-tangent adjacent segment(s) or two adjacent arc segments [whether tangent or not]?

[libarraSCXGZ]

 HI @Kent1Cooper Kent1Cooper
segments are always tangent to curves and arcs, not ellipses, not arcs or compound curves.
This is for a plant alignment of hydraulic channels

[Kent1Cooper]

And would they always start and end with line segments, that is, never start or end with an arc segment?  If so, I 

think (inters) could be usable, but otherwise calculations would need to be made using vertex locations and bulge factors.

Either way, one thing the Coordinates that are obtained in your code do not contain is any indication of which segments are arcs, which is crucial.  So a different way of pulling information is needed.  That will involve the entity data list rather than VLA properties, so the VLA conversion probably will not be needed.  But the approach I am imagining will be able to handle only LWPolylines, not "heavy" 2D Polylines.

And that all arc segments will swing through an included angle of less than 180°?

And [I keep thinking of more questions] would a Polyline ever be closed?  If so, would the start/end location ever be at either end of an arc segment?

[libarraSCXGZ]

@Kent1Cooper 

-They will always be the beginning of a line segment and the end of a line segment, line-arc-line
-There will always be open polylines
-will never start in an arc or end in an arc
-LWPolylines only
-the arcs will always be less than 180°

[komondormrex]

hey there,

you need to use first derivative at each arc segment vertex to find their intersection, which would be your to find projected vertex.

[ronjonp · Accepted solution]

@libarraSCXGZ Here's a 'hack' .. variable P3 will hold the value you're looking for:

(defun c:foo (/ p p2 p3 s)
  ;; RJP » 2024-03-27
  (defun _aap (e pt / e p)
    (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
	     (setq p (vlax-curve-getparamatpoint e pt))
	)
      (angle '(0 0 0) (vlax-curve-getfirstderiv e p))
    )
  )
  (cond	((setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (foreach o (vlax-invoke (vlax-ename->vla-object e) 'explode)
	     (cond ((= "AcDbArc" (vla-get-objectname o))
		    (setq p3 (inters (setq p (vlax-curve-getstartpoint o))
				     (polar p (_aap o p) 1)
				     (setq p2 (vlax-curve-getendpoint o))
				     (polar p2 (_aap o p2) 1)
				     nil
			     )
		    )
		    (grdraw p p3 3)
		    (grdraw p2 p3 3)
		   )
	     )
	     (vla-delete o)
	   )
	 )
	)
  )
  (princ)
)

[libarraSCXGZ]

Hi @ronjonp 
Thank you very much for your creative solution, I am going to study it and try to implement it in my lisp routine.
This is great

[CADaSchtroumpf · Accepted solution]

Another routine

(vl-load-com)
(defun c:Make_Tangent ( / js n ename obj pr dist_start dist_end pt_start pt_end seg_len seg_bulge rad ang_vtx pt_cen pt_vtx)
  (princ "\nSelect polylines.")
  (while
    (null
      (setq js
        (ssget
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (repeat (setq n (sslength js))
    (setq
      ename (ssname js (setq n (1- n)))
      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))
        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)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
          )
          (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt_start) (cons 11 pt_vtx)))
          (entmake (list '(0 . "LINE") '(62 . 1) (cons 10 pt_vtx) (cons 11 pt_end)))
        )
      )
      
    )
  )
  (prin1)
)

[john.uhden]

@libarraSCXGZ ,

Off the top of my head (which still has hair, but what's on the inside of the skull may be deteriorating), maybe you want to try...

1.  Make a copy of the polyline (so you can leave the original alone)

2.  Fillet copy ("Polyline") with radius=0

3.  Get the coordinates of the copy at each vertex

4.  Delete the copy.

All of which is easily programmable.

[libarraSCXGZ]

thank you @john.uhden  was one of the ideas I had, my knowledge was still very basic, but I was obsessed with "interest" and I found @ronjonp   's idea great

[libarraSCXGZ]

thank you very much @CADaSchtroumpf  it works perfect too, I was precisely working to make the tangent polylines..
I'm sure this will help many newbies like me to Lisp.
Thank you again

[komondormrex · Accepted solution]

for truly filleted segments in polyline

;****************************************************************************************************************************

(defun vectors_angle (vector_1 vector_2 / x1 y1 z1 x2 y2 z2 cos_a sin_a alpha)
  	(mapcar 'set '(x1 y1 z1) vector_1)
  	(mapcar 'set '(x2 y2 z2) vector_2)
	(setq cos_a (/ (+ (* x1 x2) (* y1 y2) (* z1 z2))
				   (* (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x1 y1 z1))))
					  (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x2 y2 z2))))
				   )
				)
		  sin_a (sqrt (- 1 (expt cos_a 2)))
	)
	(cond ((zerop cos_a) (* 0.5 pi)) ((zerop (setq alpha (atan (/ sin_a cos_a)))) pi) ((minusp alpha) (+ pi alpha)) (t alpha))
)

;****************************************************************************************************************************

(defun c:find_tintersects (/ pline index bulge)
	(setq pline (vlax-ename->vla-object (car (entsel "\nPick target pline: "))) index 0)
	(repeat (1- (fix (vlax-curve-getendparam pline)))
		(if (and (not (zerop (setq bulge (vla-getbulge pline index)))) (not (zerop index)))
			(if (equal (vectors_angle (vlax-curve-getfirstderiv pline index) (vlax-curve-getfirstderiv pline (1+ index)))
					   (* 4 (atan (abs bulge)))
					   1e-6
				)
					(vla-addpoint (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
								  (vlax-3d-point (inters (vlax-curve-getpointatparam pline index)
										  				 (polar (vlax-curve-getpointatparam pline index) (angle '(0 0) (vlax-curve-getfirstderiv pline index)) 1)
										  				 (vlax-curve-getpointatparam pline (1+ index))
										  				 (polar (vlax-curve-getpointatparam pline (1+ index)) (angle '(0 0) (vlax-curve-getfirstderiv pline (1+ index))) 1)
										  				 nil
								  				 )
								  )
					)
			)
		)
		(setq index (1+ index))
	)
	(princ)
)

;****************************************************************************************************************************

[libarraSCXGZ]

hi @komondormrex 
Thank you very much for your response, with all these versions I am advancing and learning a lot.
Thanks for your time.

[calderg1000]

Regards @libarraSCXGZ 

Try this code. Previously configure the point properties.

;;;___
(defun c:Lwpn (/ i x n pr0 d0 p0 n pr1 d1 p1 pr2 d2 p2 v1 v2 p1x p2x pinx j k)
  (princ "Select Lwpolylines...")
  (setq
    lsn (vl-remove-if 'listp
                      (mapcar 'cadr (ssnamex (ssget '((0 . "lwpolyline")))))
        )
  )
  (foreach x lsn
    (setq i 0
          k 0
          n (cdr (assoc 90 (entget x)))
    )
    (while (< i (- n 2))
      (setq pr0 i
            d0  (vlax-curve-getdistatparam x pr0)
            p0  (vlax-curve-getpointatparam x pr0)
            pr1 (+ i 1)
            d1  (vlax-curve-getdistatparam x pr1)
            p1  (vlax-curve-getpointatparam x pr1)
            pr2 (+ i 2)
            d2  (vlax-curve-getdistatparam x pr2)
            p2  (vlax-curve-getpointatparam x pr2)
      )
      (if (not (equal (- d2 d1) (distance p2 p1) 0.001))
        (progn
          (setq v1   (vlax-curve-getfirstderiv (vlax-ename->vla-object x) pr1)
                v2   (vlax-curve-getfirstderiv (vlax-ename->vla-object x) pr2)
                p1x  (mapcar '+ p1 (mapcar '(lambda (j) (* 1 j)) v1))
                p2x  (mapcar '+ p2 (mapcar '(lambda (k) (* 1 k)) v2))
                pinx (inters p1 p1x p2 p2x nil)
          )
          (entmakex (list '(0 . "point")
                          (cons 10 pinx)
                    )
          )
          (entmakex (list '(0 . "text")
                          (cons 1 (strcat "P-" (itoa (setq k (1+ K)))))
                          (cons 10 pinx)
                          (cons 40 2.0)
                    )
          )
          (entmakex (append (list '(0 . "lwpolyline")
                                  (cons 100 "AcDbEntity")
                                  (cons 100 "AcDbPolyline")
                                  (cons 62 8)
                                  (cons 90 n)
                            )
                            (mapcar '(lambda (m) (cons 10 m)) (list p1 pinx p2))
                    )
          )
        )
      )
      (setq i (+ i 1))
    )
  )
)

[Kent1Cooper]

---

@Kent1Cooper wrote:

.... I think (inters) could be usable, ....   one thing the Coordinates that are obtained in your code do not contain is any indication of which segments are arcs, which is crucial.  So a different way of pulling information is needed.  That will involve the entity data list rather than VLA properties.... 

.... the approach I am imagining ....

---

.... eventually worked out to this adjustment of your original code.  It does manage to get (inters) to work [as you said you hadn't been able to do in Message 1], to find the virtual intersections.  It keeps your command name, and a lot of your sub-routines, variables and so on.  I commented out some original lines that were not applicable to its different approach, sometimes with comments about why -- sorry about the mix of languages.

Very lightly tested, but it seems to work, though on "lightweight" Polylines only [but see the comments about why yours would also not work with "heavy" ones].

[libarraSCXGZ]

Thank you @calderg1000  for your help and time