;========================================================================
;3-teiliger Bogen nach Diplomarbeit J”rg Lechner TU Bergakademie Freiberg
;Autor: Mahler     Stand: 23.07.97 22:02
;       Anpassung an R14: 18.01.98 11:33
;ACHTUNG: Zugriff auf GrfTool.Lsp erforderlich
;=========================================================================
(defun c:b3()
 (setvar "cmdecho" 0)
 (setq tangent nil)  ; wenn nicht nil -> Tangenten werden in Cutter gezeichnet
 (setq gwein 17.5) ;Einfahrwinkel in Gon
 (setq gwaus 22.5) ;Ausfahrwinkel in Gon
 (load"grftool")
 (load"myPoly")
 (command "_osnap" "_nea")
 (setq liein (get_linie "Zeige Einfahrtangente:"))
 (setq liaus (get_linie "Zeige Ausfahrtangente:"))
 (command "_osnap" "_non")

 (setq rr2 (getreal " Hauptbogenradius R2: "))

 (setq rr1 (* rr2 2)) ;Einfahrradius 2xHauptradius
 (setq rr3 (* rr2 3)) ;Ausfahrradius 3xHauptradius
 (setq wein (* (/ gwein 200) pi)) ;Umrechnen in Bogenmaá
 (setq waus (* (/ gwaus 200) pi))
 (setq tesin (sin wein))
 (setq tecos (cos wein))
 (setq tasin (sin waus))
 (setq tacos (cos waus))
 (setq pi2 (/ pi 2))
; Tangentenschnittpunkt und Winkel ermitteln
 (setq ps (inters (car liein) (cadr liein) (car liaus) (cadr liaus) nil))
 (setq ww1 (angle ps (caddr liein)))
 (setq ww2 (angle ps (caddr liaus)))

 (if Tangent
  (progn
   (command "_layer" "ma" "cutter" "")
   (command "_color" "_blue")
   (command "_line" (car liein) ps "")
   (command "_color" "_green")
   (command "_line" ps (car liaus) "")
   (command "_color" "_ByLayer")
  )
 )

 (setq w1 (angle ps (car liein)))
 (if (= w1 0) (setq w1 (angle ps (cadr liein))) )
 (if (> (abs (- ww1 w1)) pi2)
  (progn
   (setq ds (abs (- (sin ww1) (sin w1))))
   (setq dc (abs (- (cos ww1) (cos w1))))
   (if (> (+ ds dc) 0.5)(setq w1 (+ w1 pi)))
  )
 )

 (setq w2 (angle ps (car liaus)))
 (if (= w2 0) (setq w2 (angle ps (cadr liaus))) )
 (if (> (abs (- ww2 w2)) pi2)
  (progn
   (setq ds (abs (- (sin ww2) (sin w2))))
   (setq dc (abs (- (cos ww2) (cos w2))))
   (if (> (+ ds dc) 0.5)(setq w2 (+ w2 pi)))
  )
 )

 (setq walp (- w2 w1))

 (if (< walp 0)
  (if (< (abs walp) pi)(setq links T) (setq links nil))
  (if (> walp pi) (setq links T) (setq links nil))
 )
 (if (< walp 0) (setq walp (+ (* 2 pi) walp)) )
 (if (> walp pi) (setq walp (- (* 2 pi) walp )) )

;der nicht eingeschlossene Winkel
 (setq walp (- pi walp))

 (setq walp2 (/ walp 2))
 (setq tanal2 (/ (sin walp2) (cos walp2)))

 (setq te1 (+ tesin (* (- 2 tecos) tanal2)))
 (setq ta1 (+ (* 2 tasin) (* (- 3 (* 2 tacos)) tanal2)) )
 (setq t2 (/ (+ 1 tecos (* -2 tacos)) (sin walp)) )
 (setq tein (* (+ te1 t2) rr2))
 (setq taus (* (- ta1 t2) rr2))

 (setq pb1 (polar ps w1 tein))
 (setq pb4 (polar ps w2 taus))

;Einfahrtangente
 (setq pm1 (polar pb1 (+ w1 pi2) rr1))
 (setq p (polar pb1 (- w1 pi2) rr1))
;Test ob richtige Seite
 (setq de1 (distance pm1 pb4))
 (setq de2 (distance p pb4))
 (setq x1 (* rr1 tesin))
 (setq y1 (* rr1 (- 1 tecos)))
 (setq pb (polar pb1 (- w1 pi) x1))
 (if (< de2 de1)
  (progn
   (setq pm1 p)
   (setq pb2 (polar pb (- w1 pi2) y1))
  )
  (setq pb2 (polar pb (+ w1 pi2) y1))
 )

;Ausfahrtangente
 (setq pm3 (polar pb4 (+ w2 pi2) rr3))
 (setq p (polar pb4 (- w2 pi2) rr3))
;Test ob richtige Seite
 (setq de1 (distance pm3 pb1))
 (setq de2 (distance p pb1))
 (setq x2 (* rr3 tasin))
 (setq y2 (* rr3 (- 1 tacos)))
 (setq pb (polar pb4 (- w2 pi) x2))
 (if (< de2 de1)
  (progn
   (setq pm3 p)
   (setq pb3 (polar pb (- w2 pi2) y2))
  )
  (setq pb3 (polar pb (+ w2 pi2) y2))
 )
 (setq pm2 (inters pb2 pm1 pb3 pm3))

 (setq puli (list pb1 pb2 pb3 pb4))

 (if links
  (progn
   (setq ruli (list (get_ru (angle pm1 pb1) (angle pm1 pb2))))
   (setq ruli (append ruli (list (get_ru (angle pm2 pb2) (angle pm2 pb3)))))
   (setq ruli (append ruli (list (get_ru (angle pm3 pb3) (angle pm3 pb4)))))
  )
  (progn
   (setq puli (reverse puli))
   (setq ruli (list (get_ru (angle pm3 pb4) (angle pm3 pb3))))
   (setq ruli (append ruli (list (get_ru (angle pm2 pb3) (angle pm2 pb2)))))
   (setq ruli (append ruli (list (get_ru (angle pm1 pb2) (angle pm1 pb1)))))
  )
 )

 (machpoly puli ruli nil)
 (setvar "cmdecho" 1)
 (princ)
)

(defun gw (ww)
 (* (/ ww pi) 180)
)