Author Topic: How to Make PI (Point of Intersection) on Pline Arc (Read 7905 times)

rashidaziz · « **on:** July 30, 2015, 09:22:36 AM »

I need Lisp for Draw or Make PI (point of intersection) Points on Centerline (PLINE with Arcs and Spline).
Draw only on ARC (not on Spline)
Please HELP me.

Thanks so much.

Lee Mac · « **Reply #1 on:** July 30, 2015, 09:32:19 AM »

Perhaps use the vector returned by vlax-curve-getfirstderiv at the end point of the surrounding splines in conjunction with the spline end points and the inters function (with the onseg argument set to nil), i.e.:

Code: [Select]

(inters
    <spline 1 end point>
    (mapcar '+ <spline 1 end point> (vlax-curve-getfirstderiv <spline 1> (vlax-curve-getparamatpoint <spline 1> <spline 1 end point>)))
    <spline 2 end point>
    (mapcar '+ <spline 2 end point> (vlax-curve-getfirstderiv <spline 2> (vlax-curve-getparamatpoint <spline 2> <spline 2 end point>)))
    nil
)

rashidaziz · « **Reply #2 on:** July 30, 2015, 09:58:54 AM »

Thanks Lee Mac

I am very new on AutoLISP. Please make LISP Program for me to Make PI Point on All Pline Arcs

Thanks and i appreciate for Helping and very quick reply.

roy_043 · « **Reply #3 on:** July 30, 2015, 01:43:22 PM »

The section indicated as 'spline' is in fact a series of very small straight segments belonging to the same polyline as the arc segment. The curve consists of a single polyline and not 3 or more elements.

Why not do it 'manually'?:

Create a copy of the polyline on a dedicated layer.
Change the linetype of the new polyline to continuous.
Explode it.
Change the colour of the arcs to make them stand out.
Use the FILLET command with R=0 on the facets bordering the arcs.
Use the TRIM command to trim the lengthened facets using the arcs as the cutting edges.
Erase all redundant facets.
Done!

BTW:
The texts in the dwg have a rotation of 0.355561 degrees.
I get worried when I see something like that...

tombu · « **Reply #4 on:** July 30, 2015, 02:01:22 PM »

Or
1. line endp osnap PC
2. int osnap each tangent for PI
3. endp osnap PT

When using fillet to add an arc I use [No trim] when those lines might come in handy later on.

ronjonp · « **Reply #5 on:** July 30, 2015, 02:37:17 PM »

Code - Auto/Visual Lisp: [Select]

(defun c:welcometotheswamp (/ _angle _line e ep p sp tmp)
  (defun _angle (ename pt / ang clpt e param)
    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
             (setq clpt (vlax-curve-getclosestpointto ename pt))
             (setq param (vlax-curve-getparamatpoint ename clpt))
             (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
        )
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 layer)
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )
  (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
    (foreach o tmp
      (if (= "AcDbArc" (vla-get-objectname o))
        (progn (setq sp (vlax-curve-getstartpoint o))
               (setq ep (vlax-curve-getendpoint o))
               (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
               (_line sp p "Intersection")
               (_line ep p "Intersection")
               (vla-delete o)
        )
        (vla-delete o)
      )
    )
  )
  (princ)
)

tombu · « **Reply #6 on:** July 30, 2015, 03:09:02 PM »

Quote from: ronjonp on July 30, 2015, 02:37:17 PM

Code: [Select]

Nice!

ronjonp · « **Reply #7 on:** July 30, 2015, 03:11:01 PM »

Quote from: tombu on July 30, 2015, 03:09:02 PM

Nice!

Thanks!

Although it may not be what the OP wanted

roy_043 · « **Reply #8 on:** July 30, 2015, 04:42:08 PM »

Quote from: tombu on July 30, 2015, 02:01:22 PM

Or
1. line endp osnap PC
2. int osnap each tangent for PI
3. endp osnap PT

When using fillet to add an arc I use [No trim] when those lines might come in handy later on.

Can you explain this in more detail. What are PC, PI and PT?

ymg · « **Reply #9 on:** July 30, 2015, 09:44:52 PM »

Roy,

In surveyor parlance, Tangent are straight line segment along an alignment.

PC stands for point of curvature, (beginning of Arc) although nowadays we use TC for Tangent to Curve.

PT is point of tangency that is end of the arc, nowadays CT for Curve to Tangent.

PI stand for point of intersection of two tangent.

Similarly you also have

TS Tangent to Spiral
SC Spiral to Curve
CS Curve to Spiral
ST Spiral to Tangent

ymg

roy_043 · « **Reply #10 on:** July 31, 2015, 03:32:27 AM »

Thanks you ymg.
But can the second step in tombu's procedure be accomplished without creating temporary tangent lines?

rashidaziz · « **Reply #11 on:** July 31, 2015, 04:00:58 AM »

Thanks so much all of you.

My problem solved with " ronjonp" post and special thanks to " ronjonp"

I really appreciate for solving my problem.

ronjonp · « **Reply #12 on:** July 31, 2015, 08:40:28 AM »

Quote from: rashidaziz on July 31, 2015, 04:00:58 AM

Thanks so much all of you.

My problem solved with " ronjonp" post and special thanks to " ronjonp"

I really appreciate for solving my problem.

Glad to help out

ymg · « **Reply #13 on:** July 31, 2015, 09:47:26 AM »

Here is another way:

Code - Auto/Visual Lisp: [Select]

(defun c:calcpi (/ bulge ptcp pct delta/2 ang chord radius tangent enpi pilst)
   
   (setq  en (car (entsel "Select Alignment: "))
         lst (listpolb en)
       pilst nil          
   )      
   (while (> (length lst) 1)
      (if (not (zerop (setq bulge (cadar lst))))
         (setq     ptc (caar lst)
                   pct (caadr lst)
               delta/2 (* (atan bulge) 2.0)
                   ang (- (angle ptc pct) delta/2)      
                 chord (distance ptc pct)
                radius (/ chord (* 2 (sin delta/2)))
               tangent (* radius (tan delta/2))
                 pilst (cons (polar ptc ang tangent) pilst)
                  enpi (entmakex (list (cons 0 "POINT") (cons 10 (car pilst))))
         )
      )
      (setq lst (cdr lst))
   )
   (print pilst)
   (princ)
)
 
;; tan   From std-lib                                                         ;
(defun tan (z / cosz)
  (cond ((zerop (rem z pi)) 0.0)        
        ((zerop (rem z (/ pi 2))) 1.7e308) 
        ((zerop (setq cosz (cos z))) 1.7e308)   
        (t (/ (sin z) cosz))))
 
 
;;                                                                            ;
;; listpolb     by ymg    (Simplified a Routine by Gile Chanteau              ;
;;                                                                            ;
;; Parameter:  en,  Entity Name or Object Name of Any Type of Polyline        ;
;;                                                                            ;
;; Returns:   List of Points and Bulge in Current UCS                         ;
;;                                                                            ;
;; Notes:      On Closed Polyline the Last Vertex is Same as First)           ;
;;                                                                            ;
 
(defun listpolb (en / i p l)  
   (repeat (setq i (fix (1+ (vlax-curve-getEndParam en))))            
      (setq l (cons (list (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1)
                             (vla-getbulge (vlax-ename->vla-object en) i)
                    )
                    l
              )     
      )
   )
)
 

roy_043 · « **Reply #14 on:** August 01, 2015, 05:20:17 AM »

@ ymg:
Nice to see some 'old school' trigonometry.
Three things to have another look at:
The (listpolb) function cannot handle closed polylines and does not translate from WCS to OCS.
The PI points should be translated from OCS to WCS.
Perhaps exclude bulge=1/-1.

ymg · « **Reply #15 on:** August 01, 2015, 10:09:20 AM »

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 · « **Reply #16 on:** August 02, 2015, 11:52:48 AM »

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]

(defun c:calcpi (/ bulge ptcp pct delta/2 ang chord radius tangent enpi pilst)
   
   (setq  en (car (entsel "Select Alignment: "))
         lst (listpolb en)
       pilst nil          
   )      
   (while (> (length lst) 1)
      (if (not (zerop (setq bulge (cadar lst))))
         (setq     ptc (caar lst)
                   pct (caadr lst)
               delta/2 (* (atan bulge) 2.0)
                   ang (- (angle ptc pct) delta/2)      
                 chord (distance ptc pct)
                radius (/ chord (* 2 (sin delta/2)))
               tangent (* radius (tan delta/2))
                 pilst (cons (polar ptc ang tangent) pilst)
                  enpi (entmakex (list (cons 0 "POINT") (cons 10 (car pilst))))
         )
      )
      (setq lst (cdr lst))
   )
   (print pilst)
   (princ)
)
 
;; tan   From std-lib                                                         ;
(defun tan (z / cosz)
  (cond ((zerop (rem z pi)) 0.0)        
        ((zerop (rem z (/ pi 2))) 1.7e308) 
        ((zerop (setq cosz (cos z))) 1.7e308)   
        (t (/ (sin z) cosz))))
 
 
;;                                                                            ;
;; listpolb     by ymg                                                        ;
;;                                                                            ;
;; Parameter:  en,  Entity Name  or Object Name                               ;
;;                                                                            ;
;; Returns:   List of Points and Bulge in WCS                                 ;
;;                                                                            ;
;; Notes:      On Closed Polyline the Last Vertex is Same as First)           ;
;;                                                                            ;
 
