Intersection between line and circle...

[Anonymous]

I was looking for a post on the subject of line and circle intersections and
found one that Bill Z had posted. I decided to incorperate one of the
replies into my own code. In particular Luis Esquivel's code. With some
minor modifications I was able to add the onseg argument that extends
intersection points for the line to the circle. I also modified it to
return only one point or two points depending on the line and circle
supplied and the onseg argument. It seems to work great.

Please check it out, modify it and/or comment,

Devin

; test function
(defun c:go ( / )
(ed_init)
(while
(or
(not (setq ent (entsel "\nSelect line: ")))
(if ent (/= (cdr (assoc 0 (setq data (entget (car ent))))) "LINE"))
)
(princ "\nLine entity not found!")
)
(while
(or
(not (setq ent2 (entsel "\nSelect circle: ")))
(if ent2 (/= (cdr (assoc 0 (setq data2 (entget (car ent2)))))
"CIRCLE"))
)
(princ "\nCircle entity not found!")
)
(setq
p1 (cdr (assoc 10 data))
p2 (cdr (assoc 11 data))
ctr (cdr (assoc 10 data2))
rad (cdr (assoc 40 data2))
; sa (cdr (assoc 50 data2))
; ea (cdr (assoc 51 data2))
)
(setq ints (inters_line_circle p1 p2 ctr rad nil))
(if
ints
(foreach n ints
(draw_circle n 50 5); replace this to indicate intersection pt for
debugging
)
(princ "\nNo intersection found!")
)
(ed_deinit)
)

(defun inters_line_circle ( pl1 pl2 cen r onseg / x1 y1 x2 y2 h r2 k yt1 yt2
pt1
pt2 m yk2 xt1 xt2 a b c z pass
)
(setq
x1 (car pl1)
y1 (cadr pl1)
x2 (car pl2)
y2 (cadr pl2)
r2 (expt r 2)
h (car cen)
xh2 (expt (- x1 h) 2)
k (cadr cen)
)
(if
(equal x2 x1 0.0001)
(if
(>= r2 xh2)
(setq
yt1 (+ (expt (- r2 xh2) 0.5) k)
yt2 (- k (expt (- r2 xh2) 0.5))
pt1 (list x1 yt1)
pt2 (list x1 yt2)
)
)
(progn
(setq m (/ (- y2 y1) (- x2 x1)))
(if
(equal m 0 0.0001)
(if
(>= r2 (setq yk2 (expt (- y1 k) 2)))
(setq
xt1 (+ (sqrt (- r2 yk2)) h)
xt2 (- h (sqrt (- r2 yk2)))
pt1 (list xt1 y2)
pt2 (list xt2 y2)
)
)
(progn
(setq
a (+ 1.0 (expt m 2))
b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k 2)
r2)))
z (- (expt b 2) (* 4 a c))
)
(if
(equal z 0 0.0001)
(setq z 0)
)
(if
(>= z 0)
(setq
yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
xt1 (+ (/ (- yt1 y1) m) x1)
xt2 (+ (/ (- yt2 y1) m) x1)
pt1 (list xt1 yt1)
pt2 (list xt2 yt2)
)
)
)
)
)
)

;(grdraw pt1 pt2 3)

