;***********************************************
;
;    Burç çizim lispi 2009  v. 1.0
;
;        powered by yazgunesi                 
;       www.autocadokulu.com
;
; **********************************************

; ilk önce DTR fonkisonunu tanımlayalım

(defun dtr (x)
  (* pi (/ x 180.0 ))
)
(princ)

; **************************************************

(defun c:brc ()

(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)

   ; kullanıcıdan bilgi alalım
 
        (setq dcp (getreal "\n Burç dış çap ? :"))
        (setq iccap (getreal "\n Burç iç çapı ? :"))
        (setq by1 (getreal "\n Burç boyu ? :"))
        (setq ftcap (getreal "\n Fatura çapı ? :"))
        (setq ftboy  (getreal "\n Fatura boyu ? :"))
        (setq yr1 (getpoint "\n Yerlestirme noktasi ? :"))

;  yan görünüş yeri kordinat hesabı ...

        (setq yr2x (/ by1 1.2))
 
        (setq msf1 (+(+ yr2x by1)(/ dcp 2)))
     
        (setq yr2 (polar yr1(dtr 180)(- msf1)))

        (setq yr1x (list(+(car yr1)by1)(cadr yr1)))

;  kordinat hesabı ön görünüş için ...

       ; (setq cpp (/(- dcp ftcap)2))
        (setq cpp (/ ftcap 2))
        (setq cpr (/ dcp 2))      
        (setq cpg (- by1 ftboy))
(setq ft1 (/ ftcap 2))

       (setq a1 (list(car yr1)(-(cadr yr1)cpr)))(terpri)
       (setq a2 (list(car yr1)(+(cadr yr1)cpr)))(terpri)

       (setq a3 (list(+(car a1)cpg)(cadr a1))) (terpri)
       (setq a4 (list(+(car a1)cpg)(cadr a2))) (terpri)

       (setq a5 (list(car a3)(-(cadr yr1)cpp))) (terpri)
       (setq a6 (list(car a4)(+(cadr yr1)cpp))) (terpri)

       (setq a7 (list(+(car a5)ftboy)(cadr a5))) (terpri)
       (setq a8 (list(+(car a6)ftboy)(cadr a6))) (terpri)

       (setq a9 (list(car yr1)(-(cadr yr1)(/ iccap 2)))) (terpri)
       (setq a10 (list(car yr1)(+(cadr yr1)(/ iccap 2)))) (terpri)
     
       (setq a11 (list(+(car a9)by1)(cadr a9))) (terpri)
       (setq a12 (list(+(car a10)by1)(cadr a10)))(terpri)

  ;  yan görünüş eksen çizgileri kordinat hesabı
       (setq a13 (list(car yr2)(-(cadr yr2)(/ dcp 2)))) (terpri)
       (setq a14 (list(car yr2)(+(cadr yr2)(/ dcp 2)))) (terpri)
       (setq a15 (list(-(car yr2)(/ dcp 2))(cadr yr2))) (terpri)
       (setq a16 (list(+(car yr2)(/ dcp 2))(cadr yr2))) (terpri)
 

;  sıra çizimde

       (command  "line"  a1 a2 a4 a6 a8 a7 a5 a3 a1 "" )

       (command  "line"  a9 a11 ""
                 "change" "l" "" "p" "lt" "hidden" "c" "2" ""
                 "line"  a10 a12 ""
                 "change" "l" "" "p" "lt" "hidden" "c" "2" "" )

;  orta eksen çizgisi çizimi ön görünüşte olan..

       (command  "line"  yr1 yr1x ""
                 "change" "l" "" "p" "lt" "center" "c" "3" "" )

;  yan görünüş daireler çizimi

  (command  "circle"  yr2 "d" dcp "")
  (command  "circle"  yr2 "d" iccap "")

  (command  "circle"  yr2 "d" ftcap ""
            "change" "l" "" "p" "lt" "hidden" "c" "2" "" )

;  yan görünüş eksen çizgileri çizimi
           
  (command  "line"  a15 a16  ""
            "change" "l" "" "p" "lt" "center" "c" "3" ""   
            "line"  a13 a14  ""
            "change" "l" "" "p" "lt" "center" "c" "3" "" )

(princ)
(setvar "osmode" oldsnap)
) ; program bittmiştir.
       
(Princ "Lisp'i çalıştırmak için > brc < yazınız!  >>> www.autocadokulu.com <<<  " )