(defun listpolb (en / obj i p l)
   (if (= (type en) 'ENAME)
      (setq obj (vlax-ename->vla-object en))
      (setq obj en en (vlax-vla-object->ename en))
   )         
   (repeat (setq i (fix (vlax-curve-getEndParam en)))         
      (setq l (cons (list (vlax-curve-getPointAtParam en (setq i (1- i))) 
                             (vla-getbulge obj i)
                    )
                    l
              )     
      )
   )
   (if (= (vla-get-closed obj) :vlax-true)
      (append l (list (car l)))
      l
   ) 
)
 

roy_043 · « **Reply #17 on:** August 04, 2015, 06:05:00 AM »

FWIW: Here is a function inspired by this topic.

Code - Auto/Visual Lisp: [Select]

; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline".
; Return value: Point in WCS.
; (mapcar '- (_Geom_PolylineArcTangentialInters (vlax-ename->vla-object (car (entsel))) 0) (getpoint "\nPoint: "))
(defun _Geom_PolylineArcTangentialInters (obj idx / ang bulge ptSta ptEnd)
  (if
    (and
      (< idx (vlax-curve-getendparam obj))
      (not (equal 0.0 (setq bulge (vla-getbulge obj idx)) (_Math_FuzzDefault)))
      (not (equal 1.0 (abs bulge) (_Math_FuzzDefault)))
    )
    (progn
      (setq ptSta (vlax-get obj 'coordinate idx))
      (setq ptEnd (vlax-get obj 'coordinate (1+ idx)))
      (trans
        (append
          (_Geom_XYof
            (polar
              ptSta
              (- (angle ptSta ptEnd) (setq ang (* 2.0 (atan bulge))))
              (/ (distance ptSta ptEnd) 2.0 (cos ang))
            )
          )
          (list (vla-get-elevation obj))
        )
        (vlax-get obj 'normal)
        0
      )
    )
  )
)
 
(defun _Geom_XYof (pt)
  (list
    (_Geom_Xof pt)
    (_Geom_Yof pt)
  )
)
 
(defun _Geom_Xof (pt)
  (if (car pt)
    (float (car pt))
    0.0
  )
)
 
(defun _Geom_Yof (pt)
  (if (cadr pt)
    (float (cadr pt))
    0.0
  )
)
 
(defun _Math_FuzzDefault ()
  0.00000001
)

tombu · « **Reply #18 on:** August 08, 2015, 04:20:51 PM »

Quote from: ronjonp on July 30, 2015, 03:11:01 PM

Quote from: tombu on July 30, 2015, 03:09:02 PM

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]

; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
(defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
  (defun _angle (ename pt / ang clpt e param)
    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
             (setq clpt (vlax-curve-getclosestpointto ename pt))
             (setq param (vlax-curve-getparamatpoint ename clpt))
             (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
        )
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 layer)
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )
 
  (princ "\nSelect Arc or Polyline ")
  (setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
  (if tmp
    (progn
      (setq e (ssname tmp 0)
            EnTyp (cdr (assoc 0 (entget e)))
      )
      (if (= EnTyp "LWPOLYLINE")
        (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
        (setq tmp (list (vlax-ename->vla-object e)))
      )
;  (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
      (foreach o tmp
        (if (= "AcDbArc" (vla-get-objectname o))
          (progn (setq sp (vlax-curve-getstartpoint o))
                 (setq ep (vlax-curve-getendpoint o))
                 (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
                 (_line sp p "Intersection")
                 (_line ep p "Intersection")
                 (if (= EnTyp "LWPOLYLINE")(vla-delete o))
          )
          (if (= EnTyp "LWPOLYLINE")(vla-delete o))
        )
      )
    )
  )
 
  (princ)
)

Thanks again!

ronjonp · « **Reply #19 on:** August 08, 2015, 09:21:34 PM »

Quote from: tombu on August 08, 2015, 04:20:51 PM

Quote from: ronjonp on July 30, 2015, 03:11:01 PM
Quote from: tombu on July 30, 2015, 03:09:02 PM

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]
; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
(defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
(defun _angle (ename pt / ang clpt e param)
(if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
(setq clpt (vlax-curve-getclosestpointto ename pt))
(setq param (vlax-curve-getparamatpoint ename clpt))
(setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
)
ang
)
)
(defun _line (p1 p2 layer)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
(cons 8 layer)
(cons 10 p1)
(cons 11 p2)
)
)
)

(princ "\nSelect Arc or Polyline ")
(setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
(if tmp
(progn
(setq e (ssname tmp 0)
EnTyp (cdr (assoc 0 (entget e)))
)
(if (= EnTyp "LWPOLYLINE")
(setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
(setq tmp (list (vlax-ename->vla-object e)))
)
; (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
(foreach o tmp
(if (= "AcDbArc" (vla-get-objectname o))
(progn (setq sp (vlax-curve-getstartpoint o))
(setq ep (vlax-curve-getendpoint o))
(setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
(_line sp p "Intersection")
(_line ep p "Intersection")
(if (= EnTyp "LWPOLYLINE")(vla-delete o))
)
(if (= EnTyp "LWPOLYLINE")(vla-delete o))
)
)
)
)

(princ)
)
Thanks again!

Glad you could make use of it

rashidaziz · « **Reply #20 on:** August 10, 2015, 04:00:18 PM »

Thanks so much all of you,

Awesome work.

Thanks again

News:

Author Topic: How to Make PI (Point of Intersection) on Pline Arc (Read 7905 times)

ymg

ymg

ymg

ymg