(if
onseg
(progn; if onseg is set to true than only accept onseg inters
(if
(between pl1 pl2 pt1)
(setq pass (append pass (list pt1)))
)
(if
(between pl1 pl2 pt2)
(setq pass (append pass (list pt2)))
)
)
(cond; if onseg is set to nil than project line to inters
(
(and
(between pt1 pt2 pl1); if both line pts are between inters end pts
(between pt1 pt2 pl2)
)
(setq pass (list pt1 pt2))
)
(
(and
(between pl1 pl2 pt1); if both inters are between line end pts
(between pl1 pl2 pt2)
)
(setq pass (list pt1 pt2))
)
(
(between pl1 pl2 pt1); if pt1 is inside line
(setq pass (list pt2))
)
(
(between pl1 pl2 pt2); if pt2 is inside line
(setq pass (list pt1))
)
(
(vl-symbol-value T)
(if
(< (distance pl1 cen) (distance pl2 cen)); if pl1 closest to cen
(if
(< (distance pl1 pt1) (distance pl1 pt2)); if pt1 is closest to
pl1
(setq pass (list pt1))
(setq pass (list pt2))
)
(if
(< (distance pl2 pt1) (distance pl2 pt2)); if pl2 closest to cen
if pt1 is closest to pl2
(setq pass (list pt1))
(setq pass (list pt2))
)
)
)
)
)
(vl-symbol-value 'pass)
)

(defun between ( p1 p2 pt / )
(and
(equal (angle p1 p2) (angle p1 pt) 0.001)
(equal (angle p2 p1) (angle p2 pt) 0.001)
)
)

[Anonymous]

There you go...
Great that an old code can be useful (even with the activex now)

I did the same in particular plus the rest of the conditions in autolisp, I
will try to post it here...


Regards,
___________________________
Luis Esquivel
Caddximation Software
http://www.caddximation.com
___________________________

"Devin" wrote in message
news:23E64CCA33F360E60E35D53A84CCF4A2@in.WebX.maYIadrTaRb...
> I was looking for a post on the subject of line and circle intersections
and
> found one that Bill Z had posted. I decided to incorperate one of the
> replies into my own code. In particular Luis Esquivel's code. With some
> minor modifications I was able to add the onseg argument that extends
> intersection points for the line to the circle. I also modified it to
> return only one point or two points depending on the line and circle
> supplied and the onseg argument. It seems to work great.
>
> Please check it out, modify it and/or comment,
>
> Devin
>
> ; test function
> (defun c:go ( / )
> (ed_init)
> (while
> (or
> (not (setq ent (entsel "\nSelect line: ")))
> (if ent (/= (cdr (assoc 0 (setq data (entget (car ent))))) "LINE"))
> )
> (princ "\nLine entity not found!")
> )
> (while
> (or
> (not (setq ent2 (entsel "\nSelect circle: ")))
> (if ent2 (/= (cdr (assoc 0 (setq data2 (entget (car ent2)))))
> "CIRCLE"))
> )
> (princ "\nCircle entity not found!")
> )
> (setq
> p1 (cdr (assoc 10 data))
> p2 (cdr (assoc 11 data))
> ctr (cdr (assoc 10 data2))
> rad (cdr (assoc 40 data2))
> ; sa (cdr (assoc 50 data2))
> ; ea (cdr (assoc 51 data2))
> )
> (setq ints (inters_line_circle p1 p2 ctr rad nil))
> (if
> ints
> (foreach n ints
> (draw_circle n 50 5); replace this to indicate intersection pt for
> debugging
> )
> (princ "\nNo intersection found!")
> )
> (ed_deinit)
> )
>
> (defun inters_line_circle ( pl1 pl2 cen r onseg / x1 y1 x2 y2 h r2 k yt1
yt2
> pt1
> pt2 m yk2 xt1 xt2 a b c z pass
> )
> (setq
> x1 (car pl1)
> y1 (cadr pl1)
> x2 (car pl2)
> y2 (cadr pl2)
> r2 (expt r 2)
> h (car cen)
> xh2 (expt (- x1 h) 2)
> k (cadr cen)
> )
> (if
> (equal x2 x1 0.0001)
> (if
> (>= r2 xh2)
> (setq
> yt1 (+ (expt (- r2 xh2) 0.5) k)
> yt2 (- k (expt (- r2 xh2) 0.5))
> pt1 (list x1 yt1)
> pt2 (list x1 yt2)
> )
> )
> (progn
> (setq m (/ (- y2 y1) (- x2 x1)))
> (if
> (equal m 0 0.0001)
> (if
> (>= r2 (setq yk2 (expt (- y1 k) 2)))
> (setq
> xt1 (+ (sqrt (- r2 yk2)) h)
> xt2 (- h (sqrt (- r2 yk2)))
> pt1 (list xt1 y2)
> pt2 (list xt2 y2)
> )
> )
> (progn
> (setq
> a (+ 1.0 (expt m 2))
> b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
> c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k
2)
> r2)))
> z (- (expt b 2) (* 4 a c))
> )
> (if
> (equal z 0 0.0001)
> (setq z 0)
> )
> (if
> (>= z 0)
> (setq
> yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
> yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
> xt1 (+ (/ (- yt1 y1) m) x1)
> xt2 (+ (/ (- yt2 y1) m) x1)
> pt1 (list xt1 yt1)
> pt2 (list xt2 yt2)
> )
> )
> )
> )
> )
> )
>
> ;(grdraw pt1 pt2 3)
>
> (if
> onseg
> (progn; if onseg is set to true than only accept onseg inters
> (if
> (between pl1 pl2 pt1)
> (setq pass (append pass (list pt1)))
> )
> (if
> (between pl1 pl2 pt2)
> (setq pass (append pass (list pt2)))
> )
> )
> (cond; if onseg is set to nil than project line to inters
> (
> (and
> (between pt1 pt2 pl1); if both line pts are between inters end
pts
> (between pt1 pt2 pl2)
> )
> (setq pass (list pt1 pt2))
> )
> (
> (and
> (between pl1 pl2 pt1); if both inters are between line end pts
> (between pl1 pl2 pt2)
> )
> (setq pass (list pt1 pt2))
> )
> (
> (between pl1 pl2 pt1); if pt1 is inside line
> (setq pass (list pt2))
> )
> (
> (between pl1 pl2 pt2); if pt2 is inside line
> (setq pass (list pt1))
> )
> (
> (vl-symbol-value T)
> (if
> (< (distance pl1 cen) (distance pl2 cen)); if pl1 closest to cen
> (if
> (< (distance pl1 pt1) (distance pl1 pt2)); if pt1 is closest
to
> pl1
> (setq pass (list pt1))
> (setq pass (list pt2))
> )
> (if
> (< (distance pl2 pt1) (distance pl2 pt2)); if pl2 closest to
cen
> if pt1 is closest to pl2
> (setq pass (list pt1))
> (setq pass (list pt2))
> )
> )
> )
> )
> )
> (vl-symbol-value 'pass)
> )
>
> (defun between ( p1 p2 pt / )
> (and
> (equal (angle p1 p2) (angle p1 pt) 0.001)
> (equal (angle p2 p1) (angle p2 pt) 0.001)
> )
> )
>
>

