; TRANFL.LSP   [Article Figure 1]   (c)1990, Gary Lewis

; ********************** TRANFL.LSP ***************************
; Copyright (c) Gary Lewis 1990
;______________________________________________________________
(defun TRAN_INPUT ()
   (setq
     C (getpoint "\nEnter center point of circle X,Y,Z: ")
     R (getreal  "\nEnter radius of circle: "))
   (command "CIRCLE" C R )
   (prompt "\nEnter 4 counterclockwise points... ")
   (setq
     P1 (getpoint "\nEnter 1st point X,Y,Z: ")
     P2 (getpoint "\nEnter 2nd point X,Y,Z: ")
     P3 (getpoint "\nEnter 3rd point X,Y,Z: ")
     P4 (getpoint "\nEnter 4th point X,Y,Z: "))
)
;______________________________________________________________
(defun TRAN_DRAW () ;draw transition
  (setq PCX (car C) PCY (cadr C) PCZ (caddr C)
    V1 (- (angle P1 P2) (/ PI 2))
    V2 (- (angle P2 P3) (/ PI 2))
    V3 (- (angle P3 P4) (/ PI 2))
    V4 (- (angle P4 P1) (/ PI 2))
    C1 (polar C V1 R) C2 (polar C V2 R)
    C3 (polar C V3 R) C4 (polar C V4 R)
    A1 (- PI (- (angle P1 P4) (angle P1 P2)))
    A2 (- PI (- (angle P2 P1) (angle P2 P3)))
    A3 (- PI (- (angle P2 P3) (angle P4 P3)))
    A4 (- PI (- (angle P3 P4) (angle P1 P4))))
  (command "LINE" P1 P2 P3 P4 P1 C1 P2 C2 P3 C3 P4 C4 P1 ^C)
)
;______________________________________________________________
(defun FLAT () ;true length
  (setq L12  (distance P1 P2) L23  (distance P2 P3)
    L34  (distance P3 P4) L41  (distance P4 P1)
    LC11 (distance C1 P1) LC12 (distance C1 P2)
    LC22 (distance C2 P2) LC23 (distance C2 P3)
    LC33 (distance C3 P3) LC34 (distance C3 P4)
    LC44 (distance C4 P4) LC41 (distance C4 P1))
)
;______________________________________________________________
(defun QXRAD ()   ;find swept rad for 4 points
  (setq PQZ (caddr P1) PG P1 S A1)
  (Q_RAD)
  (setq Q1 QG CON1 CONG E1 EG PQZ (caddr P2) PG P2 S A2)
  (Q_RAD)
  (setq Q2 QG CON2 CONG E2 EG PQZ (caddr P3) PG P3 S A3)
  (Q_RAD)
  (setq Q3 QG CON3 CONG E3 EG PQZ (caddr P4) PG P4 S A4)
  (Q_RAD)
  (setq Q4 QG CON4 CONG E4 EG)
)
;______________________________________________________________
(defun Q_RAD ()  ;swept rad
  (setq Z (abs(- PCZ PQZ)) K (list PCX PCY PQZ)
    A (distance PG K )     B (- A R)
    X (abs B)              Y 0.0000001
  )
 (if (< X Y)              ;to prevent division by zero
   (progn
      (setq QG 1E+10)     ;QG would approach infinity
      (setq EG (* S R))   ;arc would become straight line
      (setq CONG -1)
   )
   (progn
     (if (> B 0)
       (progn
         (setq D1 (* (/ A (abs B)) Z))
         (setq QG (sqrt (+(expt R 2) (expt (- D1 Z) 2))))
         (setq CONG 1)
       )
       (progn
         (setq D2(/ (* (+ A (abs B)) Z) B))
         (setq QG (sqrt (+ (expt R 2) (expt D2 2))))
         (setq CONG -1)
       )
     )
     (setq EG (* (sin (/ (* S R) 2. QG)) 2. QG)) ;chord length
   )
 )
)
;______________________________________________________________
(defun TRI_CAL () ;cosine law
  (setq ANG-1 (angle G2 G1)
    COSA (/ (- (+ (expt BG 2)(expt CG 2))(expt AG 2)) 2. BG CG)
    ANG (+ (abs(atan(/(sqrt (- 1. (expt COSA 2)))COSA))) ANG-1)
    G3 (polar G2 ANG CG))
)
;______________________________________________________________
(defun DFLAT ()
  (setq G1 (getpoint "\nPick start point for flat layout ")
        G2 (list (+ (car G1) L12) (cadr G1))
        F1 G1 F2 G2 BG L12 CG LC12 AG LC11)
  (TRI_CAL)
  (setq FC1 G3 G1 FC1  AG E2   CG LC22 BG LC12)
  (TRI_CAL)
  (setq FC2 G3 G1 G3   BG LC22 AG LC23 CG L23)
  (TRI_CAL)
  (setq F3  G3 G2 G3   CG LC33 AG E3   BG LC23)
  (TRI_CAL)
  (setq FC3 G3 AG LC34 CG L34  G1 G3   BG LC33)
  (TRI_CAL)
  (setq F4  G3 G2 G3   AG E4   BG LC34 CG LC44)
  (TRI_CAL)
  (setq FC4 G3 G1 G3   AG LC41 BG LC44 CG L41)
  (TRI_CAL)
  (setq F5  G3 G2 G3   AG E1   BG LC41 CG LC11)
  (TRI_CAL)
  (setq FC5 G3)
  (command "LINE" F5 F4 F3 F2 F1 FC1 F2 FC2 F3 FC3 F4 FC4
    F5 FC5 ^C)
  (setq AP1 FC2 AP2 FC1 AR Q2 CON CON2)
  (ARCG)
  (setq AP1 FC3 AP2 FC2 AR Q3 CON CON3)
  (ARCG)
  (setq AP1 FC4 AP2 FC3 AR Q4 CON CON4)
  (ARCG)
  (setq AP1 FC5 AP2 FC4 AR Q1 CON CON1)
  (ARCG)
)
;______________________________________________________________
(defun ARCG ()    ;draw arcs concave or convex
  (if (> CON 0)
      (command "ARC" AP1 "E" AP2 "R" AR )
      (command "ARC" AP2 "E" AP1 "R" AR )
  )
)
;______________________________________________________________
(defun C:TRAN ()  ;main program
   (TRAN_INPUT)
   (setq SBLIP (getvar "BLIPMODE") SCMDE (getvar "CMDECHO"))
   (setvar "BLIPMODE" 0) (setvar "CMDECHO" 1)
   (TRAN_DRAW)
   (setvar "BLIPMODE" SBLIP) (setvar "CMDECHO" SCMDE)
   (FLAT) (QXRAD)
   (prompt "Find a clear space on drawing then type (dflat): ")
)