Topic: How to Make PI (Point of Intersection) on Pline Arc

[ymg]

Roy,

Old school for sure!!

A bulge of +/- 1 would be a 180 degree curves
which theoretically can happen.

I'll check listpolb but it should repeat the first point
at the end of the list.

Thanks for comments!
.
ymg

[ymg]

Roy,

Here I've modified "listpolb" so that it works with closed polyline.

For the case of bulges equals to +/- 1, I did not bother as in the
context of an alignment such a curve would be split in two curves.

Code - Auto/Visual Lisp: [Select]

1. (defun c:calcpi (/ bulge ptcp pct delta/2 ang chord radius tangent enpi pilst)
2.    
3.    (setq  en (car (entsel "Select Alignment: "))
4.          lst (listpolb en)
5.        pilst nil         
6.    )     
7.    (while (> (length lst) 1)
8.       (if (not (zerop (setq bulge (cadar lst))))
9.          (setq     ptc (caar lst)
10.                    pct (caadr lst)
11.                delta/2 (* (atan bulge) 2.0)
12.                    ang (- (angle ptc pct) delta/2)     
13.                  chord (distance ptc pct)
14.                 radius (/ chord (* 2 (sin delta/2)))
15.                tangent (* radius (tan delta/2))
16.                  pilst (cons (polar ptc ang tangent) pilst)
17.                   enpi (entmakex (list (cons 0 "POINT") (cons 10 (car pilst))))
18.          )
19.       )
20.       (setq lst (cdr lst))
21.    )
22.    (print pilst)
23.    (princ)
24. )
25.  
26. ;; tan   From std-lib                                                         ;
27. (defun tan (z / cosz)
28.   (cond ((zerop (rem z pi)) 0.0)       
29.         ((zerop (rem z (/ pi 2))) 1.7e308)
30.         ((zerop (setq cosz (cos z))) 1.7e308)  
31.         (t (/ (sin z) cosz))))
32.  
33.  
34. ;;                                                                            ;
35. ;; listpolb     by ymg                                                        ;
36. ;;                                                                            ;
37. ;; Parameter:  en,  Entity Name  or Object Name                               ;
38. ;;                                                                            ;
39. ;; Returns:   List of Points and Bulge in WCS                                 ;
40. ;;                                                                            ;
41. ;; Notes:      On Closed Polyline the Last Vertex is Same as First)           ;
42. ;;                                                                            ;
43.  
44. (defun listpolb (en / obj i p l)
45.    (if (= (type en) 'ENAME)
46.       (setq obj (vlax-ename->vla-object en))
47.       (setq obj en en (vlax-vla-object->ename en))
48.    )         
49.    (repeat (setq i (fix (vlax-curve-getEndParam en)))        
50.       (setq l (cons (list (vlax-curve-getPointAtParam en (setq i (1- i)))
51.                              (vla-getbulge obj i)
52.                     )
53.                     l
54.               )    
55.       )
56.    )
57.    (if (= (vla-get-closed obj) :vlax-true)
58.       (append l (list (car l)))
59.       l
60.    )
61. )
62.  

[roy_043]

FWIW: Here is a function inspired by this topic.

Code - Auto/Visual Lisp: [Select]

1. ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline".
2. ; Return value: Point in WCS.
3. ; (mapcar '- (_Geom_PolylineArcTangentialInters (vlax-ename->vla-object (car (entsel))) 0) (getpoint "\nPoint: "))
4. (defun _Geom_PolylineArcTangentialInters (obj idx / ang bulge ptSta ptEnd)
5.   (if
6.     (and
7.       (< idx (vlax-curve-getendparam obj))
8.       (not (equal 0.0 (setq bulge (vla-getbulge obj idx)) (_Math_FuzzDefault)))
9.       (not (equal 1.0 (abs bulge) (_Math_FuzzDefault)))
10.     )
11.     (progn
12.       (setq ptSta (vlax-get obj 'coordinate idx))
13.       (setq ptEnd (vlax-get obj 'coordinate (1+ idx)))
14.       (trans
15.         (append
16.           (_Geom_XYof
17.             (polar
18.               ptSta
19.               (- (angle ptSta ptEnd) (setq ang (* 2.0 (atan bulge))))
20.               (/ (distance ptSta ptEnd) 2.0 (cos ang))
21.             )
22.           )
23.           (list (vla-get-elevation obj))
24.         )
25.         (vlax-get obj 'normal)
26.         0
27.       )
28.     )
29.   )
30. )
31.  
32. (defun _Geom_XYof (pt)
33.   (list
34.     (_Geom_Xof pt)
35.     (_Geom_Yof pt)
36.   )
37. )
38.  
39. (defun _Geom_Xof (pt)
40.   (if (car pt)
41.     (float (car pt))
42.     0.0
43.   )
44. )
45.  
46. (defun _Geom_Yof (pt)
47.   (if (cadr pt)
48.     (float (cadr pt))
49.     0.0
50.   )
51. )
52.  
53. (defun _Math_FuzzDefault ()
54.   0.00000001
55. )

[tombu]

Nice!

Thanks! 


Although it may not be what the OP wanted 

Turned out it was!

I modified it to work with preselected objects as well including arcs & lwpolylines.  I use right-click menus for modifying so I needed the preselected option.

Code - Auto/Visual Lisp: [Select]

1. ; by ronjonp
2. ; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
3. ; (load "AddArcTangents.lsp") AddArcTangents
4. ; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
5. ; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
6. (defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
7.   (defun _angle (ename pt / ang clpt e param)
8.     (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
9.              (setq clpt (vlax-curve-getclosestpointto ename pt))
10.              (setq param (vlax-curve-getparamatpoint ename clpt))
11.              (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
12.         )
13.       ang
14.     )
15.   )
16.   (defun _line (p1 p2 layer)
17.     (entmakex (list '(0 . "LINE")
18.                     '(100 . "AcDbEntity")
19.                     (cons 8 layer)
20.                     (cons 10 p1)
21.                     (cons 11 p2)
22.               )
23.     )
24.   )
25.  
26.   (princ "\nSelect Arc or Polyline ")
27.   (setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
28.   (if tmp
29.     (progn
30.       (setq e (ssname tmp 0)
31.             EnTyp (cdr (assoc 0 (entget e)))
32.       )
33.       (if (= EnTyp "LWPOLYLINE")
34.         (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
35.         (setq tmp (list (vlax-ename->vla-object e)))
36.       )
37. ;  (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
38.       (foreach o tmp
39.         (if (= "AcDbArc" (vla-get-objectname o))
40.           (progn (setq sp (vlax-curve-getstartpoint o))
41.                  (setq ep (vlax-curve-getendpoint o))
42.                  (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
43.                  (_line sp p "Intersection")
44.                  (_line ep p "Intersection")
45.                  (if (= EnTyp "LWPOLYLINE")(vla-delete o))
46.           )
47.           (if (= EnTyp "LWPOLYLINE")(vla-delete o))
48.         )
49.       )
50.     )
51.   )
52.  
53.   (princ)
54. )

Thanks again!

[ronjonp]

Nice!

Thanks! 


Although it may not be what the OP wanted 

Turned out it was!

I modified it to work with preselected objects as well including arcs & lwpolylines.  I use right-click menus for modifying so I needed the preselected option.

Code - Auto/Visual Lisp: [Select]

1. ; by ronjonp
2. ; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
3. ; (load "AddArcTangents.lsp") AddArcTangents
4. ; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
5. ; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
6. (defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
7.   (defun _angle   (ename pt / ang clpt e param)
8.     (if   (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
9.         (setq clpt (vlax-curve-getclosestpointto ename pt))
10.         (setq param (vlax-curve-getparamatpoint ename clpt))
11.         (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
12.    )
13.       ang
14.     )
15.   )
16.   (defun _line (p1 p2 layer)
17.     (entmakex (list '(0 . "LINE")
18.           '(100 . "AcDbEntity")
19.           (cons 8 layer)
20.           (cons 10 p1)
21.           (cons 11 p2)
22.          )
23.     )
24.   )
25.  
26.   (princ "\nSelect Arc or Polyline ")
27.   (setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
28.   (if tmp
29.     (progn
30.       (setq e (ssname tmp 0)
31.        EnTyp (cdr (assoc 0 (entget e)))
32.       )
33.       (if (= EnTyp "LWPOLYLINE")
34.    (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
35.    (setq tmp (list (vlax-ename->vla-object e)))
36.       )
37. ;  (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
38.       (foreach o tmp
39.         (if (= "AcDbArc" (vla-get-objectname o))
40.        (progn (setq sp (vlax-curve-getstartpoint o))
41.             (setq ep (vlax-curve-getendpoint o))
42.             (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
43.             (_line sp p "Intersection")
44.             (_line ep p "Intersection")
45.             (if (= EnTyp "LWPOLYLINE")(vla-delete o))
46.      )
47.      (if (= EnTyp "LWPOLYLINE")(vla-delete o))
48.         )
49.       )
50.     )
51.   )
52.  
53.   (princ)
54. )

Thanks again!

Glad you could make use of it 

[rashidaziz]

Thanks so much all of you,

Awesome work.

Thanks again