[Anonymous]

I'm new to activex, can activex get the intersections of a circle and line
without them being activex objects?

Devin

[Anonymous]

Devin,

Here is the code, please make it better.

This code is part of the functions that I'm working for my web page... for
download for FREE...

Regards,
___________________________
Luis Esquivel
Caddximation Software
http://www.caddximation.com
___________________________

[Anonymous]

Yes

just convert the ename's into vla-object with: vlax-ename->vla-object
(vla-getIntersectWith obj1 obj2 ExtendOption)

There are more conversion stuff to do, give a try, and here we can help you.

LE.

"Devin" wrote in message
news:B6BEEE4C0D9D92BC87AC7D8562D76A23@in.WebX.maYIadrTaRb...
> I'm new to activex, can activex get the intersections of a circle and line
> without them being activex objects?
>
> Devin
>
>

[Anonymous]

Here's the intersection between line and arc with the onseg ability...

;;in the format (inters_line_arc
)

(defun between ( p1 p2 pt / )
(and
(equal (angle p1 p2) (angle p1 pt) 0.001)
(equal (angle p2 p1) (angle p2 pt) 0.001)
)
)

(defun inters_line_arc ( pl1 pl2 cen r sa ea onseg / x1 y1 x2 y2 h r2 k yt1
yt2 pt1
pt2 m yk2 xt1 xt2 a
b c z pass
)
(setq
x1 (car pl1)
y1 (cadr pl1)
x2 (car pl2)
y2 (cadr pl2)
r2 (expt r 2)
h (car cen)
xh2 (expt (- x1 h) 2)
k (cadr cen)
)
(if
(equal x2 x1 0.0001)
(if
(>= r2 xh2)
(setq
yt1 (+ (expt (- r2 xh2) 0.5) k)
yt2 (- k (expt (- r2 xh2) 0.5))
pt1 (list x1 yt1)
pt2 (list x1 yt2)
)
)
(progn
(setq m (/ (- y2 y1) (- x2 x1)))
(if
(equal m 0 0.0001)
(if
(>= r2 (setq yk2 (expt (- y1 k) 2)))
(setq
xt1 (+ (sqrt (- r2 yk2)) h)
xt2 (- h (sqrt (- r2 yk2)))
pt1 (list xt1 y2)
pt2 (list xt2 y2)
)
)
(progn
(setq
a (+ 1.0 (expt m 2))
b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k 2)
r2)))
z (- (expt b 2) (* 4 a c))
)
(if
(equal z 0 0.0001)
(setq z 0)
)
(if
(>= z 0)
(setq
yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
xt1 (+ (/ (- yt1 y1) m) x1)
xt2 (+ (/ (- yt2 y1) m) x1)
pt1 (list xt1 yt1)
pt2 (list xt2 yt2)
)
)
)
)
)
)

