;;; civata.lsp
;;; www.autocadokulu.com
;;; Civata + Somun Cizimi

(defun dtr (a)
(* pi (/ a 180.00))
)

(defun zoom_to ()
(setq top (polar pt (dtr 45) l ))
(setq bot (polar pt (dtr 225) (/ l 2)))
(command "zoom" "w" top bot )
)

(defun headface ()
(setq f (- d 0.025))
(setq dist1 (/ (- head_dia f) 2))
(setq pt27 (polar pt8 0 dist1))
(setq pt28 (polar pt7 (dtr 180) dist1))
(setq pt29 (polar pt9 0 dist1))
(setq pt30 (polar pt10 (dtr 180) dist1))
(command "line" pt29 pt27 "")
(command "line" pt30 pt28 "")
(setq pt31a (polar pt9 0 (/ DIST1 2)))
(SETQ pt31 (polar pt31a (dtr 90) (float (/ head_thick 10))))
(setq pt32a (polar pt2 (dtr 90) head_thick))
(setq pt32 (polar pt32a (dtr 90) (float (/ head_thick 10))))
(setq pt33a (polar pt30 0 (/ dist1 2)))
(setq pt33 (polar pt33a (dtr 90) (float (/ head_thick 10))))
(command "arc" pt29 pt31 pt9)
(setq e10 (entlast))
(command "arc" pt30 pt32 pt29)
(setq e11 (entlast))
(command "arc" pt10 pt33 pt30)
(setq e11 (entlast))
(command "erase" erase_ent "")
(command "line" pt31 pt33 "")

)
;_________________________________________________________________________
(defun nutface ()
(setq pt18 (polar pt14 0 dist1))
(setq pt17 (polar pt15 0 dist1))
(setq pt19 (polar pt13 pi dist1))
(setq pt20 (polar pt12 pi dist1))
(command "line" pt18 pt17 "")
(command "line" pt19 pt20 "")
(setq pt21a (polar pt15 0 (/ DIST1 2)))
(SETQ pt21 (polar pt21a (dtr 270) (float (/ nut_thick 20))))
(setq pt22 (polar pt11 (dtr 270) (float (/ nut_thick 10))))
(setq pt23a (polar pt20 0 (/ dist1 2)))
(setq pt23 (polar pt23a (dtr 270) (float (/ nut_thick 20))))
(command "arc" pt20 pt23 pt12)
(setq e6 (entlast))
(command "arc" pt17 pt22 pt20)
(setq e8 (entlast))
(command "arc" pt15 pt21 pt17)
(setq e7 (entlast))
(command "explode" ent )
(command "erase" pt11 "")
(setq tpt8 (polar pt11 (dtr 180) (/ d 2)))
(setq tpt9 (polar pt11 0 (/ d 2)))
(command "trim" e6 e7 "" tpt8 tpt9 "")
(command "line" pt21 pt23 "")
(setq dist2 (distance pt21 pt23))
(setq picpt (polar pt21 0 (/ dist2 2)))
(command "trim" e8 "" picpt "")
)
;________________________________________________________________________
(defun chamfers ()
(setq cpt1 (polar pt6 (dtr 90)(/ d 4)))
(setq cpt2 (polar pt6 (dtr 0)(/ d 4)))
(setq cpt3 (polar pt5 (dtr 180)(/ d 4)))
(setq cpt4 (polar pt5 (dtr 90)(/ d 4)))
(command "chamfer" "d" 0.06 0.06)
(command "chamfer" cpt1 cpt2)
(command "chamfer" cpt3 cpt4)
)
;____________________________________________________________________________

(defun trims ()
(setq tpt1 (polar pt11 (dtr 180) (/ d 2)))
(setq tpt2 (polar tpt1 (dtr 90) (/ nut_thick 2)))
(setq tpt3 (polar pt11 0 (- halfdia 0.06) ))
(setq tpt3a (polar tpt3 (dtr 90) (/ nut_thick 2)))
(setq tpt4 (polar pt11 pi (- halfdia 0.06) ))
(setq tpt4a (polar tpt4 (dtr 90) (/ nut_thick 2)))
(setq tpt5 (polar pt11 0 (/ d 2)))
(setq tpt6 (polar tpt5 (dtr 90) (/ nut_thick 2)))
(command "trim" ent "" tpt2 tpt3a tpt4a tpt6 "")
)
;___________________________________________________________________________

