;************************************
;
;      ORİNG LİSPİ ANA PROGRAM
;
;        powered by yazgunesi                 
;       www.autocadokulu.com
;
;
; ***********************************

(defun c:org ()
 
(prompt " %% ?! %% Çizim seçeneğini tercih ediniz !!! %% ?! %% ")
(setq secim (getstring "\n ORİNG NASIL ÇİZİLSİN ?! >>> Normal // Kesitli görünüş < n / k > :"))      

       (cond ; cond start satırı
           ((= secim "n" ) (c:nroring))
        ) ; cond bitiş satırı
 
        (cond ; cond start satırı
           ((= secim "nn" ) (c:nroring))
        ) ; cond bitiş satırı
 
          (cond ; cond start satırı
           ((= secim "N" ) (c:nroring))
        ) ; cond bitiş satırı

          (cond ; cond start satırı
           ((= secim "m" ) (c:nroring))
        ) ; cond bitiş satırı
 
           (cond ; cond start satırı
           ((= secim "b" ) (c:nroring))
        ) ; cond bitiş satırı

        (cond ; cond start satırı
           ((= secim "k" ) (c:ksoring))
        ) ; cond bitiş satırı
 
        (cond ; cond start satırı
           ((= secim "kk" ) (c:ksoring))
        ) ; cond bitiş satırı
 
        (cond ; cond start satırı
           ((= secim "K" ) (c:ksoring))
        ) ; cond bitiş satırı

        (cond ; cond start satırı
           ((= secim "KK" ) (c:ksoring))
        ) ; cond bitiş satırı

        (cond ; cond start satırı
           ((= secim "l" ) (c:ksoring))
        ) ; cond bitiş satırı

          (cond ; cond start satırı
           ((= secim "j" ) (c:ksoring))
        ) ; cond bitiş satırı

(princ)  )
(Princ "Lisp'i çalıştırmak için > org < yazınız !  >>> www.autocadokulu.com <<< ")

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

; Oring çizim lispi 2009  v. 1.0
;   kesitli çizim seçeneği


(defun c:ksoring ()

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

        (setq iccap (getreal "\n Oring İÇ ÇAP değeri? :"))
        (setq orgcap (getreal "\n ORİNG'in çapı nedir ? :"))
        (setq yr1 (getpoint "\n Yerlestirme noktasi ? :"))

       (setq yr3 (list(car yr1)(+(cadr yr1)(/ orgcap 2) )))
 
       (setq yr2hsp (/ orgcap 2))
 
       (setq yr2 (list(car yr1)(-(cadr yr1)(/ orgcap 2) )))
 
       (setq yr4hsp (+ iccap orgcap))
 
       (setq yr4 (list(-(car yr1)(/ yr4hsp 2))(car yr1)))
       (setq yr5 (list(+(car yr1)(/ yr4hsp 2))(car yr1)))

       (setq cp2 (list(car yr4)(-(cadr yr4)(/ orgcap 2))))
       (setq cp4 (list(car yr4)(+(cadr yr4)(/ orgcap 2))))
       (setq cp3 (list(+(car yr4)(/ orgcap 2))(cadr yr4)))
       (setq cp1 (list(-(car yr4)(/ orgcap 2))(cadr yr4)))
       (setq cp6 (list(car yr5)(-(cadr yr5)(/ orgcap 2))))
       (setq cp8 (list(car yr5)(+(cadr yr5)(/ orgcap 2))))
       (setq cp7 (list(+(car yr5)(/ orgcap 2))(cadr yr5)))
       (setq cp5 (list(-(car yr5)(/ orgcap 2))(cadr yr5)))

       (setq yr3y (list(+(car cp4)(/ orgcap 2)(/ iccap 2)) (cadr cp4) ))
       (setq yr2y (list(+(car cp2)(/ orgcap 2)(/ iccap 2)) (cadr cp2) ))

        (command  "line"  cp8 cp4 ""
                  "line"  cp6 cp2 "" )
 
        (command  "circle"  yr4 "d" orgcap ""
                  "hatch" "u" "45" "0.5" "n" "l" ""
                  "change" "l" "" "p" "lt" "" "c" "2" "" )
 
        (command  "circle"  yr5 "d" orgcap ""
                  "hatch" "u" "45" "0.5" "n" "l" ""
                  "change" "l" "" "p" "lt" "" "c" "2" "" )

        (command  "line"  cp8 cp6 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp5 cp7 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp1 cp3 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp4 cp2 ""
  "change" "l" "" "p" "lt" "center" "c" "3" "" )
 
   (command  "line"  cp3 cp5 ""
     "change" "l" "" "p" "lt" "center" "c" "3" "" )
 
   (command  "line"  yr2y yr3y ""
     "change" "l" "" "p" "lt" "center" "c" "3" "" )
 
(princ)
(setvar "osmode" oldsnap)
) ; program bittmiştir.
       
