;       
;            <<<<Courtesy of PC-AUG BBS * 602-952-0638 * 24hr *>>>> 
;USAGE:      (load "ARCTARC") COMMAND:ATA
;
;            Copyright (c) 1990 -- Fred Bertagnolli -- Engramme Engr.
;            for PC-AUG BBS. Donation of $15.00 would be appreciated.
;            NOT FOR COMMERCIAL OR BUSINESS USE, OF ANY KIND.
;            For info contact Fred Bertagnolli at 801-621-3634
;
;FUNCTION:   ARCTARC draws a new arc TANGENT to another arc.
;
;INPUTS:     PICK AN EXISTING ARC, NEAR ITS END POINT.
;            CENTRAL ANGLE, in DMS mode
;            <L>EFT or <R>IGHT direction from the old arc's end
;            RADIUS of new arc
;
;            ARCTARC does the rest!  
;
;COMMENTS:   This is a difficult construct with standard methods.
;            Use for COMPOUND, SURVEYOR STYLE, ARCS and the like.
;
(DEFUN C:ATA( / ES AU E PP CTR BA EA CR CA LR RD BP EP API)
(SETVAR "OSMODE" 0)
(SETVAR "FLATLAND" 1)
(SETQ ES (ENTSEL "\nPICK ARC NEAR ARC START :"))
(REDRAW (CAR ES) 3)
(SETQ
 AU (GETVAR "AUNITS")
 E  (ENTGET (CAR ES))
 PP (OSNAP (CADR ES) "NEAR")
 PP (OSNAP PP "END")
 CTR (CDR (ASSOC '10 E))
 BA (CDR (ASSOC '50 E))
 EA (CDR (ASSOC '51 E))
 CR (CDR (ASSOC '40 E))
)
(SETVAR "AUNITS" 1)
(INITGET (+ 1 2 4))
(SETQ CA (GETANGLE "\nCentral Angle <DdMM'SS.sss\042>   :"))
(INITGET 1 "L R")
(SETQ LR (GETKWORD "\nCurve Direction <L>eft or <R>ight :"))
(INITGET (+ 1 2 4))
(SETQ RD (GETDIST "\nRadius :"))
(SETQ BP (POLAR CTR BA CR))
(SETQ EP (POLAR CTR EA CR))
(IF (EQUAL PP BP) (SETQ API (IF (= LR "R") PI 0)))
(IF (EQUAL PP EP) (SETQ API (IF (= LR "R") 0 PI)))
(SETQ CTR (POLAR PP (- (ANGLE CTR PP) API) RD))
(SETVAR "AUNITS" 3)
(IF (= LR "R")(SETQ CA (* -1.0 CA)))
(COMMAND "ARC" PP "C" CTR "A" CA)
(SETVAR "AUNITS" AU)
(REDRAW (CAR ES) 1)
(SETVAR "FLATLAND" 0)
(PRINC)
)