Osnap intersection

I have two arcs with one intersection in a lisp program the program pauses so the user can pick the intersection this works fine. But is there a way to get autolisp to find the intersection of the arc so I do not have to pause the program and get out side help?

Thanks mike

It's already been written for you, take a look at this: http://www.lee-mac.com/intersectionfunctions.html

From @Lee Mac

http://www.cadtutor.net/forum/member.php?16898-Lee-Mac

Many thanks for the recommendation rk

As an alternative to using the ActiveX intersectwith method, below is a function to calculate the points mathematically:

[color=GREEN];; 2-Arc Intersection  -  Lee Mac[/color]
[color=GREEN];; Returns the point(s) of intersection between two arcs[/color]
[color=GREEN];; with centres c1,c2 radii r1,r2, start angles s1,s2 & end angles e1,e2[/color]

([color=BLUE]defun[/color] LM:arc-arc-inters ( c1 r1 s1 e1 c2 r2 s2 e2 )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]<[/color] e1 s1) (LM:arc-arc-inters c1 r1 s1 ([color=BLUE]+[/color] e1 [color=BLUE]pi[/color] [color=BLUE]pi[/color]) c2 r2 s2 e2))
       (   ([color=BLUE]<[/color] e2 s2) (LM:arc-arc-inters c1 r1 s1 e1 c2 r2 s2 ([color=BLUE]+[/color] e2 [color=BLUE]pi[/color] [color=BLUE]pi[/color])))
       (   ([color=BLUE]vl-remove-if-not[/color]
              '([color=BLUE]lambda[/color] ( pt ) ([color=BLUE]and[/color] ([color=BLUE]<=[/color] s1 ([color=BLUE]angle[/color] c1 pt) e1) ([color=BLUE]<=[/color] s2 ([color=BLUE]angle[/color] c2 pt) e2)))
               (LM:circle-circle-inters c1 r1 c2 r2)
           )
       )
   )
)

[color=GREEN];; 2-Circle Intersection  -  Lee Mac[/color]
[color=GREEN];; Returns the point(s) of intersection between two circles[/color]
[color=GREEN];; with centres c1,c2 and radii r1,r2[/color]

([color=BLUE]defun[/color] LM:circle-circle-inters ( c1 r1 c2 r2 [color=BLUE]/[/color] a d m l x y )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] d ([color=BLUE]distance[/color] c1 c2)) ([color=BLUE]+[/color] r1 r2))
            ([color=BLUE]<=[/color] ([color=BLUE]abs[/color] ([color=BLUE]-[/color] r1 r2)) d)
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]equal[/color] r1 ([color=BLUE]setq[/color] x ([color=BLUE]/[/color] ([color=BLUE]-[/color] ([color=BLUE]+[/color] ([color=BLUE]*[/color] r1 r1) ([color=BLUE]*[/color] d d)) ([color=BLUE]*[/color] r2 r2)) ([color=BLUE]+[/color] d d))) 1e-
               ([color=BLUE]setq[/color]  l  ([color=BLUE]list[/color] ([color=BLUE]list[/color] x 0.0 0.0)))
               ([color=BLUE]setq[/color]  y  ([color=BLUE]sqrt[/color] ([color=BLUE]-[/color] ([color=BLUE]*[/color] r1 r1) ([color=BLUE]*[/color] x x)))
                      l  ([color=BLUE]list[/color] ([color=BLUE]list[/color] x y 0.0) ([color=BLUE]list[/color] x ([color=BLUE]-[/color] y) 0.0))
               )
           )
           ([color=BLUE]setq[/color] a ([color=BLUE]angle[/color] c1 c2)
                 m ([color=BLUE]list[/color] ([color=BLUE]list[/color] ([color=BLUE]cos[/color] a) ([color=BLUE]-[/color] ([color=BLUE]sin[/color] a)) 0) ([color=BLUE]list[/color] ([color=BLUE]sin[/color] a) ([color=BLUE]cos[/color] a) 0) '(0 0 1))
           )
           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] c1 (mxv m v))) l)
       )
   )
)

[color=GREEN];; Matrix x Vector  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m - nxn matrix, v - vector in R^n[/color]

([color=BLUE]defun[/color] mxv ( m v )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] r v))) m)
)