;(grdraw pt1 pt2 3)

(if
onseg
(progn; if onseg is set to true than only accept onseg inters
(if
(and
(ang_between sa ea (angle cen pt1)); check pt1 is onseg and
between sa ea
(between pl1 pl2 pt1)
)
(setq pass (append pass (list pt1)))
)
(if
(and
(ang_between sa ea (angle cen pt2)); check pt2 is onseg and
between sa ea
(between pl1 pl2 pt2)
)
(setq pass (append pass (list pt2)))
)
)
(cond; if onseg is set to nil than project line to inters
(
(or
(and
(between pt1 pt2 pl1); if both line pts are between inters end
pts
(between pt1 pt2 pl2)
)
(and
(between pl1 pl2 pt1); if both inters are between line end pts
(between pl1 pl2 pt2)
)
)
(setq pass (list pt1 pt2))
)
(
(between pl1 pl2 pt1); if pt1 is inside line
(setq pass (list pt2))
)
(
(between pl1 pl2 pt2); if pt2 is inside line
(setq pass (list pt1))
)
(
(vl-symbol-value T)
(if
(< (distance pl1 cen) (distance pl2 cen)); if pl1 closest to cen
(if
(< (distance pl1 pt1) (distance pl1 pt2)); if pt1 is closest to
pl1
(setq pass (list pt1))
(setq pass (list pt2))
)
(if
(< (distance pl2 pt1) (distance pl2 pt2)); if pl2 closest to cen
if pt1 is closest to pl2
(setq pass (list pt1))
(setq pass (list pt2))
)
)
)
)
)
(vl-symbol-value 'pass)
)

(defun ang_between ( sa ea ang / )
(if
(< sa ea)
(and
(> ang sa)
(< ang ea)
)
(or
(> ang sa)
(< ang ea)
)
)
)

[Anonymous]

but what if I'm just working in formula mode and have no entities to work
with?

Devin

[Anonymous]

I guess I posted too soon, heres the line-arc intersection program. It uses
pt1-pt2 of line and center-rad-startang-endang of arc. Is that what you're
looking for?

HTH,

Devin

[Anonymous]

🙂

What can I say... not all the roads take you to Rome...

Still the oldies-but-goodies...


