```
;*******************************************************************************************
;* Useful AutoLisp Functions
;*******************************************************************************************

;Basic Functions
(setq 2pi (* 2 pi))
(defun ² (x) (* x x))
(defun tan (x / cosx) (setq cosx (cos x)) (if (/= cosx 0) (/ (sin x) cosx)
(*ERROR* "Tangent undefined for argument.")
));d
(defun quadratic (A B C / t1) (setq t1 (- (² B) (* 4.0 A C)))
(if (>= t1 0) (list (/ (+ (- B) (setq t1 (sqrt t1))) (* 2.0 A)) (/ (- (- B) t1) (* 2.0 A))))
);d
(defun =~ (x y / n i) (or (= x y); approx
(if (and (numberp x) (numberp y)) (equal x y 1E-6)
(and (listp x) (listp y) (= (length x) (length y)) (not (vl-some '(lambda (x y) (/=~ x y)) x y)))
);i
));d
(defun /=~ (x y) (not (=~ x y))); /approx
(defun pt (x y) (list x y 0.0))
(defun unbuldge (plist / plist2) (foreach p plist
(if (listp p) (setq plist2 (append plist2 (list p)))) plist2
));d
(defun xmin (plist) (apply 'min (mapcar 'car (unbuldge plist))))
(defun xmax (plist) (apply 'max (mapcar 'car (unbuldge plist))))
(defun define-fillet (p1 p2 theta / p0 t1) (if (= theta 0) (*ERROR* "Infinite fillet radius encountered.") (progn
(setq
theta (* 2pi (+ (rem (1- (/ theta 2pi)) 2) (if (> theta 2pi) -1 1))); saw tooth
rfillet (/ (* 0.5 (distance p1 p2)) (sin (* 0.5 (abs theta))))
p0 (polar p2 (+ (angle p1 p2) (* 0.5 theta) (* (if (> theta 0) 1 -1) 0.5 pi)) rfillet); (if (> (abs theta) pi) (if (> theta 0) (- 2pi theta) (+ 2pi theta)) theta)
theta1 (angle p0 p1) theta2 (angle p0 p2)
);s
(if (< theta 0) (setq t1 theta1 theta1 theta2 theta2 t1)); must swap because arc functions go counter clockwise
p0
)));d

;Entity Functions
(defun length2 (plist / i) (setq i 0) (foreach p plist (if (listp p) (setq i (1+ i)))) i); excludes buldges
(defun getplist (ent / data plist) (if (and ent (setq data (entget ent))) (progn
(foreach t1 data
(if (= (car t1) 10) (setq plist (append plist (list (cdr t1)))))
(if (and (= (car t1) 42) (/=~ (cdr t1) 0)) (setq plist (append plist (list (* 4 (atan (cdr t1)))))))
);f
(append plist (if (= (cdr (assoc 70 data)) 1) (list (car plist))))
)));d
(defun circle (p r) (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r))))
(defun draw (plist / t1 data) (if plist (progn; draws polylines including buldges
(setq t1 (=~ (car plist) (last plist)) data (append
'((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline"))
(list (cons 90 (length2 plist)) (cons 70 (if t1 1 0)))
));s
(foreach p (if t1 (ldr plist) plist) (setq data (append data
(list (if (numberp p) (cons 42 (tan (* 0.25 p))) (cons 10 p)))
)));f
(entmake data)
)));d

;Intersection Point Functions
(defun inters-circle (p theta p0 r / x0 y0 x y t1 t2 A B C); returns both roots
(setq x0 (car p0) y0 (cadr p0) x (- (car p) x0))
(if (=~ (cos theta) 0)
(if (<= (- r) x r) (progn (setq y (sqrt (- (² r) (² x))))
(list (pt (+ x0 x) (+ y0 y)) (pt (+ x0 x) (- y0 y)))
));i
(progn (setq y (- (cadr p) y0) t1 (tan theta) t2 (/ (- (* x t1) y) r))
(setq A (1+ (² t1)) B (* -2 t2 t1) C (1- (² t2)))
(mapcar (function (lambda (x2) (pt (+ x0 (* x2 r)) (+ y0 y (* (- (* x2 r) x) t1))))) (quadratic A B C))
);p
);i
);d
(defun inters-arc (p1 p2 p1` p2` theta` onseg / p0 rfillet theta1 theta2 theta plist p)
(if (or (not theta`) (= theta` 0.0)) (if (setq p (inters p1 p2 p1` p2` onseg)) (list p)) (progn
(setq p0 (define-fillet p1` p2` theta`))
(foreach p (inters-circle p1 (angle p1 p2) p0 rfillet)
(if p (setq theta (angle p0 p)))
(if
(and p
(or (not onseg) (< (car p1) (car p) (car p2)) (< (car p2) (car p) (car p1)) (< (cadr p1) (cadr p) (cadr p2)) (< (cadr p2) (cadr p) (cadr p1))); p lies between p1 and p2
(if (< theta1 theta2) (<= theta1 theta theta2) (if (< theta theta2) (<= (- theta1 2pi) theta theta2) (<= theta1 theta (+ theta2 2pi)))); theta lies between theta1 and theta2
);a
(setq plist (append plist (list p)))
);i
);f
plist
));i
);d
(defun inters-plist (p1 p2 plist1 onseg / i p p1` p2` plist2) (setq p1` (car plist1)); onplist
(foreach p2` (cdr plist1) (if (numberp p2`) (setq theta p2`) (setq
plist2 (append plist2 (inters-arc p1 p2 p1` p2` theta onseg))
p1` p2` theta nil
)));f
plist2
);d

;Function to Calculate Enclosed Area
(defun Area (plist / Area p0 p1 theta theta1 theta2 a b c r)
(if (/=~ (car plist) (last plist)) (setq plist (append plist (list (car plist))))); plist must be closed
(setq Area 0 p0 (last plist) p1 (car plist) a (distance p0 p1) theta1 (angle p0 p1))
(foreach p2 (cdr plist) (if (numberp p2) (setq theta p2) (progn
(setq b (distance p0 p2) theta2 (angle p0 p2) Area (+ Area (* 0.5 (* a b (sin (- theta2 theta1))))))
(if theta (setq; buldge correction
c (distance p1 p2) r (/ (* 0.5 c) (sin (* 0.5 theta))); r can be negative
Area (+ Area (* 0.5 theta (² r)) (* -0.5 c r (cos (* 0.5 theta)))) theta nil
));i
(setq p1 p2 theta1 theta2 a b)
)));f
(abs Area)
);d

;Function to determine whether a point is inside a region.
(defun inside (p plist / n vp1 p1 p2 thetasum theta) (if (vl-some 'numberp plist)
(progn (setq n 0 p1 (car plist)); intersection test vector, this code was adapted from: http://www.autocode.com/lisp/inout.zip
(setq vp1 (pt (+ (car p) (* 3 (- (xmax plist) (xmin plist)))) (cadr p))); virtual point (assumes this point is outside)
(foreach p2 (cdr plist) (if (numberp p2) (setq theta p2) (progn
(if theta (setq n (+ n (length (inters-arc p vp1 p1 p2 theta T)))) (if (inters p vp1 p1 p2) (setq n (1+ n))))
(setq p1 p2 theta nil)
)));f
(/= (rem n 2) 0); oneofeach
);p
(progn (setq thetasum 0 theta2 (if plist (angle p (last plist)))); no buldges (faster)
(foreach p2 plist (setq theta1 (angle p p2) theta (- theta2 theta1))
(if (> (abs theta) pi) (setq theta (+ theta (* (if (minusp theta) -1 1) 2pi))))
(setq thetasum (+ thetasum theta) theta2 theta1)
);f
(/=~ thetasum 0)
);p
));d

;Draw Arbitrary Demo Polyline
(draw '(
(-37 -29) -1.2 (-33 -32) 3.4 (-28 -29) -2.3 (-25 -24) -2.0 (-19 -34) 3.7 (-12 -36) -1.3
(-7 -26) -3.5 (-5 -34) 4.5 (-3 -36) -2.8 (3 -36) 3.2 (6 -35) -1.2 (11 -20) 3.7 (6 -16)
-1.9 (-8 -19) 2.2 (-13 -21) -3.5 (-20 -19) 3.4 (-29 -16) -3.2 (-38 -14) -1.3 (-24 -1) 4.1
(-28 4) -2.6 (-38 7) -1.8 (-27 16) 3.4 (-27 20) -1.5 (-32 24) -1.2 (-27 33) -3.0 (-21 25)
2.8 (-17 19) -2.6 (-14 15) 1.5 (-13 10) -1.5 (-12 -2) 1.1 (-12 -11) 3.8 (-5 -4) -4.1
(-3 -2) 2.5 (4 -3) -2.9 (10 -6) 4.2 (17 -4) -1.6 (17 2) 3.5 (11 7) -2.7 (2 10) -0.5 (6 20)
-1.9 (14 20) 4.0 (17 25) 0.4 (3 23) 1.1 (-4 14) -2.5 (-6 14) -0.7 (-10 27) 1.4 (-12 30)
-3.5 (-10 34) 1.7 (-3 35) -3.0 (2 33) 2.3 (5 30) -0.5 (18 32) -1.6 (24 25) 4.0 (31 27)
-3.1 (38 35) -0.1 (43 29) -3.8 (39 27) 3.8 (36 26) 0.6 (45 21) -2.5 (46 17) -1.1 (38 17)
1.6 (31 16) -1.4 (22 14) 3.5 (21 12) -2.1 (25 4) 3.8 (32 2) -1.1 (37 13) -2.4 (42 9) -1.3
(38 6) 3.9 (40 2) -4.4 (40 -3) 2.3 (31 -9) 1.8 (36 -11) -2.7 (40 -17) -2.4 (28 -13) 1.4
(24 -9) 1.9 (17 -18) 2.0 (23 -19) -2.2 (25 -21) -2.3 (16 -26) 3.2 (14 -28) 1.0 (24 -29)
0.1 (33 -24) -1.0 (41 -24) -1.8 (42 -29) -2.1 (37 -28) 2.5 (34 -27) 1.9 (38 -33) -4.1
(36 -37) 1.5 (21 -34) -0.9 (-28 -40)
));d
(setq ent (entlast))
(command "zoom" "window" (pt -50 -50) (pt 50 50))
(defun c:inters (/ p1 p2)
(setq p1 (getpoint "\nSpecify first point: ") p2 (getpoint p1 "\nSecond point: "))
(foreach p (inters-plist p1 p2 (getplist ent) T) (circle p 1)); (car (entsel "Select object: "))
);d
(defun c:area2 () (Area (getplist ent))); (car (entsel "Select object: "))
(defun c:inside ()
(prompt (strcat "\nThe point is "
(if (inside (getpoint "\nSpecify a point: ") (getplist ent)) "inside" "outside") "."; (car (entsel "Select object: "))
));p
(princ)
);d