;   *******************************

; Oring çizim lispi 2009  v. 1.0
;  normal görünüş çizim seçeneği


(defun c:nroring ()

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

        (setq iccap (getreal "\n Oring İÇ ÇAP değeri? :"))
        (setq orgcap (getreal "\n ORİNG'in çapı nedir ? :"))
        (setq yr1 (getpoint "\n Yerlestirme noktasi ? :"))

       (setq yr3 (list(car yr1)(+(cadr yr1)(/ orgcap 2) )))
 
       (setq yr2hsp (/ orgcap 2))
 
       (setq yr2 (list(car yr1)(-(cadr yr1)(/ orgcap 2) )))
 
       (setq yr4hsp (+ iccap orgcap))
 
       (setq yr4 (list(-(car yr1)(/ yr4hsp 2))(car yr1)))
       (setq yr5 (list(+(car yr1)(/ yr4hsp 2))(car yr1)))

       (setq cp2 (list(car yr4)(-(cadr yr4)(/ orgcap 2))))
       (setq cp4 (list(car yr4)(+(cadr yr4)(/ orgcap 2))))
       (setq cp3 (list(+(car yr4)(/ orgcap 2))(cadr yr4)))
       (setq cp1 (list(-(car yr4)(/ orgcap 2))(cadr yr4)))

       (setq cp6 (list(car yr5)(-(cadr yr5)(/ orgcap 2))))
       (setq cp8 (list(car yr5)(+(cadr yr5)(/ orgcap 2))))
       (setq cp7 (list(+(car yr5)(/ orgcap 2))(cadr yr5)))
       (setq cp5 (list(-(car yr5)(/ orgcap 2))(cadr yr5)))

       (setq yr3y (list(+(car cp4)(/ orgcap 2)(/ iccap 2)) (cadr cp4) ))
       (setq yr2y (list(+(car cp2)(/ orgcap 2)(/ iccap 2)) (cadr cp2) ))

        (command  "line"  cp8 cp4 ""
                  "line"  cp6 cp2 "" )

         (command  "arc"  cp8 cp7 cp6  )
         (command  "arc"  cp6 cp5 cp8 ""
                    "change" "l" "" "p" "lt" "hidden" "c" "2" "" )
 
         (command  "arc"  cp4 cp1 cp2   )
         (command  "arc"  cp2 cp3 cp4 ""
                  "change" "l" "" "p" "lt" "hidden" "c" "2" "" )
 
         (command  "line"  cp8 cp6 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp5 cp7 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp1 cp3 ""
  "change" "l" "" "p" "lt" "center" "c" "3" ""
                  "line"  cp4 cp2 ""
  "change" "l" "" "p" "lt" "center" "c" "3" "" )

   (command  "line"  cp3 cp5 ""
     "change" "l" "" "p" "lt" "center" "c" "3" "" )
 
   (command  "line"  yr2y yr3y ""
     "change" "l" "" "p" "lt" "center" "c" "3" "" )
 
(princ)
(setvar "osmode" oldsnap)
) ; program bittmiştir.