"Devin" wrote in message
news:f12c860.5@WebX.maYIadrTaRb...
> but what if I'm just working in formula mode and have no entities to work
> with?
>
> Devin
>
>

[Anonymous]

I still need to condition the output for nil pt1 pt2. I'll post the updated
code in a minute, otherwise it will error out if no intersection is found.

Devin

[Anonymous]

Sorry, here's the new code.

Devin

[Anonymous]

Devin,

My function does that already maybe you misunderstood me, or as normal (I'm
getting older my friend)

Try this:

(setq p1 (getpoint "\nPoint one: "))
(setq p2 (getpoint "\nPoint two: "))
(setq ctr (getpoint "\nCenter point: "))
(setq radius (getdist "\nRadius: "))
(setq sp (getpoint "\nCurve start: "))
(setq ep (getpoint "\nCurve end: "))
;; nil will force the intersection... "" not
(setq data (caddxi-linCir-int p1 p2 ctr radius sp ep nil))

Regards,
Luis E.

"Devin" wrote in message
news:83448571438F2D5A4A4F70EE88E362FB@in.WebX.maYIadrTaRb...
> Sorry, here's the new code.
>
> Devin
>
>


----------------------------------------------------------------------------
----


(defun between ( p1 p2 pt / )
(and
(equal (angle p1 p2) (angle p1 pt) 0.001)
(equal (angle p2 p1) (angle p2 pt) 0.001)
)
)

(defun inters_line_arc ( pl1 pl2 cen r sa ea onseg / x1 y1 x2 y2 h r2 k yt1
yt2 pt1
pt2 m yk2 xt1 xt2 a
b c z pass
)
(setq
x1 (car pl1)
y1 (cadr pl1)
x2 (car pl2)
y2 (cadr pl2)
r2 (expt r 2)
h (car cen)
xh2 (expt (- x1 h) 2)
k (cadr cen)
)
(if
(equal x2 x1 0.0001)
(if
(>= r2 xh2)
(setq
yt1 (+ (expt (- r2 xh2) 0.5) k)
yt2 (- k (expt (- r2 xh2) 0.5))
pt1 (list x1 yt1)
pt2 (list x1 yt2)
)
)
(progn
(setq m (/ (- y2 y1) (- x2 x1)))
(if
(equal m 0 0.0001)
(if
(>= r2 (setq yk2 (expt (- y1 k) 2)))
(setq
xt1 (+ (sqrt (- r2 yk2)) h)
xt2 (- h (sqrt (- r2 yk2)))
pt1 (list xt1 y2)
pt2 (list xt2 y2)
)
)
(progn
(setq
a (+ 1.0 (expt m 2))
b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k 2)
r2)))
z (- (expt b 2) (* 4 a c))
)
(if
(equal z 0 0.0001)
(setq z 0)
)
(if
(>= z 0)
(setq
yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
xt1 (+ (/ (- yt1 y1) m) x1)
xt2 (+ (/ (- yt2 y1) m) x1)
pt1 (list xt1 yt1)
pt2 (list xt2 yt2)
)
)
)
)
)
)

;(grdraw pt1 pt2 3)

(if
(and pt1 pt2)
(if
onseg
(progn; if onseg is set to true than only accept onseg inters
(if
(and
(ang_between sa ea (angle cen pt1)); check pt1 is onseg and
between sa ea
(between pl1 pl2 pt1)
)
(setq pass (append pass (list pt1)))
)
(if
(and
(ang_between sa ea (angle cen pt2)); check pt2 is onseg and
between sa ea
(between pl1 pl2 pt2)
)
(setq pass (append pass (list pt2)))
)
)
(cond; if onseg is set to nil than project line to inters
(
(or
(and
(between pt1 pt2 pl1); if both line pts are between inters end
pts
(between pt1 pt2 pl2)
)
(and
(between pl1 pl2 pt1); if both inters are between line end pts
(between pl1 pl2 pt2)
)
)
(setq pass (list pt1 pt2))
)
(
(between pl1 pl2 pt1); if pt1 is inside line
(setq pass (list pt2))
)
(
(between pl1 pl2 pt2); if pt2 is inside line
(setq pass (list pt1))
)
(
(vl-symbol-value T)
(if
(< (distance pl1 cen) (distance pl2 cen)); if pl1 closest to cen
(if
(< (distance pl1 pt1) (distance pl1 pt2)); if pt1 is closest
to pl1
(setq pass (list pt1))
(setq pass (list pt2))
)
(if
(< (distance pl2 pt1) (distance pl2 pt2)); if pl2 closest to
cen if pt1 is closest to pl2
(setq pass (list pt1))
(setq pass (list pt2))
)
)
)
)
)
)
(vl-symbol-value 'pass)
)