(defun hexagon ()
(if (< l 6)
(setq thread_len (+ (* 2 d) 0.25))
(setq thread_len (+ (* 2 d) 0.5))
)
(if (> (* 2 d) l)
(setq thread_len (* 1.5 d))
)
(setq head_dia (* 2 d))
(setq head_thick (* 0.66667 d))
(setq nut_thick (* 0.9 d))

(setq halfdia (/ d 2))
(setq p1 (polar pt 0 (- halfdia 0.06)))
(setq p2 (polar p1 (dtr 90) thread_len))
(setq p3 (polar p2 pi (- d 0.12)))
(setq p4 (polar pt pi (- halfdia 0.06)))
(setq pt2 (polar pt (dtr 90) l))
(setq pt3 (polar pt2 0 (/ d 2)))
(setq pt4 (polar pt2 pi (/ d 2)))
(setq pt5 (polar pt 0 (/ d 2)))
(setq pt6 (polar pt pi (/ d 2)))
(setq pt7 (polar pt2 0 (/ head_dia 2)))
(setq pt8 (polar pt2 pi (/ head_dia 2)))
(setq pt9 (polar pt8 (dtr 90) head_thick))
(setq pt10 (polar pt7 (dtr 90) head_thick))
(command "line" pt3 pt4 "")
(setq e (entlast))
(command "line" pt4 pt6 "")
(setq e1 (entlast))
(command "line" pt6 pt5 "")
(setq e3 (entlast))
(command "line" pt5 pt3 "")
(setq e4 (entlast))
(chamfers)
(setq thpt1 (polar pt6 (dtr 90) 0.06))
(setq thpt2 (polar pt5 (dtr 90) 0.06))
(setq b (cdr (assoc 2 (tblsearch "LAYER" "THREAD"))))
(if (/= b "THREAD")
(command "layer" "n" "thread" "")
)
(command "layer" "c" "red" "thread" "s" "thread" "")
(command "pline" p1 p2 p3 p4 "c")
(setq entit (entlast))
(command "line" thpt1 thpt2 "")
(setvar "clayer" "0")
;_________________________________________________________________________
(setq pt11 (getpoint "
Somunun Dip Merkezini Secin : "))
(setq pt12 (polar pt11 0 (/ head_dia 2)))
(setq pt13 (polar pt12 (dtr 90) nut_thick))
(setq pt14 (polar pt13 pi head_dia))
(setq pt15 (polar pt14 (dtr 270) nut_thick))
(command "line" pt7 pt10 "")
(command "line" pt10 pt9 "")
(setq erase_ent(entlast))
(command "line" pt9 pt8 "")
(command "line" pt8 pt7 "" )
(command "pline" pt12 pt13 pt14 pt15 "c")
(setq ent (entlast))
(setq pt16 (polar pt (dtr 90) (+ l (* 3 head_thick))))
(command "circle" pt16 "d" (* 1.73 d) )
(command "polygon" "6" pt16 "c" (/ (* 1.73 d) 2))
)
;_____________________________________________________________________________
(defun hexagon1 ()
(if (< l 6)
(setq thread_len (+ (* 2 d) 0.25))
(setq thread_len (+ (* 2 d) 0.5))
)
(if (> (* 2 d) l)
(setq thread_len (* 1.5 d))
)
(setq head_dia (* 2 d))
(setq head_thick (* 0.66667 d))
(setq nut_thick (* 0.9 d))

(setq halfdia (/ d 2))
(setq p1 (polar pt 0 (- halfdia 0.06)))
(setq p2 (polar p1 (dtr 90) thread_len))
(setq p3 (polar p2 pi (- d 0.12)))
(setq p4 (polar pt pi (- halfdia 0.06)))
(setq pt2 (polar pt (dtr 90) l))
(setq pt3 (polar pt2 0 (/ d 2)))
(setq pt4 (polar pt2 pi (/ d 2)))
(setq pt5 (polar pt 0 (/ d 2)))
(setq pt6 (polar pt pi (/ d 2)))
(setq pt7 (polar pt2 0 (/ head_dia 2)))
(setq pt8 (polar pt2 pi (/ head_dia 2)))
(setq pt9 (polar pt8 (dtr 90) head_thick))
(setq pt10 (polar pt7 (dtr 90) head_thick))
(command "line" pt3 pt4 "")
(setq e (entlast))
(command "line" pt4 pt6 "")
(setq e1 (entlast))
(command "line" pt6 pt5 "")
(setq e3 (entlast))
(command "line" pt5 pt3 "")
(setq e4 (entlast))
(chamfers)
(setq pt12 (polar pt11 0 (/ head_dia 2)))
(setq pt13 (polar pt12 (dtr 90) nut_thick))
(setq pt14 (polar pt13 pi head_dia))
(setq pt15 (polar pt14 (dtr 270) nut_thick))
(setq thpt1 (polar pt6 (dtr 90) 0.06))
(setq thpt2 (polar pt5 (dtr 90) 0.06))
(command "line" pt7 pt10 "")
(command "line" pt10 pt9 "")
(setq erase_ent(entlast))
(command "line" pt9 pt8 "")
(command "line" pt8 pt7 "" )
(setq b (cdr (assoc 2 (tblsearch "LAYER" "THREAD"))))
(if (/= b "THREAD")
(command "layer" "n" "thread" "")
)
(command "layer" "c" "red" "thread" "s" "thread" "")
(command "pline" p1 p2 p3 p4 "c")
(setq entit (entlast))
(command "line" thpt1 thpt2 "")
(setq dis (distance thpt1 thpt2))
(setq cut (polar thpt1 0 (/ dis 2)))

(setvar "clayer" "0")
(setq pt16 (polar pt (dtr 90) (+ l (* 3 head_thick))))
(command "circle" pt16 "d" (* 1.73 d) )
(command "polygon" "6" pt16 "c" (/ (* 1.73 d) 2))
)

;____________________________________________________________________________
(defun C:civata ()
(setvar "cmdecho" 0)
(setq snaps (getvar "snap"))
(setq l (getdist "
Civata Uzunlugunu giriniz : "))
(setq d (getdist "
Civata Capini Giriniz : "))
(setq new_snap (/ d 2))
(command "snap" new_snap)
(setq pt (getpoint "
Civata Merkezini Giriniz : "))
(zoom_to)
(initget 1 "E e h H")
(setq answer (getkword "
Somun Istiyormusunuz (e/h): "))
(if (= answer "E")
(progn
(hexagon)
(trims)
(headface)
(nutface)
(command "zoom" "p")
)
(progn
(hexagon1)
(headface)
(command "zoom" "p")
)
)
(princ)
)
(PRINC "--> 'www.autocadokulu.com' Çizim yardımları yüklendi !")
(princ " Komutu calistirmak icin CIVATA yazin :")