Find vertex tangent curves in polyline

Find vertex tangent curves in polyline

libarraSCXGZ
Contributor Contributor
1,944 Views
16 Replies
Message 1 of 17

Find vertex tangent curves in polyline

libarraSCXGZ
Contributor
Contributor

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)

 
 
 
 
 
0 Likes
Accepted solutions (4)
1,945 Views
16 Replies
Replies (16)
Message 2 of 17

Kent1Cooper
Consultant
Consultant
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]?

Kent1Cooper_0-1711559731859.png

 

Kent Cooper, AIA
0 Likes
Message 3 of 17

libarraSCXGZ
Contributor
Contributor

 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

 

0 Likes
Message 4 of 17

Kent1Cooper
Consultant
Consultant

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?

Kent Cooper, AIA
0 Likes
Message 5 of 17

libarraSCXGZ
Contributor
Contributor

@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°

0 Likes
Message 6 of 17

komondormrex
Mentor
Mentor

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.

0 Likes
Message 7 of 17

ronjonp
Advisor
Advisor
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)
)

 

2024-03-27_16-50-15.gif

 

Message 8 of 17

libarraSCXGZ
Contributor
Contributor

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

0 Likes
Message 9 of 17

CADaSchtroumpf
Advisor
Advisor
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)
)
Message 10 of 17

john.uhden
Mentor
Mentor

@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.

John F. Uhden

Message 11 of 17

libarraSCXGZ
Contributor
Contributor

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

0 Likes
Message 12 of 17

libarraSCXGZ
Contributor
Contributor

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

0 Likes
Message 13 of 17

komondormrex
Mentor
Mentor
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)
)

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

 

Message 14 of 17

libarraSCXGZ
Contributor
Contributor

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

0 Likes
Message 15 of 17

calderg1000
Mentor
Mentor

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))
    )
  )
)

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Message 16 of 17

Kent1Cooper
Consultant
Consultant

@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].

Kent Cooper, AIA
0 Likes
Message 17 of 17

libarraSCXGZ
Contributor
Contributor

Thank you @calderg1000  for your help and time