karolaj : dialog {
  label = "**** KaRoLaj ****";
  : boxed_column {
    label = "";
    : boxed_row {
      label = "Karolaj Aralıkları (Units)";
      fixed_width = true;
      : edit_box {
        label = "X Aralığı:";
        key = "krx";
        mnemonic = "X";
        edit_width = 5; }
      spacer;
      : edit_box {
        label = "        Y Aralığı:";
        key = "kry";
        mnemonic = "Y";
        edit_width = 5; }}
    : boxed_radio_column {
      label = "Karolaj Hizalama Seçenekleri";
      : radio_button {
        width = 27;
        label = "İki Yönde Ortala";
        key = "ktp1"; }
      : radio_button {
        width = 27;
        label = "Soldan Hizala, Düşey Ortala";
        key = "ktp2"; }
      : radio_button {
        width = 27;
        label = "Sağdan Hizala, Düşey Ortala";
        key = "ktp3"; }
      : radio_button {
        width = 27;
        label = "Üstten Hizala, Yatay Ortala";
        key = "ktp4"; }
      : radio_button {
        width = 27;
        label = "Alttan Hizala, Yatay Ortala";
        key = "ktp5"; }
      : radio_button {
        width = 27;
        label = "Üstten-Soldan Hizala";
        key = "ktp6"; }
      : radio_button {
        width = 27;
        label = "Üstten-Sağdan Hizala";
        key = "ktp7"; }
      : radio_button {
        width = 27;
        label = "Alttan-Soldan Hizala";
        key = "ktp8"; }
      : radio_button {
        width = 27;
        label = "Alttan-Sağdan Hizala";
        key = "ktp9"; }
      }
      spacer;
      ok_cancel;
      spacer;
      : boxed_column {
        : text {
          alignment = centered;
          key = "cpr";
          is_bold = true; }
        spacer; }}
    spacer;
  }

;============================================================
;  KAROLAJ.LSP İki koşe noktasi ile belirlenen bölgede,      
;  her iki doğrultuda, seçilen kriterlerde ve boyutlarda     
;  karolaj cizer. Karolaj.dcl dosyasini kullanir.            
;  Hazırlayan: M. Şahin Güvercin sahinguvercin@hotmail.com   
;============================================================
(defun C:KAROLAJ ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (if (= boyx nil) (setq boyx 60.00)) (if (= boyy nil) (setq boyy 60.00))
  (if (= ktp nil) (setq ktp 1))
  (if (< (setq dcl_id (load_dialog "karolaj.dcl")) 0) (exit))
  (setq what_next 0)
  (while (< what_next 1)
    (if (not (new_dialog "karolaj" dcl_id)) (exit))
    (set_tile "krx" (rtos boyx 2 2))
    (set_tile "kry" (rtos boyy 2 2))
    (set_tile "cpr" "Hazırlayan: M.Şahin Güvercin")
    (cond ((= ktp 1) (set_tile "ktp1" "1")) ((= ktp 2) (set_tile "ktp2" "1"))
          ((= ktp 3) (set_tile "ktp3" "1")) ((= ktp 4) (set_tile "ktp4" "1"))
          ((= ktp 5) (set_tile "ktp5" "1")) ((= ktp 6) (set_tile "ktp6" "1"))
          ((= ktp 7) (set_tile "ktp7" "1")) ((= ktp 8) (set_tile "ktp8" "1"))
          ((= ktp 9) (set_tile "ktp9" "1"))
    )
    (action_tile "krx" "(setq boyx (atof (get_tile "krx")))")
    (action_tile "kry" "(setq boyy (atof (get_tile "kry")))")
    (action_tile "ktp1" "(setq ktp 1)") (action_tile "ktp2" "(setq ktp 2)")
    (action_tile "ktp3" "(setq ktp 3)") (action_tile "ktp4" "(setq ktp 4)")
    (action_tile "ktp5" "(setq ktp 5)") (action_tile "ktp6" "(setq ktp 6)")
    (action_tile "ktp7" "(setq ktp 7)") (action_tile "ktp8" "(setq ktp 8)")
    (action_tile "ktp9" "(setq ktp 9)")
    (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 2)")
    (setq what_next (start_dialog))
  )
  (if (= what_next 1)
    (progn
      (setq brnc (getpoint "\n-Birinci kose...: ")
            iknc (getpoint "\n-Ikinci kose....: ")
            xx1 (car brnc) yy1 (cadr brnc) xx2 (car iknc) yy2 (cadr iknc))
      (if (< xx1 xx2)
        (if (< yy1 yy2) (setq x1 xx1 y1 yy1 x2 xx2 y2 yy2) (setq x1 xx1 y1 yy2 x2 xx2 y2 yy1))
        (if (< yy1 yy2) (setq x1 xx2 y1 yy1 x2 xx1 y2 yy2) (setq x1 xx2 y1 yy2 x2 xx1 y2 yy1)))
      (setq lmx (- x2 x1) lmy (- y2 y1) xadet (fix (/ lmx boyx)) xreal (/ lmx boyx))
      (if (>= (- xreal xadet) 1) (setq xadet (+ 1 xadet)))
      (setq xartk (- lmx (* xadet boyx)) yadet (fix (/ lmy boyy)) yreal (/ lmy boyy))
      (if (>= (- yreal yadet) 1) (setq yadet (+ 1 yadet)))
      (setq yartk (- lmy (* yadet boyy)))
      (cond ((= ktp 1)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl (+ y1 (/ yartk 2)))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 2)
             (progn (setq xbsl x1 ybsl (+ y1 (/ yartk 2)) xbsl (+ xbsl boyx) xadet (- xadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 3)
             (progn (setq xbsl (+ x1 xartk) ybsl (+ y1 (/ yartk 2)) xadet (- xadet 1))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 4)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl (+ y1 yartk))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (setq yadet (- yadet 1))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 5)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl y1)
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (setq ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
            ((= ktp 6)
             (progn (setq xbsl x1 ybsl (+ y1 yartk) xbsl (+ xbsl boyx) xadet (- xadet 1) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 7)
             (progn (setq xbsl (+ x1 xartk) ybsl (+ y1 yartk) xadet (- xadet 1) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 8)
             (progn (setq xbsl x1 ybsl y1 xbsl (+ xbsl boyx) xadet (- xadet 1) ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
            ((= ktp 9)
             (progn (setq xbsl (+ x1 xartk) ybsl y1 xadet (- xadet 1) ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xbsl  (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
      )
      (entmake (list (cons 0 "LINE") (cons 10 (list x1 ybsl)) (cons 11 (list x2 ybsl))))
      (command "array" "l" "" "r" (+ 1 yadet) "1" boyy)
      (entmake (list (cons 0 "LINE") (cons 10 (list xbsl y1)) (cons 11 (list xbsl y2))))
      (command "array" "l" "" "r" "1" (+ 1 xadet) boyx)
    )
  )
  (command "undo" "e")
  (prin1)
)