; ***********************************
;
;                Kare flanş lispi
;   malzeme cinsi soğuk / sıcak çekme lama ...
;
;         yazgunesi02@gmail.com                   
;          www.autocadokulu.com
;
; ************************************


(defun c:krflans (/ i1 fl_en gg fk)

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

; kullanıcıdan bilgi alalım
 
(setq i1 (getpoint "\n Yerlestirme noktasi :"))
(setq fl_en (getreal "\n Flanş eni ? :"))
(setq gg (getreal "\n Flanş yüksekliği ? :"))
(setq fk  (getreal "\n Lama kaçlık ? (Lama Genişliği) : "))
 
(setq a2a (- gg fk)) 
(setq i2en1 (* fk 2))
(setq i2en2 (- fl_en i2en1))

(setq a1 (list(car i1)(+(cadr i1) gg)))
(setq i2 (list(car i1)(+(cadr i1) fk)))
(setq a2x (list(car i1) (+ (cadr i1) a2a)))

(setq a2(list(-(car i1)(/ fl_en 2))(cadr i1)))
(setq a3(list(car a2)(cadr a1)))
(setq a4(list(+(car i1)(/ fl_en 2))(cadr i1)))
(setq a5(list(car a4)(cadr a3)))

(setq a6(list(-(car i2)(/ i2en2 2))(cadr i2)))
(setq a7(list(car a6)(cadr a2x)))
(setq a8(list(+(car i2)(/ i2en2 2))(cadr i2)))
(setq a9(list(car a8)(cadr a7)))

(setq a10(list(-(car i2)(/ fl_en 2))(cadr i2)))
(setq a11(list(car a10)(cadr a2x)))
(setq a12(list(+(car i2)(/ fl_en 2))(cadr i2)))
(setq a13(list(car a12)(cadr a11)))

; çizime başlayalım..

(command "line" a2 a3 a5 a4 a2 ""
  "line" a6 a7 ""
  "line" a8 a9 ""
          "line" a10 a12 ""
  "line" a11 a13 ""
) ; çizim işlemi biti..
 
(setvar "OSMODE" oldsnap)
(princ)
) ; program bittmiştir.

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