(defun ang_between ( sa ea ang / )
(if
(< sa ea)
(and
(> ang sa)
(< ang ea)
)
(or
(> ang sa)
(< ang ea)
)
)
)

[Anonymous]

I tested the code Devin, works great.

Keep programming!

[Anonymous]

perhaps this is the more appropriate version of the inters_line_arc

onseg values are as follows...

nil = do not extend either
1 = extend line
2 = extend arc
3 = extend line and arc

(defun between ( p1 p2 pt / )
(and
(equal (angle p1 p2) (angle p1 pt) 0.001)
(equal (angle p2 p1) (angle p2 pt) 0.001)
)
)

(defun inters_line_arc ( pl1 pl2 cen r sa ea onseg / x1 y1 x2 y2 h r2 k yt1
yt2 pt1
pt2 m yk2 xt1 xt2 a
b c z pass
)
(setq
x1 (car pl1)
y1 (cadr pl1)
x2 (car pl2)
y2 (cadr pl2)
r2 (expt r 2)
h (car cen)
xh2 (expt (- x1 h) 2)
k (cadr cen)
)
(if
(equal x2 x1 0.0001)
(if
(>= r2 xh2)
(setq
yt1 (+ (expt (- r2 xh2) 0.5) k)
yt2 (- k (expt (- r2 xh2) 0.5))
pt1 (list x1 yt1)
pt2 (list x1 yt2)
)
)
(progn
(setq m (/ (- y2 y1) (- x2 x1)))
(if
(equal m 0 0.0001)
(if
(>= r2 (setq yk2 (expt (- y1 k) 2)))
(setq
xt1 (+ (sqrt (- r2 yk2)) h)
xt2 (- h (sqrt (- r2 yk2)))
pt1 (list xt1 y2)
pt2 (list xt2 y2)
)
)
(progn
(setq
a (+ 1.0 (expt m 2))
b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k 2)
r2)))
z (- (expt b 2) (* 4 a c))
)
(if
(equal z 0 0.0001)
(setq z 0)
)
(if
(>= z 0)
(setq
yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
xt1 (+ (/ (- yt1 y1) m) x1)
xt2 (+ (/ (- yt2 y1) m) x1)
pt1 (list xt1 yt1)
pt2 (list xt2 yt2)
)
)
)
)
)
)

;(grdraw pt1 pt2 3)

(if
(and pt1 pt2)
(if
(not onseg)
(progn; if onseg is set to false than only accept onseg inters
(if
(and
(ang_between sa ea (angle cen pt1)); check pt1 is onseg and
between sa ea
(between pl1 pl2 pt1)
)
(setq pass (append pass (list pt1)))
)
(if
(and
(ang_between sa ea (angle cen pt2)); check pt2 is onseg and
between sa ea
(between pl1 pl2 pt2)
)
(setq pass (append pass (list pt2)))
)
)
(cond; if onseg is set to 1 2 or 3 than project line to inters
(
(= onseg 1)
(if
(ang_between sa ea (angle cen pt1)); check pt1 is between sa ea
(setq pass (append pass (list pt1)))
)
(if
(ang_between sa ea (angle cen pt2)); check pt2 is between sa ea
(setq pass (append pass (list pt2)))
)
)
(
(= onseg 2)
(if
(between pl1 pl2 pt1); check pt1 is between pl1 pl2
(setq pass (append pass (list pt1)))
)
(if
(between pl1 pl2 pt2); check pt2 is between pl1 pl2
(setq pass (append pass (list pt2)))
)
)
(
(= onseg 3)
(setq pass (list pt1 pt2))
)
)
)
)
(vl-symbol-value 'pass)
)

