;;;leyla_salman ''HİDRODİZAYN 02.01.2006''
;;;KARELAJ.LSP
;;; istenilen ölçüde Karelaj atma programı

;;;************************************************************
(defun c:kare (/ nok1 nok2 basx basy sonx sony aralik nx ny i j)
(if (not olcek) (setq olcek 1000.0))
(setq eolcek olcek)
(princ (strcat "\nÖlçek <" (rtos eolcek 2 0) "> :"))
(setq olcek (getreal))
(if (not olcek) (setq olcek eolcek))
(princ "\nKarelaj atılacak bölgeyi gösteriniz :")
(setq nok1 (getpoint "\nSol alt köşe :"))
(setq nok2 (getcorner nok1 "\Sağ üst köşe :"))

(setq basx (yuvarla (car nok1) "yukari")
sonx (yuvarla (car nok2) "asagi")
basy (yuvarla (cadr nok1) "yukari")
sony (yuvarla (cadr nok2) "asagi")
aralik (* 100.0 (/ olcek 1000.0))
)
(setq nx (+ (fix (/ (- sonx basx) aralik)) 1)
ny (+ (fix (/ (- sony basy) aralik)) 1)
i 0
j 0
)
(command "undo" "mark")
(repeat nx
(repeat ny
(kareat (list (+ basx (* i aralik))
(+ basy (* j aralik))
)
)
(setq j (+ 1 j))
);_repeat ny
(setq i (+ 1 i) j 0)
);_repeat nx

(setq i 0 carpan (/ olcek 1000.0))
(repeat nx
;;;----- alttaki yarım kelebekler ------------------
(line_ciz (list (+ basx (* i aralik)) (cadr nok1))
(list (+ basx (* i aralik)) (+ (cadr nok1) (* 2.5 carpan)))
"GRID"
)
;;;----- üstteki yarım kelebekler ------------------
(line_ciz (list (+ basx (* i aralik)) (cadr nok2))
(list (+ basx (* i aralik)) (- (cadr nok2) (* 2.5 carpan)))
"GRID"
)
(setq i (1+ i))
);_ repeat nx
(setq i 0)
(repeat ny
;;;----- soldaki yarım kelebekler ------------------
(line_ciz (list (car nok1) (+ basy (* i aralik)))
(list (+ (car nok1) (* 2.5 carpan)) (+ basy (* i aralik)))
"GRID"
)
;;;----- sağdaki yarım kelebekler ------------------
(line_ciz (list (car nok2) (+ basy (* i aralik)))
(list (- (car nok2) (* 2.5 carpan)) (+ basy (* i aralik)))
"GRID"
)
(setq i (1+ i))
);_ repeat ny
);_kare
;;;**************************************************************
(defun c:gyaz( / nokta kyazboy kyazbos carpan dummy)
(if (not olcek) (setq olcek 1000.0))
(if (not kyazboy) (setq kyazboy (getvar "TEXTSIZE")))
(princ (strcat "\nYazı Yüksekliği <" (rtos kyazboy 2 2) "> :"))
(setq dummy (getreal))
(if dummy (setq kyazboy dummy))
(setq kyazbos (/ kyazboy 5) carpan (/ olcek 1000.0))
(setq nokta (getpoint "\nKoordinatı yazılacak noktayı gösteriniz :"))
(command "TEXT" "J" "MR"
(list (- (car nokta) (* carpan (+ 2 kyazbos))) (cadr nokta))
kyazboy
0.0
(rtos (cadr nokta) 2 0)
)
(command "TEXT" "J" "ML"
(list (car nokta) (- (cadr nokta) (* carpan (+ 2 kyazbos))))
kyazboy
270.0
(rtos (car nokta) 2 0)
)
);_gyaz
;;;*******************************************************
;;;*******************************************************
(defun c:kyaz( / nok kyazboy kyazbos carpan dummy)
(if (not olcek) (setq olcek 1000.0))

(if (not kyazboy) (setq kyazboy (getvar "TEXTSIZE")))
(princ (strcat "\nYazı Yüksekliği <" (rtos kyazboy 2 2) "> :"))
(setq dummy (getreal))
(if dummy (setq kyazboy dummy))

(setq kyazbos (/ kyazboy 5) carpan (/ olcek 1000.0))
(setq nok (getpoint "\nKoordinatı yazılacak noktayı gösteriniz :"))
(command "undo" "begin")
(setvar "osmode" 0)
(setq nokx (car nok)
noky (cadr nok)
kyazbos (* kyazbos carpan)
)
(setq yer (getpoint nok "\nYazının konacağı yeri gösteriniz :"))
(setq yerx (car yer)
yery (cadr yer)
)
(setvar "cmdecho" 0)
(line_ciz nok yer (getvar "CLAYER"))
(if (< yerx nokx)
(setq son (list (- yerx (* 7 kyazboy)) yery))
(setq son (list (+ yerx (* 7 kyazboy)) yery))
)
(line_ciz yer son (getvar "CLAYER"))
(setq sonx (car son)
sony (cadr son)
)
(if (< yerx nokx)
(progn
(command "TEXT"
"J"
"BR"
(list yerx yery)
kyazboy
0.0
(rtos nokx 2 2)
)
(command "TEXT"
"J"
"TR"
(list yerx (- yery kyazbos))
kyazboy
0.0
(rtos noky 2 2)
)
)
(progn
(command "TEXT"
"J"
"BR"
(list sonx sony)
kyazboy
0.0
(rtos nokx 2 2)
)
(command "TEXT"
"J"
"TR"
(list sonx (- sony kyazbos))
kyazboy
0.0
(rtos noky 2 2)
)
)
)
(setvar "OSMODE" 1)
(command "undo" "end")
(setvar "cmdecho" 1)

);_kyaz
;;;********************************************************
(defun yuvarla(sayi yon / carpan sonuc)
(setq carpan (/ olcek 1000.0))
(setq sonuc (* (fix (/ sayi (* 100.0 carpan))) (* 100.0 carpan)))
(if (= yon "yukari") (+ sonuc (* 100 carpan)) sonuc)
);
;;;---------------------------------------------------------------------------------
;;;(defun kareat(nokta / carpan)
;;; (setq carpan (/ olcek 1000.0))
;;; (line_ciz (list (- (car nokta) (* 2.5 carpan)) (cadr nokta))
;;; (list (+ (car nokta) (* 2.5 carpan)) (cadr nokta))
;;; "GRID"
;;; )
;;; (line_ciz (list (car nokta) (- (cadr nokta) (* 2.5 carpan)))
;;; (list (car nokta) (+ (cadr nokta) (* 2.5 carpan)))
;;; "GRID"
;;; )
;;;)
;;;-----------------------------------------------------------------------------------
(defun kareat(nokta / carpan)
(setq carpan (/ olcek 1000.0))

;;;--------- büyük çizgiler
(line_ciz (list (- (car nokta) (* 2.5 carpan)) (cadr nokta)) ;;;sol yatay çizgi
(list (- (car nokta) (* 0.5 carpan)) (cadr nokta))
"GRID"
)
(line_ciz (list (+ (car nokta) (* 0.5 carpan)) (cadr nokta));;;sağ yatay çizgi
(list (+ (car nokta) (* 2.5 carpan)) (cadr nokta))
"GRID"
)

(line_ciz (list (car nokta) (- (cadr nokta) (* 2.5 carpan)));;;alt düşey çizgi
(list (car nokta) (- (cadr nokta) (* 0.5 carpan)))
"GRID"
)
(line_ciz (list (car nokta) (+ (cadr nokta) (* 0.5 carpan)));;;üst düşey çizgi
(list (car nokta) (+ (cadr nokta) (* 2.5 carpan)))
"GRID"

)
;;;--------- küçük çizgiler
(line_ciz (list (- (car nokta) (* 0.1 carpan)) (cadr nokta))
(list (+ (car nokta) (* 0.1 carpan)) (cadr nokta))
"GRID"
)
(line_ciz (list (car nokta) (- (cadr nokta) (* 0.1 carpan)))
(list (car nokta) (+ (cadr nokta) (* 0.1 carpan)))
"GRID"
)


)
;;;-----------------------------------------------------------------------------------

(defun line_ciz(bas son lyr / elist)
(setq elist (list (cons 0 "LINE")
(cons 8 lyr)
(cons 10 bas)
(cons 11 son)
)
)
(entmake elist)
);_line_ciz
;;;------------------------------------------------------------------------------------------------------
(setq stylelist (tblsearch "style" (getvar "TEXTSTYLE")))
(if (/= (cdr (assoc 40 stylelist)) 0.0)
(command "-STYLE" "" "" 0.0 "" "" "" "")
)
(princ "\nKARELAJ.LSP Yüklendi. LEYLA_SALMAN")
(princ "\n[KARE] : Karelaj at - [KYAZ] : gösterilen noktaya, [GYAZ] : Gride koord. yaz")
(princ)