And a program to test the above:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] e1 e2 zv )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]setq[/color] e1 ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect 1st arc: "[/color])))
            ([color=BLUE]=[/color] [color=MAROON]"ARC"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] e1 ([color=BLUE]entget[/color] e1)))))
            ([color=BLUE]setq[/color] e2 ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect 2nd arc: "[/color])))
            ([color=BLUE]=[/color] [color=MAROON]"ARC"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] e2 ([color=BLUE]entget[/color] e2)))))
            ([color=BLUE]setq[/color] zv ([color=BLUE]assoc[/color] 210 e1))
       )
       ([color=BLUE]foreach[/color] x
           ([color=BLUE]apply[/color] 'LM:arc-arc-inters
               ([color=BLUE]apply[/color] '[color=BLUE]append[/color]
                   ([color=BLUE]mapcar[/color]
                      '([color=BLUE]lambda[/color] ( x )
                           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( k ) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] k x))) '(10 40 50 51))
                       )
                       ([color=BLUE]list[/color] e1 e2)
                   )
               )
           )
           ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"POINT"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] x ([color=BLUE]cdr[/color] zv) 0)) zv))
       )
   )
   ([color=BLUE]princ[/color])
)

Here is an example of using intersection with pick arc pick two horizontal lines the indent is drawn, this is used for pram crossings in a road.

; Draws a pram crossing into a line 

(vl-load-com)

(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldlayer (getvar "clayer"))

;pdmode point type use when checking points
; (setvar "pdmode" 34)

(setvar "osmode" 512)  ; nearest make sure on line
(setq pickobj (entsel "\nPick arc :"))
(setq obj1 (vlax-ename->vla-object (car pickobj)))
(setq pt1 (cadr pickobj))  
(setvar "clayer" (cdr (assoc 8 (entget (car pickobj)))))

(setq pickobj1 (entsel "\nPick 1st line :"))
(setq obj2 (vlax-ename->vla-object (car pickobj1)))
(setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(setq L1 (cdr (assoc 10 (entget (car pickobj1)))))
(setq L2 (cdr (assoc 11 (entget (car pickobj1)))))
(setq ang (angle L1 L2))
(setq dist (distance L1 L2))
(setq pt2 (polar L1 ang (/ dist 2.0)))
;(setq pt2 (cadr pickobj1))
;(command "point" intpt1) ;path intersect with arc

;path intersect with arc
(setq pickobj2 (entsel "\nPick 2nd line :"))
(setq obj3 (vlax-ename->vla-object (car pickobj2)))
(setq pt3 (cadr pickobj2))
(setq intpt2 (vlax-invoke obj3 'intersectWith obj1 acExtendThisEntity))
;(command "point" intpt2)

; left & right offset
(setq L1 (cdr (assoc 10 (entget (car pickobj2)))))
(setq L2 (cdr (assoc 11 (entget (car pickobj2)))))
(setq ang (angle L1 L2))
(setq dist (distance L1 L2))
(setq pt3 (polar L1 ang (/ dist 2.0)))

(setvar "osmode" 0)

(setq ang (angle pt2 pt3))
(setq ang2 (+ ang 3.14159))

(setq pt4 (polar pt2 ang2 1.0))
(setq pt5 (polar pt3 ang 1.0))

;path offset intersect with arc
(command "offset" 0.6 pickobj2 pt5 "exit")
(setq pickobj3 (entlast))
(setq obj4 (vlax-ename->vla-object pickobj3))
(setq intpt3 (vlax-invoke obj4 'intersectWith obj1 acExtendThisEntity))
;(command "point" intpt3) 

;path offset intersect with arc
(command "offset" 0.6 pickobj1 pt4 "exit")
(setq pickobj4 (entlast))
(setq obj5 (vlax-ename->vla-object pickobj4))
(setq intpt4 (vlax-invoke obj5 'intersectWith obj1 acExtendThisEntity)) 
;(command "point" intpt4) :

(command "offset" 0.3 pickobj pt4 "exit")
(setq pickobj5 (entlast))

(command "extend" pickobj5 "" pickobj1 "")
(command "extend" pickobj5 "" pickobj2 "")

(setq L1 (cdr (assoc 10 (entget (car pickobj2)))))
(setq L2 (cdr (assoc 11 (entget (car pickobj2)))))

; swap
(setq d1 (distance intpt2 L1))
(setq d2 (distance intpt2 L2))
(if (> d1 d2)
 (progn 
 (setq temp L1)
 (setq L1 L2)
 (setq L2 temp)
)
)


(setq L3 (cdr (assoc 10 (entget (car pickobj1)))))
(setq L4 (cdr (assoc 11 (entget (car pickobj1)))))

;swap 
(setq d1 (distance intpt1 L3))
(setq d2 (distance intpt1 L4))
(if (> d1 d2)
 (progn 
 (setq temp L3)
 (setq L3 L4)
 (setq L4 temp)
)
)
(command "erase" pickobj3 pickobj4 pickobj5 "")
(command "break" pickobj "F" intpt3 intpt4)
(command "line" intpt3 L1 L3 intpt4 "")


(setvar "osmode" oldsnap)

(princ)