(defun ang_between ( sa ea ang / )
(if
(< sa ea)
(and
(> ang sa)
(< ang ea)
)
(or
(> ang sa)
(< ang ea)
)
)
)

[Anonymous]

Devin:

I've got a ton of "old" intersection functions that work based on mathematical
relationships, not VLA-Objects. Having given only a cursory look at your code,
be careful of your Between function as it may not handle angles correctly where
one is just less than (* pi 2) and the other is (> 0). I think many were
developed as part of a project that the client actually owns, but I think I can
still share some of the functions. If you're interested let me know.

--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ


"Devin" wrote in message
news:83448571438F2D5A4A4F70EE88E362FB@in.WebX.maYIadrTaRb...
> Sorry, here's the new code.
>
> Devin
>
>


--------------------------------------------------------------------------------


(defun between ( p1 p2 pt / )
(and
(equal (angle p1 p2) (angle p1 pt) 0.001)
(equal (angle p2 p1) (angle p2 pt) 0.001)
)
)

(defun inters_line_arc ( pl1 pl2 cen r sa ea onseg / x1 y1 x2 y2 h r2 k yt1 yt2
pt1
pt2 m yk2 xt1 xt2 a b c
z pass
)
(setq
x1 (car pl1)
y1 (cadr pl1)
x2 (car pl2)
y2 (cadr pl2)
r2 (expt r 2)
h (car cen)
xh2 (expt (- x1 h) 2)
k (cadr cen)
)
(if
(equal x2 x1 0.0001)
(if
(>= r2 xh2)
(setq
yt1 (+ (expt (- r2 xh2) 0.5) k)
yt2 (- k (expt (- r2 xh2) 0.5))
pt1 (list x1 yt1)
pt2 (list x1 yt2)
)
)
(progn
(setq m (/ (- y2 y1) (- x2 x1)))
(if
(equal m 0 0.0001)
(if
(>= r2 (setq yk2 (expt (- y1 k) 2)))
(setq
xt1 (+ (sqrt (- r2 yk2)) h)
xt2 (- h (sqrt (- r2 yk2)))
pt1 (list xt1 y2)
pt2 (list xt2 y2)
)
)
(progn
(setq
a (+ 1.0 (expt m 2))
b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
c (+ (expt (+ (* m (- h x1)) y1) 2) (* (expt m 2) (- (expt k 2)
r2)))
z (- (expt b 2) (* 4 a c))
)
(if
(equal z 0 0.0001)
(setq z 0)
)
(if
(>= z 0)
(setq
yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
xt1 (+ (/ (- yt1 y1) m) x1)
xt2 (+ (/ (- yt2 y1) m) x1)
pt1 (list xt1 yt1)
pt2 (list xt2 yt2)
)
)
)
)
)
)

;(grdraw pt1 pt2 3)

(if
(and pt1 pt2)
(if
onseg
(progn; if onseg is set to true than only accept onseg inters
(if
(and
(ang_between sa ea (angle cen pt1)); check pt1 is onseg and between
sa ea
(between pl1 pl2 pt1)
)
(setq pass (append pass (list pt1)))
)
(if
(and
(ang_between sa ea (angle cen pt2)); check pt2 is onseg and between
sa ea
(between pl1 pl2 pt2)
)
(setq pass (append pass (list pt2)))
)
)
(cond; if onseg is set to nil than project line to inters
(
(or
(and
(between pt1 pt2 pl1); if both line pts are between inters end pts
(between pt1 pt2 pl2)
)
(and
(between pl1 pl2 pt1); if both inters are between line end pts
(between pl1 pl2 pt2)
)
)
(setq pass (list pt1 pt2))
)
(
(between pl1 pl2 pt1); if pt1 is inside line
(setq pass (list pt2))
)
(
(between pl1 pl2 pt2); if pt2 is inside line
(setq pass (list pt1))
)
(
(vl-symbol-value T)
(if
(< (distance pl1 cen) (distance pl2 cen)); if pl1 closest to cen
(if
(< (distance pl1 pt1) (distance pl1 pt2)); if pt1 is closest to
pl1
(setq pass (list pt1))
(setq pass (list pt2))
)
(if
(< (distance pl2 pt1) (distance pl2 pt2)); if pl2 closest to cen
if pt1 is closest to pl2
(setq pass (list pt1))
(setq pass (list pt2))
)
)
)
)
)
)
(vl-symbol-value 'pass)
)

(defun ang_between ( sa ea ang / )
(if
(< sa ea)
(and
(> ang sa)
(< ang ea)
)
(or
(> ang sa)
(< ang ea)
)
)
)

[Anonymous]

Ya sure. BTW could you help me understand why the between function will
have problems? I can't seem to understand why. And I've noticed some
strange error's that this may account for in other parts of my code. If I
could understand then perhaps I could fix the other stuff too.

Devin

[Anonymous]

Devin,

What happen if you use my function that I posted yesterday? that should work
I know does not return the first point intersection in cases that there is
more than one, but it can be known by the vector direction.

I'm not a civil engineer (I'm an architect) the function I wrote is still
part of civil cad program, and works, we made several changes and adaptation
usings ads, arx for performance but the basic is the same.

