Tangent Line From an Arc

Here’s a great LISP that should be incorporated with AutoCAD. After drawing an arc, we should be able to easily draw a line that is tangent from the arc. Well… until then here;s how…

(Written by Alan JT found @ the swamp.org)

~enjoy

(defun c:TLA (/ *error* ent arc)

;; draw Tangent Line from selected Arc's endpoint

;; Required subroutines: AT:GetSel

;; Alan J. Thompson, 12.14.10

(vl-load-com)

(defun *error* (msg)

(and (eq 4 (length ent)) arc (entdel (car arc)))

(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))

(princ (strcat "\nError: " msg))

)

)

(if (setq ent (AT:GetSel nentselp

"\nSelect arc from which to draw tangent line: "

(lambda (x) (eq "ARC" (cdr (assoc 0 (entget (car x))))))

)

)

(progn

(if (eq 4 (length ent))

(vla-transformby

(vlax-ename->vla-object (car (setq arc (list (entmakex (entget (car ent))) (cadr ent)))))

(vlax-tmatrix (caddr ent))

)

(setq arc ent)

)

((lambda (points _dist _angle _angtos / ang pnt)

(if (< (_dist (cadr arc) (car points)) (_dist (cadr arc) (cadr points)))

(setq ang (_angtos (+ (/ pi 2.) (_angle (cdr (assoc 50 (entget (car arc)))))))

pnt (car points)

)

(setq ang (_angtos (+ (/ pi 2.) (_angle (cdr (assoc 51 (entget (car arc)))))))

pnt (cadr points)

)

)

(vl-cmdf "_.line" "_non" pnt (strcat "<" ang) PAUSE)

)

(mapcar (function (lambda (p) (trans p 0 1)))

(list (vlax-curve-getStartPoint (car arc)) (vlax-curve-getEndPoint (car arc)))

)

(lambda (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

(lambda (a)

(if (zerop (getvar 'WORLDUCS))

(- a (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T)))

a

)

)

(lambda (a) (angtos a (getvar 'aunits) 16))

)

)

)

(*error* nil)

(princ)

)

(defun AT:GetSel (meth msg fnc / ent good)

;; meth - selection method (entsel, nentsel, nentselp)

;; msg - message to display (nil for default)

;; fnc - optional function to apply to selected object

;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))

;; Alan J. Thompson, 05.25.10

(setvar 'errno 0)

(while (not good)

(setq ent (meth (cond (msg)

("\nSelect object: ")

)

)

)

(cond

((vl-consp ent)

(setq good (cond ((or (not fnc) (fnc ent)) ent)

((prompt "\nInvalid object!"))

)

)

)

((eq (type ent) 'STR) (setq good ent))

((setq good (eq 52 (getvar 'errno))) nil)

((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))

)

)

)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, TIPS. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s