I know that John will have more experience than me in this field, for what I
did for CivilCAD, was a lot of research.

Have fun,
Luis E.


"Devin" wrote in message
news:28F8E14B5AC5DB8F1BB74EE4E4DB4887@in.WebX.maYIadrTaRb...
> Ya sure. BTW could you help me understand why the between function will
> have problems? I can't seem to understand why. And I've noticed some
> strange error's that this may account for in other parts of my code. If I
> could understand then perhaps I could fix the other stuff too.
>
> Devin
>
>

[Anonymous]

When messing around with angles near 0, they might actually be just less than (*
2 pi)...
Command: (angle p1 p2) 6.28319

Command: (angle p2 p1) 3.14159

Command: (angle p1 p) 0.0

Command: (angle p p2) 6.28319

Command: (between p1 p2 p) nil

You're better of using David Bethel's famous approach:
Command: (equal (distance p1 p2)(+ (distance p1 p)(distance p2 p)) 1e-8) T

--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ


"Devin" wrote in message
news:28F8E14B5AC5DB8F1BB74EE4E4DB4887@in.WebX.maYIadrTaRb...
> Ya sure. BTW could you help me understand why the between function will
> have problems? I can't seem to understand why. And I've noticed some
> strange error's that this may account for in other parts of my code. If I
> could understand then perhaps I could fix the other stuff too.
>
> Devin
>
>

[Anonymous]

Oops. I forgot to show...
Command: (setq p1 '(0 1e-8 0) p2 '(10 -1e-8 0) p '(5 1e-8 0))

--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ


"Devin" wrote in message
news:28F8E14B5AC5DB8F1BB74EE4E4DB4887@in.WebX.maYIadrTaRb...
> Ya sure. BTW could you help me understand why the between function will
> have problems? I can't seem to understand why. And I've noticed some
> strange error's that this may account for in other parts of my code. If I
> could understand then perhaps I could fix the other stuff too.
>
> Devin
>
>

[Anonymous]

Sounds like a glitch in autocad or the math of radian calculation in
autocad. I'll alter my functions.

Thanks,

Devin