;;; eplisp - Tum araclar tek dosyada
;;; eplisp 2.0.0 - https://eplisp.com/tr/
;;; Ucretsiz. AutoCAD ve GstarCAD icin. Yuklemek icin: APPLOAD
;;; Hicbir garanti verilmez; sonuclari kontrol ederek kullanin.
;;; Komutlar: YUKCEL, YUKCEL-LEJANT, YUKCEL-LINYE, YUKCEL-EXPORT, YUKCEL-AYAR, KESIF, TOPLA, KABLO, KABLO-AYAR, LAMBADIZ, HATTABLOK, METINDEGIS, BULVEDEGIS, METINESLE, METINTOPLA, NUMARALA, METINDIZ, DOSYADANYAZI, ALANORTASI, STILSEC, YERINDEOLCEK, KATMANSIL, KATMANDEGIS, AKTIFKATMANA, KATMANSEC, OBJDONDUR, RENKVER, KIRMIZI, SARI, YESIL, ACMAVI, MAVI, MOR, BEYAZ, KOGRI, ACGRI, KATMANRENGI, RENK11, RENK12, RENK21, RENK25, RENK30, RENK33, RENK40, RENK41, RENK125, RENK140, RENK175, RENK215, RENK230, KESIKCI, PARALEL, CITSEC, ARAKESME, BOSLUKAC, YERDEGIS, BLOKDEGIS, SOLUZAT, SAGUZAT, YUKARIUZAT, ASAGIUZAT

;;; ------------------------------------------------------------
;;; ep core: shared helpers for every eplisp tool
;;; Prefix "ep:" keeps these names away from other LISP files.
;;; ------------------------------------------------------------

(vl-load-com)

;;; Sysvar save / restore + undo group + error handler.
;;; Usage inside a command:
;;;   (defun c:X (/ *error*)
;;;     (defun *error* (m) (ep:on-error m))
;;;     (ep:begin '("CMDECHO" "OSMODE"))
;;;     ...
;;;     (ep:finish)
;;;     (princ))
(defun ep:begin (vars)
  (setq ep:*sv* (mapcar '(lambda (v) (cons v (getvar v))) vars))
  (if (not (assoc "CMDECHO" ep:*sv*))
    (setq ep:*sv* (cons (cons "CMDECHO" (getvar "CMDECHO")) ep:*sv*))
  )
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_BEGIN")
  (setq ep:*undo* T)
)

(defun ep:finish ()
  (if ep:*undo*
    (progn
      (setq ep:*undo* nil)
      (if command-s
        (command-s "_.UNDO" "_END")
        (command "_.UNDO" "_END")
      )
    )
  )
  (foreach p ep:*sv*
    (if (cdr p) (setvar (car p) (cdr p)))
  )
  (setq ep:*sv* nil)
)

(defun ep:on-error (msg)
  (if (and msg
           (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*,*abort*")))
    (princ (strcat "\nHata: " msg))
  )
  (ep:finish)
  (princ)
)

;;; ------------------------------------------------------------
;;; Numbers and strings
;;; ------------------------------------------------------------

;;; Decimal separator used in reports (Turkish Excel expects a comma).
(setq ep:*dec* ",")
;;; CSV column separator (Turkish Excel expects a semicolon).
(setq ep:*sep* ";")

;;; Number -> string with the report decimal separator.
(defun ep:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (/= ep:*dec* ".")
    (ep:replace-all s "." ep:*dec*)
    s
  )
)

(defun ep:replace-all (str old new / pos out)
  (setq out "")
  (while (setq pos (vl-string-search old str))
    (setq out (strcat out (substr str 1 pos) new)
          str (substr str (+ pos 1 (strlen old))))
  )
  (strcat out str)
)

(defun ep:trim (s)
  (if s (vl-string-trim " \t" s) "")
)

(defun ep:pad (s n)
  (if (not s) (setq s ""))
  (while (< (strlen s) n) (setq s (strcat s " ")))
  s
)

;;; Current drawing name without extension, or a fallback.
(defun ep:dwg-base (fallback / n)
  (setq n (getvar "DWGNAME"))
  (if (or (not n) (= n ""))
    fallback
    (if (wcmatch (strcase n) "*.DWG")
      (substr n 1 (- (strlen n) 4))
      n
    )
  )
)

;;; ------------------------------------------------------------
;;; Geometry
;;; ------------------------------------------------------------

(defun ep:2d (p) (list (car p) (cadr p)))

;;; Length of any curve (LINE, ARC, CIRCLE, LWPOLYLINE with arcs,
;;; POLYLINE, ELLIPSE, SPLINE). Returns nil for non-curves.
(defun ep:curve-length (ent / typ ed)
  (setq ed (entget ent) typ (cdr (assoc 0 ed)))
  (cond
    ((not (member typ '("LINE" "ARC" "CIRCLE" "LWPOLYLINE" "POLYLINE" "ELLIPSE" "SPLINE")))
      nil
    )
    ((= typ "LINE")
      (distance (cdr (assoc 10 ed)) (cdr (assoc 11 ed)))
    )
    (T
      (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
    )
  )
)

;;; Selection set -> list of enames.
(defun ep:ss-list (ss / i out)
  (setq i 0 out nil)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out) i (1+ i))
    )
  )
  (reverse out)
)

;;; Angle of the current UCS X axis in WCS (for text rotation).
(defun ep:ucs-angle ()
  (angle '(0 0 0) (trans '(1 0 0) 1 0 T))
)

;;; ------------------------------------------------------------
;;; Layers
;;; ------------------------------------------------------------

(defun ep:ensure-layer (name color)
  (if (not (tblsearch "LAYER" name))
    (entmake (list '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 2 name)
                   '(70 . 0)
                   (cons 62 color)
                   '(6 . "Continuous")))
  )
  name
)

;;; ------------------------------------------------------------
;;; CSV output
;;; rows: list of rows, each row a list of strings.
;;; ------------------------------------------------------------

(defun ep:csv-field (s)
  (if (not s) (setq s ""))
  (if (or (vl-string-search ep:*sep* s) (vl-string-search "\"" s))
    (strcat "\"" (ep:replace-all s "\"" "\"\"") "\"")
    s
  )
)

(defun ep:csv-line (row / out first)
  (setq out "" first T)
  (foreach f row
    (setq out (strcat out (if first "" ep:*sep*) (ep:csv-field f))
          first nil)
  )
  out
)

;;; Asks for a file name (default: drawing folder + name) and writes rows.
;;; Returns the path, or nil if the user cancelled.
(defun ep:csv-save (title default-name rows / path f)
  (setq path (getfiled title
                       (strcat (getvar "DWGPREFIX") default-name)
                       "csv" 1))
  (if path
    (progn
      (setq f (open path "w"))
      (if f
        (progn
          (foreach r rows (write-line (ep:csv-line r) f))
          (close f)
          (princ (strcat "\nCSV kaydedildi: " path))
          path
        )
        (progn
          (princ (strcat "\nDosya yazilamadi: " path))
          nil
        )
      )
    )
    (progn (princ "\nCSV kaydi atlandi.") nil)
  )
)

;;; ------------------------------------------------------------
;;; Table drawn into the drawing as LINE + TEXT entities.
;;; Works in every CAD program (no TABLE object, no ActiveX).
;;; rows : list of rows (list of strings); first row is the header.
;;; ------------------------------------------------------------

(defun ep:text (p h s lay rot)
  (entmake (list '(0 . "TEXT")
                 (cons 8 lay)
                 (cons 10 p)
                 (cons 11 p)
                 (cons 40 h)
                 (cons 1 s)
                 (cons 50 rot)
                 (cons 7 (getvar "TEXTSTYLE"))
                 '(72 . 0)
                 '(73 . 2)))
)

(defun ep:line (p1 p2 lay)
  (entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 p1) (cons 11 p2)))
)

;;; Converts a point given relative to an origin in the UCS into WCS.
(defun ep:uw (origin dx dy)
  (trans (list (+ (car origin) dx) (- (cadr origin) dy) 0.0) 1 0)
)

(defun ep:draw-table (origin rows h lay / widths ncol i w row-h total-w
                      total-h y x r c rot pad)
  (setq ncol (apply 'max (mapcar 'length rows))
        pad  (* h 0.6)
        row-h (* h 2.0)
        rot  (ep:ucs-angle))
  ;; Column widths from the longest text in each column.
  (setq widths nil i 0)
  (repeat ncol
    (setq w 0)
    (foreach r rows
      (if (nth i r) (setq w (max w (strlen (nth i r)))))
    )
    (setq widths (append widths (list (+ (* w h 0.85) (* pad 2.0))))
          i (1+ i))
  )
  (setq total-w (apply '+ widths)
        total-h (* row-h (length rows)))
  ;; Horizontal lines
  (setq y 0.0)
  (repeat (1+ (length rows))
    (ep:line (ep:uw origin 0.0 y) (ep:uw origin total-w y) lay)
    (setq y (+ y row-h))
  )
  ;; Vertical lines
  (setq x 0.0)
  (ep:line (ep:uw origin 0.0 0.0) (ep:uw origin 0.0 total-h) lay)
  (foreach w widths
    (setq x (+ x w))
    (ep:line (ep:uw origin x 0.0) (ep:uw origin x total-h) lay)
  )
  ;; Cell texts
  (setq y (/ row-h 2.0))
  (foreach r rows
    (setq x 0.0 c 0)
    (foreach w widths
      (if (and (nth c r) (/= (nth c r) ""))
        (ep:text (ep:uw origin (+ x pad) y) h (nth c r) lay rot)
      )
      (setq x (+ x w) c (1+ c))
    )
    (setq y (+ y row-h))
  )
  (princ (strcat "\nTablo cizildi: "
                 (itoa (length rows)) " satir"))
)

;;; Asks where to put the table and the text height, then draws it.
(defun ep:place-table (rows lay / pt h def)
  (initget "Evet Hayir")
  (if (/= (getkword "\nTablo cizime eklensin mi? [Evet/Hayir] <Evet>: ")
          "Hayir")
    (progn
      (setq pt (getpoint "\nTablonun sol ust kosesi (Enter = atla): "))
      (if pt
        (progn
          (setq def (getvar "TEXTSIZE"))
          (setq h (getdist pt (strcat "\nYazi yuksekligi <" (rtos def 2 2) ">: ")))
          (if (not h) (setq h def))
          (ep:ensure-layer lay 7)
          (ep:draw-table pt rows h lay)
        )
      )
    )
  )
)

;;; ------------------------------------------------------------
;;; Entity editing
;;; ------------------------------------------------------------

;;; Sets DXF group `code` of an entity to `val` (adds it when missing).
(defun ep:set-dxf (ent code val / ed old)
  (setq ed (entget ent))
  (if (setq old (assoc code ed))
    (setq ed (subst (cons code val) old ed))
    (setq ed (append ed (list (cons code val))))
  )
  (entmod ed)
  (entupd ent)
)

(defun ep:dxf (ent code) (cdr (assoc code (entget ent))))

;;; TEXT with a given justification (72 horizontal, 73 vertical).
;;; 72: 0 left 1 center 2 right   73: 0 base 1 bottom 2 middle 3 top
(defun ep:text-j (p h s lay rot j72 j73)
  (entmake (list '(0 . "TEXT")
                 (cons 8 lay)
                 (cons 10 p)
                 (cons 11 p)
                 (cons 40 h)
                 (cons 1 s)
                 (cons 50 rot)
                 (cons 7 (getvar "TEXTSTYLE"))
                 (cons 72 j72)
                 (cons 73 j73)))
)

;;; First number in a string: "L=12,5 m" -> 12.5, "-3" -> -3.0, none -> nil
(defun ep:first-number (s / i n ch out started dot)
  (setq i 1 n (strlen s) out "" started nil dot nil)
  (while (<= i n)
    (setq ch (substr s i 1))
    (cond
      ((wcmatch ch "#")
        (if (and (not started) (> i 1) (= (substr s (1- i) 1) "-"))
          (setq out "-")
        )
        (setq out (strcat out ch) started T)
      )
      ((and started (not dot) (member ch '("." ","))
            (< i n) (wcmatch (substr s (1+ i) 1) "#"))
        (setq out (strcat out ".") dot T)
      )
      (started (setq i n))
    )
    (setq i (1+ i))
  )
  (if started (atof out) nil)
)

;;; Attributes of an INSERT as ((TAG . value) ...)
(defun ep:attribs-get (ins / e ed out)
  (setq out nil e (entnext ins))
  (while (and e (= (cdr (assoc 0 (setq ed (entget e)))) "ATTRIB"))
    (setq out (cons (cons (strcase (cdr (assoc 2 ed))) (cdr (assoc 1 ed))) out)
          e (entnext e))
  )
  (reverse out)
)

;;; Writes values into the attributes whose tags match.
(defun ep:attribs-set (ins vals / e ed v)
  (setq e (entnext ins))
  (while (and e (= (cdr (assoc 0 (setq ed (entget e)))) "ATTRIB"))
    (if (setq v (assoc (strcase (cdr (assoc 2 ed))) vals))
      (entmod (subst (cons 1 (cdr v)) (assoc 1 ed) ed))
    )
    (setq e (entnext e))
  )
  (entupd ins)
)

;;; Inserts a block that exists in the drawing. pt in UCS, rot in radians
;;; (relative to the UCS X axis). Attributes get their default values.
;;; Needs ATTREQ / AUNITS / ANGBASE / ANGDIR saved by ep:begin.
(defun ep:insert (name pt scale rot lay / e)
  (setvar "ATTREQ" 0)
  (setvar "AUNITS" 0)
  (setvar "ANGBASE" 0.0)
  (setvar "ANGDIR" 0)
  (command "_.-INSERT" name "_S" scale "_R" (angtos rot 0 8) "_non" pt)
  (setq e (entlast))
  (if (and lay e (= (cdr (assoc 0 (entget e))) "INSERT"))
    (ep:set-dxf e 8 lay)
  )
  e
)

(setq ep:*insert-vars* '("ATTREQ" "AUNITS" "ANGBASE" "ANGDIR" "OSMODE"))

;;; Asks for a block name (default = last used); typing S lets the user
;;; pick a sample block instead. Returns a block name that exists, or nil.
(defun ep:ask-block (default / s e)
  (setq s (getstring T (strcat "\nBlok adi (S = ornek blok sec)"
                               (if default (strcat " <" default ">") "") ": ")))
  (cond
    ((= s "") (setq s default))
    ((= (strcase s) "S")
      (setq e (entsel "\nOrnek bloku secin: "))
      (setq s (if (and e (= (ep:dxf (car e) 0) "INSERT")) (ep:dxf (car e) 2) nil))
    )
  )
  (cond
    ((not s) nil)
    ((tblsearch "BLOCK" s) s)
    (T (princ (strcat "\nCizimde boyle bir blok yok: " s)) nil)
  )
)

;;; LWPOLYLINE from 2D WCS points.
(defun ep:lwpoly (pts closed lay)
  (entmake (append (list '(0 . "LWPOLYLINE")
                         '(100 . "AcDbEntity")
                         (cons 8 lay)
                         '(100 . "AcDbPolyline")
                         (cons 90 (length pts))
                         (cons 70 (if closed 1 0)))
                   (mapcar '(lambda (p) (cons 10 (list (car p) (cadr p)))) pts)))
)

;;; LINE endpoints in the current UCS.
(defun ep:line-ucs (e / ed)
  (setq ed (entget e))
  (list (trans (cdr (assoc 10 ed)) 0 1) (trans (cdr (assoc 11 ed)) 0 1))
)

;;; Projection of p onto the infinite line a-b (2D).
(defun ep:project (p a b / dx dy l2 k)
  (setq dx (- (car b) (car a)) dy (- (cadr b) (cadr a))
        l2 (+ (* dx dx) (* dy dy)))
  (if (< l2 1e-12)
    a
    (progn
      (setq k (/ (+ (* (- (car p) (car a)) dx) (* (- (cadr p) (cadr a)) dy)) l2))
      (list (+ (car a) (* k dx)) (+ (cadr a) (* k dy)) 0.0)
    )
  )
)

;;; Is p on segment a-b (within tol)?
(defun ep:on-seg (p a b tol)
  (< (abs (- (+ (distance (ep:2d a) (ep:2d p)) (distance (ep:2d p) (ep:2d b)))
             (distance (ep:2d a) (ep:2d b))))
     tol)
)

;;; Temporary preview of a point chain (cleared by REDRAW).
(defun ep:preview (pts / i)
  (setq i 0)
  (while (< i (1- (length pts)))
    (grdraw (nth i pts) (nth (1+ i) pts) 7 1)
    (setq i (1+ i))
  )
)

;;; Collects points with a rubber-band preview. Keywords: Close / Undo.
;;; Returns (points closed-flag); points are in the UCS.
(defun ep:collect-points (first-prompt / pts pt closed done)
  (setq pts nil closed nil done nil)
  (if (setq pt (getpoint first-prompt))
    (progn
      (setq pts (list pt))
      (while (not done)
        (initget "Kapat Geri")
        (setq pt (getpoint (last pts) "\nSonraki nokta [Kapat/Geri] (Enter = bitir): "))
        (cond
          ((null pt) (setq done T))
          ((= pt "Kapat")
            (if (> (length pts) 2) (setq closed T done T)
              (princ "\nKapatmak icin en az 3 nokta gerekir.")))
          ((= pt "Geri")
            (if (> (length pts) 1)
              (progn
                (setq pts (reverse (cdr (reverse pts))))
                (redraw)
                (ep:preview pts)
              )
            )
            (setq pt nil)
          )
          ((> (distance pt (last pts)) 1e-9)
            (grdraw (last pts) pt 7 1)
            (setq pts (append pts (list pt)))
          )
        )
      )
      (redraw)
    )
  )
  (list pts closed)
)

;;; YUKCEL - Elektrik ic tesisat yukleme cetveli.
;;; Lejanttan blok tiplerini ve guclerini okur, secilen linyeleri takip eder,
;;; sorti, guc, akim, kablo, sigorta ve faz dagilimini hesaplar.
;;; Hesaplar Elektrik Ic Tesisleri Yonetmeligi'ndeki (220/380 V) kurallara gore yapilir.

;;; ---- helpers (geometry, text, attributes, line topology) ----
;;; Iki nokta arasi mesafe (2D)
(defun yukcel:dist (p1 p2)
  (if (and p1 p2)
    (distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2)))
    99999.9
  )
)

;;; Iki nokta esit mi (toleransli)
(defun yukcel:pt-equal (p1 p2 / d)
  (if (and p1 p2)
    (< (yukcel:dist p1 p2) *yukcel-tol*)
    nil
  )
)

;;; Turkce karakterleri ASCII karsiliklarina donustur
;;; AutoCAD/GstarCAD Windows-1254 (Turkish) code page kullanir
;;; strcase Turkce ozel karakterleri dogru donusturmedigi icin
;;; once normalize edip sonra strcase yapiyoruz
(defun yukcel:tr-normalize (str / i ch result code)
  (if (not str) ""
    (progn
      (setq result "" i 1)
      (while (<= i (strlen str))
        (setq ch (substr str i 1))
        (setq code (ascii ch))
        (setq ch
          (cond
            ;; Windows-1254 Turkish code page
            ;; Kucuk harfler
            ((= code 246) "O")  ; o -> O
            ((= code 252) "U")  ; u -> U
            ((= code 231) "C")  ; c -> C
            ((= code 254) "S")  ; s (code page 1254: 254) -> S
            ((= code 240) "G")  ; g (code page 1254: 240) -> G  
            ((= code 253) "I")  ; i (code page 1254: 253) -> I
            ;; Buyuk harfler
            ((= code 214) "O")  ; O -> O
            ((= code 220) "U")  ; U -> U
            ((= code 199) "C")  ; C -> C
            ((= code 222) "S")  ; S (code page 1254: 222) -> S
            ((= code 208) "G")  ; G (code page 1254: 208) -> G
            ((= code 221) "I")  ; I (code page 1254: 221) -> I
            ;; ISO-8859-9 alternatif kodlar (bazi sistemlerde)
            ((= code 351) "S")  ; s unicode
            ((= code 350) "S")  ; S unicode
            ((= code 287) "G")  ; g unicode
            ((= code 286) "G")  ; G unicode
            ((= code 305) "I")  ; i unicode
            ((= code 304) "I")  ; I unicode
            (T ch)
          )
        )
        (setq result (strcat result ch))
        (setq i (1+ i))
      )
      result
    )
  )
)

;;; String icinde substring ara (case-insensitive, Turkce uyumlu)
;;; Once Turkce normalize, sonra strcase, sonra ara
(defun yukcel:str-find (sub str / i ls lsub found)
  (if (or (not sub) (not str) (= sub "") (= str ""))
    nil
    (progn
      (setq sub (strcase (yukcel:tr-normalize sub)))
      (setq str (strcase (yukcel:tr-normalize str)))
      (setq ls (strlen str))
      (setq lsub (strlen sub))
      (setq i 1 found nil)
      (while (and (<= (+ i lsub -1) ls) (not found))
        (if (= (substr str i lsub) sub)
          (setq found i)
          (setq i (1+ i))
        )
      )
      found
    )
  )
)

;;; String'den sayi cikart (ilk bulunan sayi dizisi)
(defun yukcel:extract-number (str / i ch num-str len1 started)
  (if (not str) (setq str ""))
  (setq len1 (strlen str) i 1 num-str "" started nil)
  (while (<= i len1)
    (setq ch (substr str i 1))
    (if (or (and (>= (ascii ch) 48) (<= (ascii ch) 57)) (= ch "."))
      (progn (setq num-str (strcat num-str ch)) (setq started T))
      (if started (setq i (1+ len1)))
    )
    (setq i (1+ i))
  )
  (if (= num-str "") 0.0 (atof num-str))
)

;;; "2x36W" veya "36W" gibi guc parse
(defun yukcel:parse-watt (txt / pos1 pos2 num1 num2 upper)
  (if (not txt) (setq txt ""))
  (setq upper (strcase (yukcel:tr-normalize txt)))
  (setq pos1 (yukcel:str-find "W" upper))
  (if (not pos1)
    0.0
    (progn
      (setq pos2 (yukcel:str-find "X" upper))
      (if (and pos2 (< pos2 pos1))
        (progn
          (setq num1 (yukcel:extract-number (substr upper 1 (1- pos2))))
          (setq num2 (yukcel:extract-number (substr upper (1+ pos2) (- pos1 pos2 1))))
          (if (= num1 0.0) (setq num1 1.0))
          (* num1 num2)
        )
        (yukcel:extract-number upper)
      )
    )
  )
)

;;; Entity tipini al
(defun yukcel:get-type (ent)
  (cdr (assoc 0 (entget ent)))
)

;;; Entity'nin layer'ini al
(defun yukcel:get-layer (ent)
  (cdr (assoc 8 (entget ent)))
)

;;; Blok adini al
(defun yukcel:get-block-name (ent / edata)
  (setq edata (entget ent))
  (if (= (cdr (assoc 0 edata)) "INSERT")
    (cdr (assoc 2 edata))
    nil
  )
)

;;; TEXT veya MTEXT icerigini al
(defun yukcel:get-text-content (ent / edata etype)
  (setq edata (entget ent))
  (setq etype (cdr (assoc 0 edata)))
  (cond
    ((= etype "TEXT")  (cdr (assoc 1 edata)))
    ((= etype "MTEXT") (cdr (assoc 1 edata)))
    (T nil)
  )
)

;;; ============================================================
;;; BLOK ATTRIBUTE OKUMA
;;; Blok INSERT entity'sinden ATTRIB sub-entity'leri okur
;;; ============================================================

;;; Bloktaki tum attribute'lari oku
;;; Dondurur: (("TAG1" . "VALUE1") ("TAG2" . "VALUE2") ...)
(defun yukcel:get-block-attribs (ent / sub edata etype result)
  (setq result nil)
  (setq edata (entget ent))
  ;; DXF 66 = 1 ise attribute'lar var
  (if (and (= (cdr (assoc 0 edata)) "INSERT")
           (= (cdr (assoc 66 edata)) 1))
    (progn
      (setq sub (entnext ent))
      (while sub
        (setq edata (entget sub))
        (setq etype (cdr (assoc 0 edata)))
        (cond
          ((= etype "ATTRIB")
            (setq result (cons 
              (cons (cdr (assoc 2 edata))   ; tag
                    (cdr (assoc 1 edata)))  ; value
              result))
          )
          ((= etype "SEQEND") (setq sub nil)) ; bitti
        )
        (if sub (setq sub (entnext sub)))
      )
    )
  )
  (reverse result)
)

;;; Bloktaki tum attribute degerlerini birlestir (tek string)
(defun yukcel:get-all-attrib-text (ent / attribs txt)
  (setq attribs (yukcel:get-block-attribs ent))
  (setq txt "")
  (foreach a attribs
    (if (cdr a)
      (setq txt (strcat txt " " (cdr a)))
    )
  )
  txt
)

;;; Bloktaki attribute'lardan guc (W) degerini parse et
;;; Tum attribute'lari tarar, icinde W geceni bulur
(defun yukcel:get-attrib-watt (ent / attribs val w best-w)
  (setq attribs (yukcel:get-block-attribs ent))
  (setq best-w 0.0)
  (foreach a attribs
    (setq val (cdr a))
    (if val
      (progn
        (setq w (yukcel:parse-watt val))
        (if (> w best-w) (setq best-w w))
      )
    )
  )
  best-w
)

;;; Entity'nin insertion point veya merkez noktasini al
(defun yukcel:get-insert-pt (ent / edata etype)
  (setq edata (entget ent))
  (setq etype (cdr (assoc 0 edata)))
  (cond
    ((= etype "INSERT") (cdr (assoc 10 edata)))
    ((= etype "TEXT")   (cdr (assoc 10 edata)))
    ((= etype "MTEXT")  (cdr (assoc 10 edata)))
    ((= etype "POINT")  (cdr (assoc 10 edata)))
    ((= etype "CIRCLE") (cdr (assoc 10 edata)))
    ((= etype "LINE")   
      (list 
        (/ (+ (car (cdr (assoc 10 edata))) (car (cdr (assoc 11 edata)))) 2.0)
        (/ (+ (cadr (cdr (assoc 10 edata))) (cadr (cdr (assoc 11 edata)))) 2.0)
      )
    )
    ((= etype "LWPOLYLINE") (cdr (assoc 10 edata)))
    (T nil)
  )
)

;;; Selection set'i listeye cevir
(defun yukcel:ss-to-list (ss / i n lst)
  (setq lst nil)
  (if ss
    (progn
      (setq n (sslength ss) i 0)
      (while (< i n)
        (setq lst (cons (ssname ss i) lst))
        (setq i (1+ i))
      )
    )
  )
  (reverse lst)
)

;;; Bir noktadaki tum entity'leri bul (toleransli)
(defun yukcel:entities-at-point (pt radius / ss)
  (setq ss (ssget "_C" 
    (list (- (car pt) radius) (- (cadr pt) radius))
    (list (+ (car pt) radius) (+ (cadr pt) radius))
  ))
  (if ss (yukcel:ss-to-list ss) nil)
)

;;; Listede eleman var mi
(defun yukcel:member-ent (ent lst)
  (if (not lst) nil
    (if (equal ent (car lst))
      T
      (yukcel:member-ent ent (cdr lst))
    )
  )
)

;;; Unique layer sayisi (entity listesinden)
(defun yukcel:unique-layer-count (ent-list / layers lay)
  (setq layers nil)
  (foreach e ent-list
    (setq lay (yukcel:get-layer e))
    (if (and lay (not (member lay layers)))
      (setq layers (cons lay layers))
    )
  )
  (length layers)
)

;;; String'i sola yasla, boslukla doldur
(defun yukcel:pad-right (str width / len1)
  (if (not str) (setq str ""))
  (setq len1 (strlen str))
  (while (< len1 width)
    (setq str (strcat str " "))
    (setq len1 (1+ len1))
  )
  (substr str 1 width)
)

;;; Noktanin bir dogru parcasina (p1-p2) olan mesafesi
(defun yukcel:point-to-seg-dist (pt p1 p2 / dx dy t1 proj-x proj-y)
  (setq dx (- (car p2) (car p1)))
  (setq dy (- (cadr p2) (cadr p1)))
  (if (and (= dx 0.0) (= dy 0.0))
    (yukcel:dist pt p1)
    (progn
      (setq t1 (/ (+ (* (- (car pt) (car p1)) dx) 
                     (* (- (cadr pt) (cadr p1)) dy))
                  (+ (* dx dx) (* dy dy))))
      (if (< t1 0.0) (setq t1 0.0))
      (if (> t1 1.0) (setq t1 1.0))
      (setq proj-x (+ (car p1) (* t1 dx)))
      (setq proj-y (+ (cadr p1) (* t1 dy)))
      (yukcel:dist pt (list proj-x proj-y))
    )
  )
)

;;; ============================================================
;;; HAT SOYUTLAMA KATMANI (LINE + LWPOLYLINE + POLYLINE)
;;; "hat" = herhangi bir cizgi entity'si
;;; ============================================================

;;; Entity hat mi?
(defun yukcel:is-hat (ent / etype)
  (setq etype (yukcel:get-type ent))
  (or (= etype "LINE") (= etype "LWPOLYLINE") (= etype "POLYLINE"))
)

;;; LWPOLYLINE'dan vertex listesi cikar
(defun yukcel:lwpoly-vertices (ent / edata pts pair)
  (setq edata (entget ent))
  (setq pts nil)
  (foreach pair edata
    (if (= (car pair) 10)
      (setq pts (cons (cdr pair) pts))
    )
  )
  (reverse pts)
)

;;; Eski tip POLYLINE'dan vertex listesi cikar (sub-entity)
(defun yukcel:polyline-vertices (ent / e edata etype pts)
  (setq pts nil)
  (setq e (entnext ent))
  (while e
    (setq edata (entget e))
    (setq etype (cdr (assoc 0 edata)))
    (if (= etype "VERTEX")
      (setq pts (cons (cdr (assoc 10 edata)) pts))
    )
    (if (= etype "SEQEND") (setq e nil)
      (setq e (entnext e))
    )
  )
  (reverse pts)
)

;;; Herhangi bir hat entity'sinden vertex listesi al
(defun yukcel:hat-vertices (ent / edata etype)
  (setq edata (entget ent))
  (setq etype (cdr (assoc 0 edata)))
  (cond
    ((= etype "LINE")
      (list (cdr (assoc 10 edata)) (cdr (assoc 11 edata)))
    )
    ((= etype "LWPOLYLINE")
      (yukcel:lwpoly-vertices ent)
    )
    ((= etype "POLYLINE")
      (yukcel:polyline-vertices ent)
    )
    (T nil)
  )
)

;;; Hat entity'sinden segment listesi cikar: ((p1 p2) (p2 p3) ...)
(defun yukcel:hat-segments (ent / verts segs i closed edata etype)
  (setq verts (yukcel:hat-vertices ent))
  (if (not verts) nil
    (progn
      (setq segs nil i 0)
      (while (< i (1- (length verts)))
        (setq segs (cons (list (nth i verts) (nth (1+ i) verts)) segs))
        (setq i (1+ i))
      )
      ;; Kapali polyline kontrol
      (setq edata (entget ent))
      (setq etype (cdr (assoc 0 edata)))
      (setq closed nil)
      (if (or (= etype "LWPOLYLINE") (= etype "POLYLINE"))
        (if (= (logand (cdr (assoc 70 edata)) 1) 1) (setq closed T))
      )
      (if (and closed (> (length verts) 2))
        (setq segs (cons (list (last verts) (car verts)) segs))
      )
      (reverse segs)
    )
  )
)

;;; Bir noktanin hat'in endpoint'i mi yoksa govdesinde mi oldugunu kontrol et
;;; Endpoint ise T, govde ise nil dondurur
(defun yukcel:is-endpoint (pt ent / verts first-pt last-pt)
  (setq verts (yukcel:hat-vertices ent))
  (if (not verts) nil
    (progn
      (setq first-pt (car verts))
      (setq last-pt (last verts))
      (or (yukcel:pt-equal pt first-pt)
          (yukcel:pt-equal pt last-pt))
    )
  )
)

;;; Bir noktanin hat'in govdesine (segmentlerinin uzerine) dusup dusmedigini kontrol et
;;; Endpoint haric, segmentin ortasina yakin mi?
(defun yukcel:point-on-hat-body (pt ent / segs seg d on-body)
  ;; Once endpoint mi kontrol et - endpoint ise govde degil
  (if (yukcel:is-endpoint pt ent) nil
    (progn
      (setq segs (yukcel:hat-segments ent))
      (setq on-body nil)
      (foreach seg segs
        (if (not on-body)
          (progn
            (setq d (yukcel:point-to-seg-dist pt (car seg) (cadr seg)))
            (if (< d *yukcel-tol*) (setq on-body T))
          )
        )
      )
      on-body
    )
  )
)

;;; Iki hat arasindaki baglanti tipini belirle
;;; Dondurur:
;;;   "EP-EP"    = her ikisinin de endpoint'i ayni noktada (kural 2)
;;;   "EP-BODY"  = birinin endpoint'i digerinin govdesinde (kural 3,4)
;;;   "BODY-BODY"= her ikisi de govdeden kesisiyor (kural 1 - FARKLI linye)
;;;   nil        = hic baglanti yok
(defun yukcel:hat-connection-type (ent1 ent2 / verts1 verts2 
                                    ep1-first ep1-last ep2-first ep2-last
                                    result test-pt)
  (setq verts1 (yukcel:hat-vertices ent1))
  (setq verts2 (yukcel:hat-vertices ent2))
  (if (or (not verts1) (not verts2)) nil
    (progn
      (setq ep1-first (car verts1))
      (setq ep1-last (last verts1))
      (setq ep2-first (car verts2))
      (setq ep2-last (last verts2))
      (setq result nil)
      
      ;; Kural 2: Endpoint-Endpoint (iki hat'in uc noktalari ayni yerde)
      (if (not result)
        (if (or (yukcel:pt-equal ep1-first ep2-first)
                (yukcel:pt-equal ep1-first ep2-last)
                (yukcel:pt-equal ep1-last ep2-first)
                (yukcel:pt-equal ep1-last ep2-last))
          (setq result "EP-EP")
        )
      )
      
      ;; Kural 3/4: ent1'in endpoint'i ent2'nin govdesinde mi?
      (if (not result)
        (if (or (yukcel:point-on-hat-body ep1-first ent2)
                (yukcel:point-on-hat-body ep1-last ent2))
          (setq result "EP-BODY")
        )
      )
      
      ;; Kural 3/4: ent2'nin endpoint'i ent1'in govdesinde mi?
      (if (not result)
        (if (or (yukcel:point-on-hat-body ep2-first ent1)
                (yukcel:point-on-hat-body ep2-last ent1))
          (setq result "EP-BODY")
        )
      )
      
      ;; Kural 1 kontrolu gerek yok - yukaridakiler eslesmezse
      ;; baglanti yok (veya govde-govde kesisim ki bu farkli linye)
      result
    )
  )
)

;;; ---- classification ----
(defun yukcel:tip-belirle (blk-name txt / upper)
  (setq upper "")
  (if txt (setq upper (strcase (yukcel:tr-normalize txt))))
  (if blk-name (setq upper (strcat upper " " (strcase (yukcel:tr-normalize blk-name)))))
  (cond
    ;; =============== ZAYIF AKIM - YOKSAY ===============
    ((yukcel:str-find "TELEFON" upper) "ZAY")
    ((yukcel:str-find "TV" upper) "ZAY")
    ((yukcel:str-find "DATA" upper) "ZAY")
    ((yukcel:str-find "INTERNET" upper) "ZAY")
    ((yukcel:str-find "ZAYIF" upper) "ZAY")
    ((yukcel:str-find "YANGIN" upper) "ZAY")
    ((yukcel:str-find "DUMAN" upper) "ZAY")
    ((yukcel:str-find "KAMERA" upper) "ZAY")
    ((yukcel:str-find "ZIL" upper) "ZAY")
    ((yukcel:str-find "INTERKOM" upper) "ZAY")
    ((yukcel:str-find "DIYAFON" upper) "ZAY")
    ((yukcel:str-find "DIAFON" upper) "ZAY")
    ((yukcel:str-find "CCTV" upper) "ZAY")
    ((yukcel:str-find "ALARM" upper) "ZAY")
    ((yukcel:str-find "HAREKET SENSOR" upper) "ZAY") ; hareket sensoru (tek basina)
    ((yukcel:str-find "HAREKET DEDEK" upper) "ZAY")  ; hareket dedektoru (zayif akim)
    ((yukcel:str-find "DUMAN DEDEK" upper) "ZAY")
    ((yukcel:str-find "ISI DEDEK" upper) "ZAY")
    ((yukcel:str-find "GAZ DEDEK" upper) "ZAY")
    ((yukcel:str-find "YANGIN DEDEK" upper) "ZAY")
    ((yukcel:str-find "ANTEN" upper) "ZAY")
    ((yukcel:str-find "SIREN" upper) "ZAY")
    ((yukcel:str-find "HOPARLOR" upper) "ZAY")
    ((yukcel:str-find "UPS" upper) "ZAY")
    ((yukcel:str-find "CATV" upper) "ZAY")
    ((yukcel:str-find "RJ45" upper) "ZAY")
    ((yukcel:str-find "RJ11" upper) "ZAY")
    ((yukcel:str-find "CAT5" upper) "ZAY")
    ((yukcel:str-find "CAT6" upper) "ZAY")
    ((yukcel:str-find "WIRELESS" upper) "ZAY")
    ((yukcel:str-find "MODEM" upper) "ZAY")
    ((yukcel:str-find "HUB" upper) "ZAY")
    ((yukcel:str-find "SWITCH" upper) "ZAY")  ; TR: network switch, EN: light switch
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    ;; =============== ANAHTAR ===============
    ((yukcel:str-find "ANAHTAR" upper) "ANH")
    ((yukcel:str-find "KOMUT" upper) "ANH")
    ((yukcel:str-find "KOMITAT" upper) "ANH")  ; komutator
    ((yukcel:str-find "VAVIYEN" upper) "ANH")
    ((yukcel:str-find "VAVIEN" upper) "ANH")
    ((yukcel:str-find "DEVIAT" upper) "ANH")
    ((yukcel:str-find "DIMMER" upper) "ANH")
    ((yukcel:str-find "CAPRAZ" upper) "ANH")   ; capraz anahtar
    ((yukcel:str-find "PERMUT" upper) "ANH")   ; permutator
    ((yukcel:str-find "TEK KUTUP" upper) "ANH")
    ((yukcel:str-find "CIFT KUTUP" upper) "ANH")
    ((yukcel:str-find "ADI ANAHTAR" upper) "ANH")
    ;; Blok adi kisaltmalari (proje sembollerinde sikca kullanilir)
    ((yukcel:str-find "EADI" upper) "ANH")     ; etanj adi anahtar
    ((yukcel:str-find "VANH" upper) "ANH")     ; vaviyen anahtar
    ((yukcel:str-find "ANH" upper) "ANH")      ; anahtar kisaltmasi
    
    
    
    
    
    
    ;; =============== CIHAZ (mustakil) ===============
    ((yukcel:str-find "CAMASIR" upper) "CIH")
    ((yukcel:str-find "BULASIK" upper) "CIH")
    ((yukcel:str-find "FIRIN" upper) "CIH")
    ((yukcel:str-find "SOFBEN" upper) "CIH")
    ((yukcel:str-find "SOBA" upper) "CIH")
    ((yukcel:str-find "KLIMA" upper) "CIH")
    ((yukcel:str-find "KOMBI" upper) "CIH")
    ((yukcel:str-find "ELEKTRIKLI ISIT" upper) "CIH")
    ((yukcel:str-find "BOYLER" upper) "CIH")
    ((yukcel:str-find "TERMOSIFON" upper) "CIH")
    ((yukcel:str-find "KURUTUCU" upper) "CIH")
    ((yukcel:str-find "BUZDOLABI" upper) "CIH")
    ((yukcel:str-find "ASPIRATOR" upper) "CIH")
    ((yukcel:str-find "DAVLUMBAZ" upper) "CIH")
    ((yukcel:str-find "MIKRODALGA" upper) "CIH")
    ((yukcel:str-find "ANKASTRE" upper) "CIH")
    ((yukcel:str-find "OCAK" upper) "CIH")
    ((yukcel:str-find "MOTOR" upper) "CIH")
    ((yukcel:str-find "POMPA" upper) "CIH")
    ((yukcel:str-find "KOMPRES" upper) "CIH")
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    ;; =============== PRIZ ===============
    ((yukcel:str-find "PRIZ" upper) "PRZ")
    ((yukcel:str-find "TOPRAKLI" upper) "PRZ")
    ((yukcel:str-find "ETANS PRIZ" upper) "PRZ")
    ((yukcel:str-find "SIVA ALTI PRIZ" upper) "PRZ")
    ((yukcel:str-find "SIVA USTU PRIZ" upper) "PRZ")
    
    
    
    
    
    ;; =============== BUAT ===============
    ((yukcel:str-find "BUAT" upper) "BUA")
    ((yukcel:str-find "BAGLANTI KUTU" upper) "BUA")
    ((yukcel:str-find "EK KUTU" upper) "BUA")
    ((yukcel:str-find "DAGITIM KUTU" upper) "BUA")
    
    
    
    
    ;; =============== AYDINLATMA ===============
    ((yukcel:str-find "SENSORLU" upper) "AYD")  ; sensorlu armatur/LED - AYD bolumunde olmali
    ((yukcel:str-find "ARMATUR" upper) "AYD")
    ((yukcel:str-find "ARMAT" upper) "AYD")
    ((yukcel:str-find "LAMBA" upper) "AYD")
    ((yukcel:str-find "AMPUL" upper) "AYD")
    ((yukcel:str-find "APLIK" upper) "AYD")
    ((yukcel:str-find "APLK" upper) "AYD")
    ((yukcel:str-find "AVIZE" upper) "AYD")
    ((yukcel:str-find "SPOT" upper) "AYD")
    ((yukcel:str-find "FLORESAN" upper) "AYD")
    ((yukcel:str-find "FLUORESAN" upper) "AYD")
    ((yukcel:str-find "FLORESSON" upper) "AYD")
    ((yukcel:str-find "LED" upper) "AYD")
    ((yukcel:str-find "TAVAN" upper) "AYD")
    ((yukcel:str-find "DUVAR AYDINL" upper) "AYD")
    ((yukcel:str-find "SARKAVIYE" upper) "AYD")
    ((yukcel:str-find "SARKIT" upper) "AYD")
    ((yukcel:str-find "SIVA ALTI" upper) "AYD") ; siva alti armatur (priz yoksa)
    ((yukcel:str-find "SIVA USTU" upper) "AYD") ; siva ustu armatur (priz yoksa)
    ((yukcel:str-find "ETANS" upper) "AYD")     ; etans armatur (priz yoksa)
    ((yukcel:str-find "ETANJ" upper) "AYD")
    ((yukcel:str-find "GLOP" upper) "AYD")
    ((yukcel:str-find "GLOB" upper) "AYD")
    ((yukcel:str-find "PROJEKTOR" upper) "AYD")
    ((yukcel:str-find "DOWNLIGHT" upper) "AYD")
    ((yukcel:str-find "PANEL" upper) "AYD")     ; LED panel
    ((yukcel:str-find "LINEER" upper) "AYD")    ; lineer armatur
    ((yukcel:str-find "LINEAR" upper) "AYD")
    ((yukcel:str-find "SERIT" upper) "AYD")     ; serit LED
    ((yukcel:str-find "STRIP" upper) "AYD")
    ((yukcel:str-find "ACIL AYDINL" upper) "AYD")
    ((yukcel:str-find "ACIL CIKIS" upper) "AYD")
    ((yukcel:str-find "EXIT" upper) "AYD")
    ((yukcel:str-find "YONLENDIRME" upper) "AYD")
    ((yukcel:str-find "HALOJEN" upper) "AYD")
    ((yukcel:str-find "AKKOR" upper) "AYD")
    ((yukcel:str-find "SORTI" upper) "AYD")     ; aydinlatma sortisi
    ((yukcel:str-find "TRAFIK" upper) "AYD")    ; park/bahce aydinlatma
    ((yukcel:str-find "BAHCE" upper) "AYD")
    ((yukcel:str-find "DIS AYDINL" upper) "AYD")
    ((yukcel:str-find "KARE FLOR" upper) "AYD")
    ((yukcel:str-find "SIMIT FLOR" upper) "AYD")
    ((yukcel:str-find "RALINA" upper) "AYD")
    ((yukcel:str-find "SOKET" upper) "AYD")     ; lamba soketi / duy
    ((yukcel:str-find "DUY" upper) "AYD")
    ((yukcel:str-find "AYDINLATMA" upper) "AYD")
    ((yukcel:str-find "AYDNLTMA" upper) "AYD")  ; kisaltma
    ((yukcel:str-find "AYD." upper) "AYD")      ; kisaltma
    ((yukcel:str-find "LUMEN" upper) "AYD")
    ((yukcel:str-find "LUX" upper) "AYD")
    ((yukcel:str-find "ISIK" upper) "AYD")      ; isik
    
    
    
    
    
    
    
    
    
    
    
    
    
    ;; Watt degeri varsa ve priz/cihaz degilse -> aydinlatma
    ((and (> (yukcel:parse-watt upper) 0) 
          (not (yukcel:str-find "PRIZ" upper))
          (not (yukcel:str-find "CAMASIR" upper))
          (not (yukcel:str-find "BULASIK" upper))
          (not (yukcel:str-find "FIRIN" upper))
          (not (yukcel:str-find "KLIMA" upper)))
     "AYD")
    ;; Bilinmeyen
    (T "???")
  )
)

(defun yukcel:varsayilan-guc (tip txt / upper w)
  (setq upper "")
  (if txt (setq upper (strcase (yukcel:tr-normalize txt))))
  (setq w (yukcel:parse-watt upper))
  (cond
    ((= tip "PRZ") (if (> w 0) w 300.0))
    ((= tip "CIH")
      (cond
        ((yukcel:str-find "CAMASIR" upper) 2500.0)
        ((yukcel:str-find "BULASIK" upper) 2500.0)
        ((yukcel:str-find "KURUTUCU" upper) 2500.0)
        ((yukcel:str-find "FIRIN" upper) 2000.0)
        ((yukcel:str-find "ANKASTRE" upper) 2000.0)
        ((yukcel:str-find "OCAK" upper) 2000.0)
        ((yukcel:str-find "SOFBEN" upper) 2000.0)
        ((yukcel:str-find "TERMOSIFON" upper) 2000.0)
        ((yukcel:str-find "BOYLER" upper) 2000.0)
        ((yukcel:str-find "KLIMA" upper) 1500.0)
        ((yukcel:str-find "KOMBI" upper) 2000.0)
        ((yukcel:str-find "SOBA" upper) 2000.0)
        ((yukcel:str-find "BUZDOLABI" upper) 300.0)
        ((yukcel:str-find "ASPIRATOR" upper) 300.0)
        ((yukcel:str-find "DAVLUMBAZ" upper) 300.0)
        ((yukcel:str-find "MIKRODALGA" upper) 1500.0)
        ((yukcel:str-find "POMPA" upper) 1500.0)
        ((yukcel:str-find "MOTOR" upper) 1500.0)
        
        
        
        
        
        
        
        
        
        (T (if (> w 0) w 1500.0))
      )
    )
    ((= tip "AYD") (if (> w 0) w 0.0))
    (T 0.0)
  )
)

;;; ---- circuit tracing and block collection ----
;;; Mesafeye gore siralama (basit bubble sort)
(defun yukcel:sort-by-dist (lst / sorted changed temp i)
  (setq sorted lst)
  (setq changed T)
  (while changed
    (setq changed nil)
    (setq i 0)
    (while (< i (1- (length sorted)))
      (if (> (car (nth i sorted)) (car (nth (1+ i) sorted)))
        (progn
          (setq temp (nth i sorted))
          (setq sorted (yukcel:list-replace sorted i (nth (1+ i) sorted)))
          (setq sorted (yukcel:list-replace sorted (1+ i) temp))
          (setq changed T)
        )
      )
      (setq i (1+ i))
    )
  )
  sorted
)

;;; Liste'nin n. elemanini degistir
(defun yukcel:list-replace (lst idx val / i result)
  (setq result nil i 0)
  (foreach item lst
    (if (= i idx)
      (setq result (cons val result))
      (setq result (cons item result))
    )
    (setq i (1+ i))
  )
  (reverse result)
)

;;; Listenin ilk n elemanini al
(defun yukcel:first-n (lst n / result i)
  (setq result nil i 0)
  (foreach item lst
    (if (< i n)
      (setq result (cons item result))
    )
    (setq i (1+ i))
  )
  (reverse result)
)

;;; ============================================================
;;; ADIM 2: LINYE TAKIBI (LINE + LWPOLYLINE + POLYLINE)
;;; ============================================================

;;; Bir hat entity'sine yakin (crossing) tum hat entity'lerini bul
;;; Hat'in bbox'u + margin ile ssget "_C" yapar
(defun yukcel:hats-near-hat (ent margin / verts v
                              min-x min-y max-x max-y
                              ss lst e etype)
  (setq verts (yukcel:hat-vertices ent))
  (if (not verts) nil
    (progn
      (setq min-x 1e20 min-y 1e20 max-x -1e20 max-y -1e20)
      (foreach v verts
        (if (< (car v) min-x)  (setq min-x (car v)))
        (if (< (cadr v) min-y) (setq min-y (cadr v)))
        (if (> (car v) max-x)  (setq max-x (car v)))
        (if (> (cadr v) max-y) (setq max-y (cadr v)))
      )
      ;; Margin ekle - endpoint'leri biraz disarida olan hatlar da yakalansin
      (setq min-x (- min-x margin) min-y (- min-y margin))
      (setq max-x (+ max-x margin) max-y (+ max-y margin))
      (setq ss (ssget "_C"
        (list min-x min-y)
        (list max-x max-y)
      ))
      (setq lst nil)
      (if ss
        (foreach e (yukcel:ss-to-list ss)
          (setq etype (yukcel:get-type e))
          (if (or (= etype "LINE") (= etype "LWPOLYLINE") (= etype "POLYLINE"))
            (setq lst (cons e lst))
          )
        )
      )
      lst
    )
  )
)

;;; Entity'nin rengini al (DXF 62 kodu, yoksa 256=BYLAYER)
(defun yukcel:get-color (ent / edata clr)
  (setq edata (entget ent))
  (setq clr (assoc 62 edata))
  (if clr (cdr clr) 256)
)

;;; Iki hat ayni layer ve renkte mi?
(defun yukcel:same-layer-color (ent1 ent2)
  (and (= (yukcel:get-layer ent1) (yukcel:get-layer ent2))
       (= (yukcel:get-color ent1) (yukcel:get-color ent2)))
)

;;; Dizi algoritmasi - endpoint tabanli baglanti tespiti
;;; OPTIMIZASYON: Her hat'in bbox'u etrafinda crossing secim ile
;;; yakin hatlari bulur. Boylece hat'in govdesine baglanan dallar da tespit edilir.
;;; EK KONTROL: Aday hat, baslangic hatti ile ayni layer ve renkte olmali.
(defun yukcel:trace-linye (start-ent / dizi idx current-hat
                            nearby candidate conn-type
                            ref-layer ref-color)
  ;; Referans layer ve renk: kullanicinin sectigi ilk hat
  (setq ref-layer (yukcel:get-layer start-ent))
  (setq ref-color (yukcel:get-color start-ent))
  
  ;; Dizi baslat
  (setq dizi (list start-ent))
  (setq idx 0)
  
  (princ (strcat "\n  Referans katman: " ref-layer
                 ", renk: " (itoa ref-color)))
  
  (while (< idx (length dizi))
    (setq current-hat (nth idx dizi))
    
    ;; Current hat'in bbox'u etrafindaki tum hatlari bul
    (setq nearby (yukcel:hats-near-hat current-hat 5.0))
    
    (foreach candidate nearby
      (if (and (not (equal candidate current-hat))
               (not (yukcel:member-ent candidate dizi))
               ;; Ayni layer ve renk kontrolu
               (= (yukcel:get-layer candidate) ref-layer)
               (= (yukcel:get-color candidate) ref-color))
        (progn
          (setq conn-type (yukcel:hat-connection-type current-hat candidate))
          (if (or (= conn-type "EP-EP") (= conn-type "EP-BODY"))
            (setq dizi (append dizi (list candidate)))
          )
        )
      )
    )
    
    (setq idx (1+ idx))
    (if (= (rem idx 20) 0)
      (princ (strcat "\r  Tarama: " (itoa idx) "/" (itoa (length dizi)) "..."))
    )
  )
  
  (princ (strcat "\n  Linye: " (itoa (length dizi)) " hat bulundu."))
  dizi
)

;;; ============================================================
;;; BLOK TOPLAMA - SEGMENT BAZLI TARAMA
;;; ============================================================
;;; Strateji:
;;;   1. Her hat'in her segmentini tek tek dolasiriz
;;;   2. Her segment icin kendi kucuk bbox'unu hesaplariz
;;;   3. O kucuk alanda ssget "_C" ile INSERT arariz
;;;   4. Bulunan blogun insertion point'inin segmente GERCEK
;;;      mesafesini olceriz (yukcel:point-to-seg-dist ile)
;;;   5. Mesafe esik degerinin altindaysa blok listeye eklenir
;;;   6. Ayni blok birden fazla eklenmez
;;;
;;; Neden eski yontem calismiyordu:
;;;   Eski yontem TUM hatlarin TOPLAM bbox'unu aliyordu (devasa alan)
;;;   sonra 50 birim genisletiyordu. Bu ya cok fazla blok buluyor
;;;   (komsu linye bloklari dahil) ya da hic bulamiyordu.
;;;   Yeni yontem her segmenti kendi kucuk penceresinde tarar.
;;; ============================================================

;;; Blok arama: Segment bbox margin degeri
;;; Kullanici degistirebilir: (setq *yukcel-blok-margin* 30.0)
;;; NOT: Varsayilan deger dosya basinda tanimlidir.

;;; ============================================================
;;; BLOK TOPLAMA - HAT BAZLI CROSSING (v14 mantigi)
;;; ============================================================
;;; Her hat entity'si icin:
;;;   1. Tum vertex noktalarini al (hat-vertices)
;;;   2. Min/max bbox hesapla + margin
;;;   3. ssget "C" ile tum layerlardan INSERT ara
;;;   4. Bulunanlari ekle, tekrarlari atla
;;;
;;; Segment'e ayirma YOK - hat ne kadar uzun/karmasik olursa olsun
;;; entity'nin kendi bbox'u kullanilir. Bu v14'un calisan yontemidir.
;;; ============================================================

;;; Bulunan hatlara degen bloklari topla
(defun yukcel:collect-blocks-on-hats (hat-list / blok-list h verts v
                                       min-x min-y max-x max-y
                                       margin ss e)
  (setq blok-list nil)
  (setq margin *yukcel-blok-margin*)
  
  ;; Her hat'i tek tek dolasiriz
  (foreach h hat-list
    (setq verts (yukcel:hat-vertices h))
    (if verts
      (progn
        ;; Bu hat'in tum vertex'lerinden bbox hesapla
        (setq min-x 1e20 min-y 1e20 max-x -1e20 max-y -1e20)
        (foreach v verts
          (if v
            (progn
              (if (< (car v) min-x)  (setq min-x (car v)))
              (if (< (cadr v) min-y) (setq min-y (cadr v)))
              (if (> (car v) max-x)  (setq max-x (car v)))
              (if (> (cadr v) max-y) (setq max-y (cadr v)))
            )
          )
        )
        ;; Margin ekle
        (setq min-x (- min-x margin) min-y (- min-y margin))
        (setq max-x (+ max-x margin) max-y (+ max-y margin))
        
        ;; Bu alanda INSERT ara - tum layerlardan
        (setq ss (ssget "_C"
          (list min-x min-y)
          (list max-x max-y)
          '((0 . "INSERT"))
        ))
        
        ;; Bulunan her bloku ekle - sadece lejantta tanimli olanlar
        (if ss
          (foreach e (yukcel:ss-to-list ss)
            (if (and (not (yukcel:member-ent e blok-list))
                     (assoc (yukcel:get-block-name e) *yukcel-lejant*))
              (setq blok-list (cons e blok-list))
            )
          )
        )
      )
    )
  ) ; foreach h
  
  (reverse blok-list)
)

;;; Blok hatlarin segmentlerinden birine dokuniyor mu?
;;; (Geriye uyumluluk icin korunuyor)
(defun yukcel:block-touches-hats (blk hat-list / bpt touches segs seg d)
  (setq bpt (yukcel:get-insert-pt blk))
  (setq touches nil)
  (if bpt
    (foreach h hat-list
      (if (not touches)
        (progn
          (setq segs (yukcel:hat-segments h))
          (foreach seg segs
            (if (not touches)
              (progn
                (setq d (yukcel:point-to-seg-dist bpt (car seg) (cadr seg)))
                (if (< d *yukcel-blok-margin*)
                  (setq touches T)
                )
              )
            )
          )
        )
      )
    )
  )
  touches
)

;;; ============================================================
;;; KABLO UZUNLUGU HESABI
;;; ============================================================

;;; Hat listesinin toplam segment uzunlugunu hesapla (birim cinsinden)
(defun yukcel:calc-cable-length (hat-list / total-len len)
  (setq total-len 0.0)
  (foreach h hat-list
    (if (setq len (ep:curve-length h))
      (setq total-len (+ total-len len))
    )
  )
  total-len
)

;;; ---- circuit analysis ----
(defun yukcel:analyze-linye (linye-no blok-list / items e blk-name blk-layer
                               lejant-entry tip guc item linye-tipi
                               ayd-cnt ayd-w prz-cnt prz-w cih-cnt cih-w
                               anh-cnt bua-cnt unk-cnt toplam-w sorti
                               kablo sigorta attrib-w attrib-txt combined-txt)
  (setq items nil)
  (setq ayd-cnt 0 ayd-w 0.0 prz-cnt 0 prz-w 0.0 
        cih-cnt 0 cih-w 0.0 anh-cnt 0 bua-cnt 0 unk-cnt 0)
  
  (foreach e blok-list
    (setq blk-name (yukcel:get-block-name e))
    (setq blk-layer (yukcel:get-layer e))
    (if blk-name
      (progn
        (setq lejant-entry (assoc blk-name *yukcel-lejant*))
        ;; Debug: lejant eslesme durumunu goster
        (princ (strcat "\n      " blk-name
          (if lejant-entry
            (strcat " -> " (yukcel:tip-ad (nth 3 lejant-entry)))
            " -> LEJANTTA YOK")))
        (if lejant-entry
          ;; Lejantta var - v14 ile AYNI format: (blk-name aciklama guc tip)
          ;; tip = (nth 3 lejant-entry), guc = (nth 2 lejant-entry)
          (progn
            (setq tip (nth 3 lejant-entry))
            (setq guc (if (nth 2 lejant-entry) (nth 2 lejant-entry) 0.0))
            ;; Lejant'tan guc 0 ise, bu blogun kendi attribute'undan dene
            (if (= guc 0.0)
              (progn
                (setq attrib-w (yukcel:get-attrib-watt e))
                (if (> attrib-w 0) (setq guc attrib-w))
              )
            )
            (cond
              ;; Zayif akim - tamamen yoksay (items'a ekleme)
              ((= tip "ZAY") nil)
              ;; Anahtar/Buat - sayaci artir ama items'a EKLEME
              ((= tip "ANH") (setq anh-cnt (1+ anh-cnt)))
              ((= tip "BUA") (setq bua-cnt (1+ bua-cnt)))
              ;; Guc tuketen elemanlar - items'a ekle
              ((= tip "AYD") 
                (progn
                  (setq item (list tip blk-name guc blk-layer))
                  (setq items (cons item items))
                  (setq ayd-cnt (1+ ayd-cnt) ayd-w (+ ayd-w guc))
                )
              )
              ((= tip "PRZ")
                (progn
                  (setq item (list tip blk-name guc blk-layer))
                  (setq items (cons item items))
                  (setq prz-cnt (1+ prz-cnt) prz-w (+ prz-w guc))
                )
              )
              ((= tip "CIH")
                (progn
                  (setq item (list tip blk-name guc blk-layer))
                  (setq items (cons item items))
                  (setq cih-cnt (1+ cih-cnt) cih-w (+ cih-w guc))
                )
              )
              ;; Tanimsiz - goster ama sorti sayma
              (T
                (progn
                  (setq item (list "???" blk-name 0.0 blk-layer))
                  (setq items (cons item items))
                  (setq unk-cnt (1+ unk-cnt))
                )
              )
            )
          )
          ;; Lejantta tanimli degil - v14 ile AYNI: bilinmeyenler listesine ekle
          (progn
            (setq item (list "???" blk-name 0.0 blk-layer))
            (setq items (cons item items))
            (setq unk-cnt (1+ unk-cnt))
          )
        )
      )
    )
  )
  
  (setq items (reverse items))
  
  ;; Linye tipi belirle
  (setq linye-tipi
    (cond
      ((> cih-cnt 0) "CIH")
      ((and (> prz-cnt 0) (= ayd-cnt 0)) "PRZ")
      ((and (> ayd-cnt 0) (= prz-cnt 0)) "AYD")
      ((and (> ayd-cnt 0) (> prz-cnt 0)) "KRM")
      (T "???")
    )
  )
  
  ;; Kablo kesiti
  (setq kablo
    (cond
      ((= linye-tipi "AYD") "3x1.5")
      ((= linye-tipi "PRZ") "3x2.5")
      ((= linye-tipi "CIH") "3x2.5")
      ((= linye-tipi "KRM") "3x2.5")
      (T "3x2.5")
    )
  )
  
  ;; Sigorta
  (setq sigorta
    (cond
      ((= linye-tipi "AYD") "B10A")
      ((= linye-tipi "PRZ") "C16A")
      ((= linye-tipi "CIH") "C16A")
      (T "C16A")
    )
  )
  
  (setq toplam-w (+ ayd-w prz-w cih-w))
  (setq sorti (+ ayd-cnt prz-cnt cih-cnt))
  
  (list
    linye-no linye-tipi items
    ayd-cnt ayd-w prz-cnt prz-w cih-cnt cih-w
    anh-cnt bua-cnt unk-cnt
    toplam-w sorti kablo sigorta
  )
)

;;; ============================================================
;;; Settings and labels
;;; ============================================================

(if (not *yukcel-tol*) (setq *yukcel-tol* 1.5))                ; line connection tolerance
(if (not *yukcel-blok-margin*) (setq *yukcel-blok-margin* 25.0)) ; block search margin around lines
(setq *yukcel-lejant* nil)
(setq *yukcel-linyeler* nil)

;;; Display name of an internal type code.
(defun yukcel:tip-ad (tip)
  (cond
    ((= tip "AYD") "AYD")
    ((= tip "PRZ") "PRZ")
    ((= tip "CIH") "CIH")
    ((= tip "ANH") "ANH")
    ((= tip "BUA") "BUA")
    ((= tip "ZAY") "ZAY")
    ((= tip "KRM") "KRM")
    (T "???")
  )
)

;;; Metres per drawing unit: INSUNITS when set, otherwise centimetres.
(defun yukcel:mpu (/ u)
  (setq u (getvar "INSUNITS"))
  (cond
    ((= u 4) 0.001)
    ((= u 5) 0.01)
    ((= u 6) 1.0)
    ((= u 1) 0.0254)
    ((= u 2) 0.3048)
    (T 0.01)
  )
)

;;; ============================================================
;;; Adim 1: lejant
;;; ============================================================

(defun c:YUKCEL-LEJANT (/ *error* pt1 pt2 ss-b ss-t lejant i e blk-name bpt j te ts tp md d yk g tip)
  (defun *error* (m) (ep:on-error m))
  (princ "\n=== YUKCEL - LEJANT OKUMA ===")
  (setq pt1 (getpoint "\nLejant tablosunun SOL-ALT kosesi: "))
  (if (not pt1) (exit))
  (setq pt2 (getcorner pt1 "\nSAG-UST kose: "))
  (if (not pt2) (exit))
  (setq ss-b (ssget "_W"
    (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2)))
    (list (max (car pt1) (car pt2)) (max (cadr pt1) (cadr pt2)))
    '((0 . "INSERT"))))
  (setq ss-t (ssget "_W"
    (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2)))
    (list (max (car pt1) (car pt2)) (max (cadr pt1) (cadr pt2)))
    '((0 . "TEXT,MTEXT"))))
  (if (not ss-b)
    (progn (princ "\nSecilen alanda blok bulunamadi!") (exit))
  )
  (princ (strcat "\nBlok: " (itoa (sslength ss-b))
                 ", metin: " (if ss-t (itoa (sslength ss-t)) "0")))

  ;; Record format: (block-name description power type)
  (setq lejant nil i 0)
  (repeat (sslength ss-b)
    (setq e (ssname ss-b i)
          blk-name (yukcel:get-block-name e)
          bpt (yukcel:get-insert-pt e))
    (if (not (assoc blk-name lejant))
      (progn
        ;; nearest text = description
        (setq yk "" md 1e10)
        (if ss-t
          (progn
            (setq j 0)
            (repeat (sslength ss-t)
              (setq te (ssname ss-t j)
                    tp (yukcel:get-insert-pt te)
                    ts (yukcel:get-text-content te)
                    d (yukcel:dist bpt tp))
              (if (< d md) (setq md d yk (if ts ts "")))
              (setq j (1+ j))
            )
          )
        )
        (setq g (yukcel:parse-watt yk)
              tip (yukcel:tip-belirle blk-name yk))
        (if (and (= g 0.0) (= tip "PRZ")) (setq g 300.0))
        (if (and (= g 0.0) (= tip "CIH")) (setq g (yukcel:varsayilan-guc tip yk)))
        (if (and (= g 0.0) (= tip "AYD")) (setq g (yukcel:get-attrib-watt e)))
        (setq lejant (append lejant (list (list blk-name yk g tip))))
      )
    )
    (setq i (1+ i))
  )
  (setq *yukcel-lejant* lejant)

  (princ "\n\n------------------------------------------------------")
  (princ "\nBlok Adi            Tip  Guc(W)  Aciklama")
  (princ "\n------------------------------------------------------")
  (foreach item lejant
    (princ (strcat "\n"
      (yukcel:pad-right (car item) 20)
      (yukcel:pad-right (yukcel:tip-ad (nth 3 item)) 5)
      (yukcel:pad-right (rtos (nth 2 item) 2 0) 8)
      (substr (cadr item) 1 (min 40 (strlen (cadr item))))))
  )
  (princ "\n------------------------------------------------------")
  (princ (strcat "\n" (itoa (length lejant)) " lejant kaydi olusturuldu."))
  (if (assoc "???" (mapcar '(lambda (x) (cons (nth 3 x) x)) lejant))
    (princ "\nUYARI: ??? tipli kayitlar taninmadi; aciklamalarini kontrol edin.")
  )
  (princ "\nDevam: YUKCEL-LINYE")
  (princ)
)

;;; ============================================================
;;; Adim 2: linyeler
;;; ============================================================

(defun c:YUKCEL-LINYE (/ *error* linye-no devam ent hat-list new-hats blok-list
                         linye-sonuc linye-devam h)
  (defun *error* (m)
    (foreach h hat-list (if (entget h) (redraw h 4)))
    (ep:on-error m))
  (if (not *yukcel-lejant*)
    (progn (princ "\n*** Once YUKCEL-LEJANT komutunu calistirin! ***") (exit))
  )
  (setq *yukcel-linyeler* nil linye-no 0 devam T)
  (princ "\n=== YUKCEL - LINYE TAKIBI ===")
  (princ "\nSol tik : linyenin bir hattini sec (baglantili hatlar otomatik bulunur)")
  (princ "\nSol tik : eksik kalan hatti ayni linyeye ekle")
  (princ "\nSag tik : linyeyi tamamla, sonrakine gec")
  (princ "\nSag tik (bos linyede): bitir\n")

  (while devam
    (setq linye-no (1+ linye-no) hat-list nil linye-devam T)
    (princ (strcat "\n===== LINYE " (itoa linye-no) " ====="))
    (while linye-devam
      (princ (strcat "\n  Linye " (itoa linye-no) " [" (itoa (length hat-list))
                     " hat] - Sol tik=ekle, Sag tik=bitir: "))
      (setq ent (car (entsel)))
      (if (not ent)
        (if (not hat-list)
          (setq linye-devam nil devam nil linye-no (1- linye-no))
          (progn
            (setq linye-devam nil)
            (foreach h hat-list (redraw h 4))
            (setq blok-list (yukcel:collect-blocks-on-hats hat-list))
            (princ (strcat "\n  " (itoa (length blok-list)) " blok bulundu."))
            (setq linye-sonuc (yukcel:analyze-linye linye-no blok-list))
            (setq linye-sonuc (append linye-sonuc (list (yukcel:calc-cable-length hat-list))))
            (setq *yukcel-linyeler* (append *yukcel-linyeler* (list linye-sonuc)))
            (yukcel:print-linye linye-sonuc)
          )
        )
        (if (not (yukcel:is-hat ent))
          (princ (strcat "\n  *** " (yukcel:get-type ent) " - LINE/LWPOLYLINE/POLYLINE secin!"))
          (if (yukcel:member-ent ent hat-list)
            (princ "\n  Bu hat zaten secili.")
            (progn
              (setq new-hats (yukcel:trace-linye ent))
              (foreach h new-hats
                (if (not (yukcel:member-ent h hat-list))
                  (progn (setq hat-list (append hat-list (list h))) (redraw h 3))
                )
              )
              (princ (strcat "\n  Toplam: " (itoa (length hat-list)) " hat"))
            )
          )
        )
      )
    )
  )
  (if *yukcel-linyeler*
    (progn
      (yukcel:print-summary)
      (princ "\nRapor icin: YUKCEL-EXPORT")
    )
  )
  (princ)
)

;;; ============================================================
;;; Output
;;; Circuit record: (no type items ayd-cnt ayd-w prz-cnt prz-w cih-cnt cih-w
;;;                  anh-cnt bua-cnt unk-cnt total-w outlets cable fuse length)
;;; ============================================================

(defun yukcel:print-linye (ls / linye-tip linye-w sorti-cnt cable-len)
  (setq linye-tip (nth 1 ls)
        linye-w (nth 12 ls)
        sorti-cnt (nth 13 ls)
        cable-len (if (nth 16 ls) (nth 16 ls) 0.0))
  (princ (strcat "\n\n-- LINYE " (itoa (nth 0 ls)) " (" (yukcel:tip-ad linye-tip) ") --------------------"))
  (foreach item (nth 2 ls)
    (princ (strcat "\n    "
      (yukcel:pad-right (yukcel:tip-ad (car item)) 5)
      (yukcel:pad-right (cadr item) 18)
      (yukcel:pad-right (strcat (rtos (caddr item) 2 0) "W") 8)
      "[" (if (cadddr item) (cadddr item) "?") "]"))
  )
  (princ "\n    ----")
  (if (> (nth 3 ls) 0)
    (princ (strcat "\n    >> " (yukcel:tip-ad "AYD") ": " (itoa (nth 3 ls)) " sorti, " (rtos (nth 4 ls) 2 0) "W")))
  (if (> (nth 5 ls) 0)
    (princ (strcat "\n    >> " (yukcel:tip-ad "PRZ") ": " (itoa (nth 5 ls)) " sorti, " (rtos (nth 6 ls) 2 0) "W")))
  (if (> (nth 7 ls) 0)
    (princ (strcat "\n    >> " (yukcel:tip-ad "CIH") ": " (itoa (nth 7 ls)) " sorti, " (rtos (nth 8 ls) 2 0) "W")))
  (if (> (nth 11 ls) 0)
    (princ (strcat "\n    >> ???: " (itoa (nth 11 ls)) " adet (tanimsiz - kontrol edin)")))
  (princ (strcat "\n    Sorti: " (itoa sorti-cnt)
                 "  |  Guc: " (rtos linye-w 2 0) "W"
                 "  |  Akim: " (rtos (/ linye-w 220.0) 2 1) "A"
                 "  |  Kablo: " (nth 14 ls)
                 "  |  Sigorta: " (nth 15 ls)))
  (if (> cable-len 0)
    (princ (strcat "\n    Kablo uzunlugu: " (rtos (* cable-len (yukcel:mpu)) 2 1) " m")))
  ;; Warnings (Turkish electrical installation regulation limits)
  (if (and (= linye-tip "AYD") (> (nth 3 ls) 9))
    (princ "\n    *** UYARI: Aydinlatma linyesinde 9'dan fazla sorti! (max 9)"))
  (if (and (or (= linye-tip "PRZ") (= linye-tip "KRM")) (> (nth 5 ls) 7))
    (princ "\n    *** UYARI: Priz linyesinde 7'den fazla sorti! (max 7)"))
  (if (> linye-w 2000.0)
    (princ (strcat "\n    *** UYARI: Linye gucu " (rtos linye-w 2 0) "W > 2000W")))
  (if (and (> sorti-cnt 0) (= linye-w 0.0))
    (princ "\n    *** UYARI: Sorti var ama toplam guc 0W - guc bilgisi eksik!"))
  (princ "\n--------------------------------------------")
)

;;; Totals for the summary, the CSV and the table.
;;; Returns an assoc list.
(defun yukcel:totals (/ toplam-w toplam-sorti ayd-t prz-t cih-t toplam-kablo talep-w talep-a
                        ana-sig ana-kablo faz-w faz-idx)
  (setq toplam-w 0.0 toplam-sorti 0 ayd-t 0.0 prz-t 0.0 cih-t 0.0 toplam-kablo 0.0
        faz-w (list 0.0 0.0 0.0) faz-idx 0)
  (foreach ls *yukcel-linyeler*
    (setq toplam-w (+ toplam-w (nth 12 ls))
          toplam-sorti (+ toplam-sorti (nth 13 ls))
          ayd-t (+ ayd-t (nth 4 ls))
          prz-t (+ prz-t (nth 6 ls))
          cih-t (+ cih-t (nth 8 ls)))
    (if (nth 16 ls) (setq toplam-kablo (+ toplam-kablo (nth 16 ls))))
    (setq faz-w (yukcel:list-replace faz-w (rem faz-idx 3) (+ (nth (rem faz-idx 3) faz-w) (nth 12 ls)))
          faz-idx (1+ faz-idx))
  )
  ;; Demand: 60% of the first 8 kW, 40% of the rest
  (if (<= toplam-w 8000.0)
    (setq talep-w (* toplam-w 0.6))
    (setq talep-w (+ (* 8000.0 0.6) (* (- toplam-w 8000.0) 0.4)))
  )
  ;; 3-phase current: P / (sqrt(3) * 380 * 0.8) = P / 526
  (setq talep-a (/ talep-w 526.0))
  (setq ana-sig
    (cond ((<= talep-a 16.0) 20) ((<= talep-a 20.0) 25) ((<= talep-a 25.0) 32)
          ((<= talep-a 32.0) 40) ((<= talep-a 40.0) 50) ((<= talep-a 50.0) 63)
          ((<= talep-a 63.0) 80) (T 100)))
  (setq ana-kablo
    (cond ((<= ana-sig 20) "4x4") ((<= ana-sig 32) "4x6") ((<= ana-sig 40) "4x10")
          ((<= ana-sig 63) "4x16") ((<= ana-sig 80) "4x25") (T "4x35")))
  (list
    (cons "linye" (length *yukcel-linyeler*))
    (cons "sorti" toplam-sorti)
    (cons "ayd" ayd-t) (cons "prz" prz-t) (cons "cih" cih-t)
    (cons "kurulu" toplam-w)
    (cons "talep" talep-w)
    (cons "akim" talep-a)
    (cons "sigorta" ana-sig)
    (cons "kablo" ana-kablo)
    (cons "kablo-m" (* toplam-kablo (yukcel:mpu)))
    (cons "R" (nth 0 faz-w)) (cons "S" (nth 1 faz-w)) (cons "T" (nth 2 faz-w))
    (cons "denge" (- (apply 'max faz-w) (apply 'min faz-w)))
  )
)

(defun yukcel:tv (k tot) (cdr (assoc k tot)))

(defun yukcel:print-summary (/ tot faz-idx)
  (setq tot (yukcel:totals))
  (princ "\n\n====================================================")
  (princ "\n            YUKCEL - TOPLAM OZET")
  (princ "\n====================================================")
  (princ (strcat "\nLinye sayisi       : " (itoa (yukcel:tv "linye" tot))))
  (princ (strcat "\nSorti sayisi       : " (itoa (yukcel:tv "sorti" tot))))
  (princ (strcat "\nAydinlatma toplam  : " (rtos (yukcel:tv "ayd" tot) 2 0) " W"))
  (princ (strcat "\nPriz toplam        : " (rtos (yukcel:tv "prz" tot) 2 0) " W"))
  (princ (strcat "\nCihaz toplam       : " (rtos (yukcel:tv "cih" tot) 2 0) " W"))
  (princ "\n--------------------------------------------")
  (princ (strcat "\nKurulu guc         : " (rtos (yukcel:tv "kurulu" tot) 2 0) " W"))
  (princ (strcat "\nTalep gucu         : " (rtos (yukcel:tv "talep" tot) 2 0) " W"))
  (princ (strcat "\nTalep akimi (3F)   : " (rtos (yukcel:tv "akim" tot) 2 1) " A"))
  (princ (strcat "\nAna sigorta        : " (itoa (yukcel:tv "sigorta" tot)) " A"))
  (princ (strcat "\nAna kablo          : " (yukcel:tv "kablo" tot) " mm2"))
  (if (> (yukcel:tv "kablo-m" tot) 0)
    (princ (strcat "\nToplam kablo       : " (rtos (yukcel:tv "kablo-m" tot) 2 1) " m")))
  (princ "\n\n--- Faz dagilimi ---")
  (setq faz-idx 0)
  (foreach ls *yukcel-linyeler*
    (princ (strcat "\nLinye " (itoa (nth 0 ls)) " (" (yukcel:tip-ad (nth 1 ls)) "): "
                   (rtos (nth 12 ls) 2 0) "W -> " (nth (rem faz-idx 3) '("R" "S" "T"))))
    (setq faz-idx (1+ faz-idx))
  )
  (princ (strcat "\nR: " (rtos (yukcel:tv "R" tot) 2 0) " W   S: " (rtos (yukcel:tv "S" tot) 2 0)
                 " W   T: " (rtos (yukcel:tv "T" tot) 2 0) " W"))
  (princ (strcat "\nDengesizlik: " (rtos (yukcel:tv "denge" tot) 2 0) " W"))
  (princ "\n====================================================")
)

;;; ============================================================
;;; Adim 3: rapor (CSV + cizime tablo)
;;; ============================================================

(defun c:YUKCEL-EXPORT (/ *error* tot rows table faz-idx sira ls faz mpu)
  (defun *error* (m) (ep:on-error m))
  (if (not *yukcel-linyeler*)
    (progn (princ "\n*** Henuz linye verisi yok! Once YUKCEL-LINYE. ***") (exit))
  )
  (ep:begin nil)
  (setq tot (yukcel:totals) mpu (yukcel:mpu))

  ;; Circuit rows
  (setq rows nil table nil faz-idx 0 sira 0)
  (foreach ls *yukcel-linyeler*
    (setq sira (1+ sira)
          faz (nth (rem faz-idx 3) '("R" "S" "T"))
          faz-idx (1+ faz-idx))
    (setq rows (append rows (list (list
      (itoa sira) (itoa (nth 0 ls)) (yukcel:tip-ad (nth 1 ls)) (itoa (nth 13 ls))
      (ep:num (nth 4 ls) 0) (ep:num (nth 6 ls) 0) (ep:num (nth 8 ls) 0) (ep:num (nth 12 ls) 0)
      (ep:num (/ (nth 12 ls) 220.0) 1) (nth 14 ls)
      (if (nth 16 ls) (ep:num (* (nth 16 ls) mpu) 1) "")
      (nth 15 ls) faz ""))))
    (setq table (append table (list (list
      (itoa (nth 0 ls)) (yukcel:tip-ad (nth 1 ls)) (itoa (nth 13 ls))
      (ep:num (nth 12 ls) 0) (ep:num (/ (nth 12 ls) 220.0) 1) (nth 14 ls)
      (if (nth 16 ls) (ep:num (* (nth 16 ls) mpu) 1) "") (nth 15 ls) faz))))
  )

  (ep:csv-save "Yukleme cetvelini kaydet"
    (strcat (ep:dwg-base "Proje") "-YukCet")
    (append
      (list (list "ELEKTRIK IC TESISAT YUKLEME CETVELI")
            (list "Proje" (ep:dwg-base ""))
            (list "")
            (list "Sira" "Devre No" "Tip" "Sorti"
                  "Ayd. Guc (W)" "Priz Guc (W)" "Cihaz Guc (W)"
                  "Toplam Guc (W)" "Akim (A)" "Kablo Cinsi"
                  "Kablo Uz. (m)" "Sigorta" "Faz" "Aciklama"))
      rows
      (list (list "")
            (list "Kurulu Guc (W)" (ep:num (yukcel:tv "kurulu" tot) 0))
            (list "Talep Gucu (W)" (ep:num (yukcel:tv "talep" tot) 0))
            (list "Talep Akimi (A)" (ep:num (yukcel:tv "akim" tot) 1))
            (list "Ana Sigorta (A)" (itoa (yukcel:tv "sigorta" tot)))
            (list "Ana Kablo Kesiti" (yukcel:tv "kablo" tot))
            (list "Faz R (W)" (ep:num (yukcel:tv "R" tot) 0))
            (list "Faz S (W)" (ep:num (yukcel:tv "S" tot) 0))
            (list "Faz T (W)" (ep:num (yukcel:tv "T" tot) 0))
            (list "Faz Dengesizligi (W)" (ep:num (yukcel:tv "denge" tot) 0))
            (list "Toplam Kablo (m)" (ep:num (yukcel:tv "kablo-m" tot) 1)))
    )
  )

  (ep:place-table
    (append
      (list (list "Devre" "Tip" "Sorti" "Guc (W)" "Akim (A)"
                  "Kablo" "Uz. (m)" "Sigorta" "Faz"))
      table
      (list (list "Kurulu guc" "" "" (ep:num (yukcel:tv "kurulu" tot) 0) "" "" "" "" "")
            (list "Talep gucu" "" "" (ep:num (yukcel:tv "talep" tot) 0)
                  (ep:num (yukcel:tv "akim" tot) 1) (yukcel:tv "kablo" tot) "" (strcat (itoa (yukcel:tv "sigorta" tot)) "A") "3F"))
    )
    "EP-TABLO")
  (ep:finish)
  (princ)
)

;;; ============================================================
;;; Bilgi ve ayarlar
;;; ============================================================

(defun c:YUKCEL ()
  (princ "\n====================================================")
  (princ "\n  YUKCEL - Yukleme Cetveli")
  (princ "\n====================================================")
  (princ "\n  1) YUKCEL-LEJANT  : lejant tablosunu oku")
  (princ "\n  2) YUKCEL-LINYE   : linyeleri sec ve analiz et")
  (princ "\n  3) YUKCEL-EXPORT  : CSV raporu + cizime tablo")
  (princ "\n     YUKCEL-AYAR    : tolerans ve arama ayarlari")
  (princ (strcat "\n\n  Baglanti toleransi: " (rtos *yukcel-tol* 2 2)))
  (princ (strcat "\n  Blok arama payi   : " (rtos *yukcel-blok-margin* 2 2)))
  (princ (strcat "\n  1 cizim birimi    : " (rtos (yukcel:mpu) 2 4) " m (INSUNITS)"))
  (princ "\n====================================================")
  (princ)
)

(defun c:YUKCEL-AYAR (/ v)
  (setq v (getdist (strcat "\nHat baglanti toleransi <" (rtos *yukcel-tol* 2 2) ">: ")))
  (if v (setq *yukcel-tol* v))
  (setq v (getdist (strcat "\nBlok arama payi <" (rtos *yukcel-blok-margin* 2 2) ">: ")))
  (if v (setq *yukcel-blok-margin* v))
  (princ "\nAyarlar guncellendi.")
  (princ)
)

;;; KESIF - Elektrik projesinden malzeme listesi (kesif / metraj) cikarir.
;;; 1) Lejant alanindaki her blok, en yakin aciklama metniyle eslestirilir.
;;; 2) Cizimdeki tum bu bloklar sayilir.
;;; 3) Secilen kablo katman+renk gruplarinin uzunlugu metre olarak hesaplanir.
;;; 4) Sonuc CSV dosyasina (Excel) ve istenirse cizime tablo olarak yazilir.

(if (not *KESIF-OLCEK*) (setq *KESIF-OLCEK* 50.0))

(defun kesif:color-name (c)
  (cond
    ((= c 1) "Kirmizi")
    ((= c 2) "Sari")
    ((= c 3) "Yesil")
    ((= c 4) "Cyan")
    ((= c 5) "Mavi")
    ((= c 6) "Magenta")
    ((= c 7) "Beyaz")
    (T (strcat "Renk-" (itoa c)))
  )
)

;;; Effective color number of an entity (ByLayer / ByBlock -> layer color).
(defun kesif:color (ent / ed c lay)
  (setq ed (entget ent) c (cdr (assoc 62 ed)))
  (if (or (null c) (= c 256) (= c 0))
    (progn
      (setq lay (tblsearch "LAYER" (cdr (assoc 8 ed))))
      (if lay (abs (cdr (assoc 62 lay))) 7)
    )
    (abs c)
  )
)

(defun kesif:text (ent / ed typ s)
  (setq ed (entget ent) typ (cdr (assoc 0 ed)))
  (cond
    ((= typ "TEXT") (cdr (assoc 1 ed)))
    ((= typ "MTEXT")
      (setq s (cdr (assoc 1 ed)))
      (setq s (ep:replace-all s "\\P" " "))
      (setq s (ep:replace-all s "{" ""))
      (setq s (ep:replace-all s "}" ""))
      s
    )
    (T "")
  )
)

;;; "1:50" -> 50.0, "100" -> 100.0
(defun kesif:parse-scale (str / pos num)
  (setq pos (vl-string-search ":" str))
  (setq num (atof (if pos (substr str (+ pos 2)) str)))
  (if (> num 0) num nil)
)

;;; Metres per drawing unit, from INSUNITS.
(defun kesif:unit-factor (u)
  (cond
    ((= u 1) 0.0254)
    ((= u 2) 0.3048)
    ((= u 4) 0.001)
    ((= u 5) 0.01)
    ((= u 6) 1.0)
    ((= u 7) 1000.0)
    (T 0.001)
  )
)

(defun kesif:unit-name (u)
  (cond
    ((= u 1) "inc")
    ((= u 2) "fit")
    ((= u 4) "milimetre")
    ((= u 5) "santimetre")
    ((= u 6) "metre")
    ((= u 7) "kilometre")
    (T "tanimsiz (mm kabul edildi)")
  )
)

;;; Adds len to the value stored under key in an assoc list.
(defun kesif:add (key val lst / old)
  (if (setq old (assoc key lst))
    (subst (cons key (+ (cdr old) val)) old lst)
    (append lst (list (cons key val)))
  )
)

(defun c:KESIF (/ *error* s scale insunits factor p1 p2 pmin pmax ss
                 inserts texts dict best bestd d e ed name
                 groups more sel lay col key counts cables row rows sira
                 len total-m proj)
  (defun *error* (m) (ep:on-error m))
  (ep:begin nil)

  (princ "\n============================================")
  (princ "\n  KESIF - Malzeme Listesi")
  (princ "\n============================================")

  ;; --- 1. Scale and units ---
  (setq s (getstring (strcat "\nCizim olcegi (1:50, 1:100 ...) <1:"
                             (rtos *KESIF-OLCEK* 2 0) ">: ")))
  (if (and s (/= s "") (kesif:parse-scale s))
    (setq *KESIF-OLCEK* (kesif:parse-scale s))
  )
  (setq scale *KESIF-OLCEK*
        insunits (getvar "INSUNITS")
        factor (kesif:unit-factor insunits))
  (princ (strcat "\n>> Olcek 1:" (rtos scale 2 0)
                 ", cizim birimi: " (kesif:unit-name insunits)))

  ;; --- 2. Legend ---
  (princ "\n\n--- LEJANT ---")
  (setq p1 (getpoint "\nLejant alaninin birinci kosesi: "))
  (if (not p1) (exit))
  (setq p2 (getcorner p1 "\nIkinci kose: "))
  (if (not p2) (exit))
  (setq pmin (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))
        pmax (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2))))
  (setq ss (ssget "_C" pmin pmax '((0 . "INSERT,TEXT,MTEXT"))))
  (if (not ss)
    (progn (princ "\n>> Lejant alaninda obje bulunamadi.") (exit))
  )
  (setq inserts nil texts nil)
  (foreach e (ep:ss-list ss)
    (setq ed (entget e))
    (if (= (cdr (assoc 0 ed)) "INSERT")
      (setq inserts (cons (list (cdr (assoc 2 ed)) (cdr (assoc 10 ed))) inserts))
      (if (/= (ep:trim (kesif:text e)) "")
        (setq texts (cons (list (ep:trim (kesif:text e)) (cdr (assoc 10 ed))) texts))
      )
    )
  )
  (if (not inserts)
    (progn (princ "\n>> Lejant alaninda blok yok.") (exit))
  )
  ;; Every block name -> nearest text
  (setq dict nil)
  (foreach ins inserts
    (if (not (assoc (car ins) dict))
      (progn
        (setq best (car ins) bestd 1e20)
        (foreach tx texts
          (setq d (distance (ep:2d (cadr ins)) (ep:2d (cadr tx))))
          (if (< d bestd) (setq bestd d best (car tx)))
        )
        (setq dict (append dict (list (cons (car ins) best))))
      )
    )
  )
  (princ (strcat "\n>> " (itoa (length dict)) " blok-malzeme eslesmesi"))

  ;; --- 3. Cable groups (layer + color) ---
  (princ "\n\n--- KABLOLAR ---")
  (setq groups nil more T)
  (while more
    (setq sel (entsel "\nHer kablo turunden bir tane secin (bitirmek icin Enter): "))
    (if sel
      (progn
        (setq lay (cdr (assoc 8 (entget (car sel))))
              col (kesif:color (car sel))
              key (cons lay col))
        (if (member key groups)
          (princ (strcat "\n>> " lay " | " (kesif:color-name col) " zaten listede"))
          (progn
            (setq groups (append groups (list key)))
            (princ (strcat "\n>> Eklendi: " lay " | " (kesif:color-name col)))
          )
        )
      )
      (setq more nil)
    )
  )

  ;; --- 4. Counting ---
  (princ "\n\n--- SAYIM ---")
  (setq counts nil)
  (setq ss (ssget "_X" '((0 . "INSERT"))))
  (foreach e (ep:ss-list ss)
    (setq name (cdr (assoc 2 (entget e))))
    (if (assoc name dict) (setq counts (kesif:add name 1 counts)))
  )
  (setq cables nil)
  (foreach g groups
    (setq key (strcat (car g) " | " (kesif:color-name (cdr g))))
    (setq ss (ssget "_X" (list '(0 . "LINE,ARC,LWPOLYLINE,POLYLINE,SPLINE") (cons 8 (car g)))))
    (foreach e (ep:ss-list ss)
      (if (and (= (kesif:color e) (cdr g)) (setq len (ep:curve-length e)))
        (setq cables (kesif:add key len cables))
      )
    )
  )
  ;; drawing units -> metres
  (setq cables (mapcar '(lambda (c) (cons (car c) (* (cdr c) scale factor))) cables))

  ;; --- 5. Output ---
  (setq rows (list (list "Sira" "Malzeme / Is Tanimi" "Birim" "Miktar"))
        sira 0)
  (foreach c counts
    (setq sira (1+ sira))
    (setq rows (append rows (list (list (itoa sira) (cdr (assoc (car c) dict)) "Adet" (itoa (cdr c))))))
  )
  (setq total-m 0.0)
  (foreach c cables
    (setq sira (1+ sira) total-m (+ total-m (cdr c)))
    (setq rows (append rows (list (list (itoa sira) (car c) "m" (ep:num (cdr c) 2)))))
  )

  (princ "\n\n============================================")
  (princ "\n  KESIF SONUCLARI")
  (princ "\n============================================")
  (foreach r rows
    (princ (strcat "\n" (ep:pad (nth 0 r) 5) (ep:pad (nth 1 r) 42) (ep:pad (nth 2 r) 6) (nth 3 r)))
  )
  (princ "\n--------------------------------------------")
  (princ (strcat "\n  Toplam " (itoa sira) " kalem"
                 (if (> total-m 0) (strcat ", kablo " (rtos total-m 2 2) " m") "")))

  (if (> sira 0)
    (progn
      (setq proj (strcat (ep:dwg-base "Proje") "-Kesif"))
      (ep:csv-save "Kesif listesini kaydet" proj
        (append
          (list (list "ELEKTRIK TESISATI KESIF OZETI")
                (list "Proje" (ep:dwg-base ""))
                (list "Olcek" (strcat "1:" (rtos scale 2 0)))
                (list "")
                (list "Sira No" "Poz No" "Malzeme / Is Tanimi" "Birim" "Miktar" "Birim Fiyat" "Toplam"))
          (mapcar '(lambda (r) (list (nth 0 r) "" (nth 1 r) (nth 2 r) (nth 3 r) "" "")) (cdr rows))
        )
      )
      (ep:place-table rows "EP-TABLO")
    )
  )
  (ep:finish)
  (princ)
)

;;; TOPLA - Secilen cizgi, yay, daire ve polyline uzunluklarini toplar.

(defun c:TOPLA (/ *error* ss ents e typ len n-line n-arc n-poly n-other
                  t-line t-arc t-poly t-other total)
  (defun *error* (m) (ep:on-error m))
  (ep:begin nil)
  (princ "\nUzunlugu toplanacak objeleri secin: ")
  (setq ss (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,POLYLINE,ELLIPSE,SPLINE"))))
  (if (not ss)
    (princ "\nUygun obje secilmedi.")
    (progn
      (setq n-line 0 n-arc 0 n-poly 0 n-other 0
            t-line 0.0 t-arc 0.0 t-poly 0.0 t-other 0.0)
      (foreach e (ep:ss-list ss)
        (setq typ (cdr (assoc 0 (entget e)))
              len (ep:curve-length e))
        (if len
          (cond
            ((= typ "LINE")
              (setq n-line (1+ n-line) t-line (+ t-line len)))
            ((member typ '("ARC" "CIRCLE"))
              (setq n-arc (1+ n-arc) t-arc (+ t-arc len)))
            ((member typ '("LWPOLYLINE" "POLYLINE"))
              (setq n-poly (1+ n-poly) t-poly (+ t-poly len)))
            (T
              (setq n-other (1+ n-other) t-other (+ t-other len)))
          )
        )
      )
      (setq total (+ t-line t-arc t-poly t-other))
      (princ "\n----------------------------------------")
      (if (> n-line 0)
        (princ (strcat "\n  Dogrular          (" (itoa n-line) ") : " (rtos t-line 2 2))))
      (if (> n-arc 0)
        (princ (strcat "\n  Yay + daire  (" (itoa n-arc) ") : " (rtos t-arc 2 2))))
      (if (> n-poly 0)
        (princ (strcat "\n  Polyline'lar      (" (itoa n-poly) ") : " (rtos t-poly 2 2))))
      (if (> n-other 0)
        (princ (strcat "\n  Elips + spline (" (itoa n-other) ") : " (rtos t-other 2 2))))
      (princ "\n----------------------------------------")
      (princ (strcat "\n  TOPLAM UZUNLUK : " (rtos total 2 2) " birim"))
      (princ "\n----------------------------------------")
    )
  )
  (ep:finish)
  (princ)
)

;;; KABLO - Ortogonal kablo rotalama (duvara paralel, 90 derece donuslu).
;;; Kullanici noktalari tiklar; her iki nokta arasinda en yakin duvar/cizgi
;;; bulunur ve kablo ona sabit mesafede, yalniz yatay/dikey ilerler.

;;; --- GLOBAL AYARLAR ---
(if (not *KB-OFFSET*) (setq *KB-OFFSET* 6.0))        ; distance from the reference line
(if (not *KB-LAYER*)  (setq *KB-LAYER* "E-KABLO"))
(if (not *KB-COLOR*)  (setq *KB-COLOR* 1))           ; red
(if (not *KB-ARAMA*)  (setq *KB-ARAMA* 150.0))       ; search radius
(setq *KB-EXCLUDE* nil)

;;; ============================================================
;;; GEOMETRI YARDIMCILARI
;;; ============================================================

(defun kb:px (p) (car p))
(defun kb:py (p) (cadr p))
(defun kb:2d (p) (list (kb:px p) (kb:py p)))

(defun kb:dist (p1 p2)
  (sqrt (+ (expt (- (kb:px p2) (kb:px p1)) 2)
           (expt (- (kb:py p2) (kb:py p1)) 2)))
)

(defun kb:midpt (p1 p2)
  (list (/ (+ (kb:px p1) (kb:px p2)) 2.0)
        (/ (+ (kb:py p1) (kb:py p2)) 2.0))
)

;;; Noktadan dogru parcasina en yakin nokta
(defun kb:closest-on-seg (pt a b / dx dy len2 t1)
  (setq dx (- (kb:px b) (kb:px a)))
  (setq dy (- (kb:py b) (kb:py a)))
  (setq len2 (+ (* dx dx) (* dy dy)))
  (if (< len2 1e-10)
    a
    (progn
      (setq t1 (/ (+ (* (- (kb:px pt) (kb:px a)) dx)
                     (* (- (kb:py pt) (kb:py a)) dy))
                  len2))
      (setq t1 (max 0.0 (min 1.0 t1)))
      (list (+ (kb:px a) (* t1 dx))
            (+ (kb:py a) (* t1 dy)))
    )
  )
)

;;; Iki dogrunun kesisim noktasi (sinirsiz uzatilmis)
(defun kb:line-intersect (a1 a2 b1 b2 / dx1 dy1 dx2 dy2 denom t1)
  (setq dx1 (- (kb:px a2) (kb:px a1)))
  (setq dy1 (- (kb:py a2) (kb:py a1)))
  (setq dx2 (- (kb:px b2) (kb:px b1)))
  (setq dy2 (- (kb:py b2) (kb:py b1)))
  (setq denom (- (* dx1 dy2) (* dy1 dx2)))
  (if (< (abs denom) 1e-10)
    nil
    (progn
      (setq t1 (/ (- (* (- (kb:px b1) (kb:px a1)) dy2)
                     (* (- (kb:py b1) (kb:py a1)) dx2))
                  denom))
      (list (+ (kb:px a1) (* t1 dx1))
            (+ (kb:py a1) (* t1 dy1)))
    )
  )
)

;;; Bir dogunun birim normal vektoru
(defun kb:normal (a b / dx dy len)
  (setq dx (- (kb:px b) (kb:px a)))
  (setq dy (- (kb:py b) (kb:py a)))
  (setq len (sqrt (+ (* dx dx) (* dy dy))))
  (if (< len 1e-10)
    (list 0.0 1.0)
    (list (/ (- dy) len) (/ dx len))
  )
)

;;; Bir dogunun yon vektoru
(defun kb:direction (a b / dx dy len)
  (setq dx (- (kb:px b) (kb:px a)))
  (setq dy (- (kb:py b) (kb:py a)))
  (setq len (sqrt (+ (* dx dx) (* dy dy))))
  (if (< len 1e-10)
    (list 1.0 0.0)
    (list (/ dx len) (/ dy len))
  )
)

;;; ============================================================
;;; GECICI CIZGIYE EN YAKIN LINE/POLYLINE SEGMENTI BUL
;;; ============================================================
;;; Iki nokta arasindaki hayali cizgiye en yakin segment
;;; Olcut: segmentin orta noktasinin hayali cizgiye mesafesi
;;; + hayali cizginin orta noktasinin segmente mesafesi

(defun kb:en-yakin-seg-bul (pa pb arama-r /
                            ss i ent ed etype
                            best-dist best-seg best-p1 best-p2
                            p1 p2 pts j
                            mid-hayali mid-seg
                            d1 d2 d-total
                            cpt1 cpt2
                            min-x min-y max-x max-y)
  (setq best-dist 1e20)
  (setq best-seg nil)
  (setq mid-hayali (kb:midpt pa pb))

  ;; Arama bolgesi: iki noktayi kapsayan kutu + margin
  (setq min-x (- (min (kb:px pa) (kb:px pb)) arama-r))
  (setq min-y (- (min (kb:py pa) (kb:py pb)) arama-r))
  (setq max-x (+ (max (kb:px pa) (kb:px pb)) arama-r))
  (setq max-y (+ (max (kb:py pa) (kb:py pb)) arama-r))

  ;; LINE entities
  (setq ss (ssget "C"
             (list min-x min-y)
             (list max-x max-y)
             '((0 . "LINE"))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        ;; Kendi cizdiklerimizi haric tut
        (if (not (member ent *KB-EXCLUDE*))
          (progn
            (setq ed (entget ent))
            ;; Kablo layer'indaki cizgileri atla
            ;; (daha once cizilmis kablolar haric - onlar ayri kontrol)
            (setq p1 (kb:2d (cdr (assoc 10 ed))))
            (setq p2 (kb:2d (cdr (assoc 11 ed))))
            (if (> (kb:dist p1 p2) 0.5)
              (progn
                ;; Mesafe hesabi:
                ;; Hayali cizginin orta noktasindan segmente mesafe
                (setq cpt1 (kb:closest-on-seg mid-hayali p1 p2))
                (setq d1 (kb:dist mid-hayali cpt1))
                ;; Segmentin orta noktasindan hayali cizgiye mesafe
                (setq mid-seg (kb:midpt p1 p2))
                (setq cpt2 (kb:closest-on-seg mid-seg pa pb))
                (setq d2 (kb:dist mid-seg cpt2))
                ;; Kombine mesafe
                (setq d-total (min d1 d2))
                (if (< d-total best-dist)
                  (progn
                    (setq best-dist d-total)
                    (setq best-p1 p1)
                    (setq best-p2 p2)
                    (setq best-seg ent)
                  )
                )
              )
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )

  ;; LWPOLYLINE entities
  (setq ss (ssget "C"
             (list min-x min-y)
             (list max-x max-y)
             '((0 . "LWPOLYLINE"))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (if (not (member ent *KB-EXCLUDE*))
          (progn
            (setq ed (entget ent))
            (setq pts '())
            (foreach pair ed
              (if (= (car pair) 10)
                (setq pts (cons (list (cadr pair) (caddr pair)) pts))
              )
            )
            (setq pts (reverse pts))
            ;; Kapali polyline
            (if (= (logand (cdr (assoc 70 ed)) 1) 1)
              (setq pts (append pts (list (car pts))))
            )
            ;; Her segment icin kontrol
            (setq j 0)
            (while (< j (1- (length pts)))
              (setq p1 (nth j pts))
              (setq p2 (nth (1+ j) pts))
              (if (> (kb:dist p1 p2) 0.5)
                (progn
                  (setq cpt1 (kb:closest-on-seg mid-hayali p1 p2))
                  (setq d1 (kb:dist mid-hayali cpt1))
                  (setq mid-seg (kb:midpt p1 p2))
                  (setq cpt2 (kb:closest-on-seg mid-seg pa pb))
                  (setq d2 (kb:dist mid-seg cpt2))
                  (setq d-total (min d1 d2))
                  (if (< d-total best-dist)
                    (progn
                      (setq best-dist d-total)
                      (setq best-p1 p1)
                      (setq best-p2 p2)
                      (setq best-seg ent)
                    )
                  )
                )
              )
              (setq j (1+ j))
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )

  (if best-seg
    (list best-dist best-p1 best-p2 best-seg)
    nil
  )
)

;;; ============================================================
;;; MEVCUT KABLOYA EN YAKIN SEGMENT BUL
;;; ============================================================
;;; Daha once cizilmis kablolar varsa onlara 6cm yaklasir

(defun kb:en-yakin-kablo-bul (pa pb arama-r /
                               ss i ent ed p1 p2
                               best-dist best-p1 best-p2 best-ent
                               cpt1 d1 mid-hayali pts j
                               min-x min-y max-x max-y)
  (setq best-dist 1e20)
  (setq mid-hayali (kb:midpt pa pb))

  (setq min-x (- (min (kb:px pa) (kb:px pb)) arama-r))
  (setq min-y (- (min (kb:py pa) (kb:py pb)) arama-r))
  (setq max-x (+ (max (kb:px pa) (kb:px pb)) arama-r))
  (setq max-y (+ (max (kb:py pa) (kb:py pb)) arama-r))

  ;; Kablo layer'indaki LINE'lar
  (setq ss (ssget "C"
             (list min-x min-y)
             (list max-x max-y)
             (list (cons 0 "LINE") (cons 8 *KB-LAYER*))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (if (not (member ent *KB-EXCLUDE*))
          (progn
            (setq ed (entget ent))
            (setq p1 (kb:2d (cdr (assoc 10 ed))))
            (setq p2 (kb:2d (cdr (assoc 11 ed))))
            (setq cpt1 (kb:closest-on-seg mid-hayali p1 p2))
            (setq d1 (kb:dist mid-hayali cpt1))
            (if (< d1 best-dist)
              (progn
                (setq best-dist d1)
                (setq best-p1 p1)
                (setq best-p2 p2)
                (setq best-ent ent)
              )
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )

  ;; Kablo layer'indaki POLYLINE'lar
  (setq ss (ssget "C"
             (list min-x min-y)
             (list max-x max-y)
             (list (cons 0 "LWPOLYLINE") (cons 8 *KB-LAYER*))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (if (not (member ent *KB-EXCLUDE*))
          (progn
            (setq ed (entget ent))
            (setq pts '())
            (foreach pair ed
              (if (= (car pair) 10)
                (setq pts (cons (list (cadr pair) (caddr pair)) pts))
              )
            )
            (setq pts (reverse pts))
            (setq j 0)
            (while (< j (1- (length pts)))
              (setq p1 (nth j pts))
              (setq p2 (nth (1+ j) pts))
              (setq cpt1 (kb:closest-on-seg mid-hayali p1 p2))
              (setq d1 (kb:dist mid-hayali cpt1))
              (if (< d1 best-dist)
                (progn
                  (setq best-dist d1)
                  (setq best-p1 p1)
                  (setq best-p2 p2)
                  (setq best-ent ent)
                )
              )
              (setq j (1+ j))
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )

  (if (and best-ent (< best-dist (* *KB-OFFSET* 4)))
    (list best-dist best-p1 best-p2 best-ent)
    nil
  )
)

;;; ============================================================
;;; SEGMENT ICIN REFERANS VE OFFSET HATTI BUL
;;; ============================================================
;;; Donus: (list ref-p1 ref-p2 off-line-coord ref-yatay-mi taraf)
;;; veya nil

(defun kb:segment-ref-bul (pa pb offset /
                            ref-sonuc kablo-sonuc
                            ref-p1 ref-p2 norm proj-a
                            ref-dx ref-dy ref-yatay-mi
                            taraf off-coord)

  ;; Referans bul
  (setq kablo-sonuc (kb:en-yakin-kablo-bul pa pb (* *KB-ARAMA* 0.5)))
  (setq ref-sonuc (kb:en-yakin-seg-bul pa pb *KB-ARAMA*))

  (if (and kablo-sonuc ref-sonuc)
    (if (< (car kablo-sonuc) (car ref-sonuc))
      (setq ref-sonuc kablo-sonuc)
    )
  )
  (if (and kablo-sonuc (null ref-sonuc))
    (setq ref-sonuc kablo-sonuc)
  )

  (if (null ref-sonuc)
    nil
    (progn
      (setq ref-p1 (cadr ref-sonuc))
      (setq ref-p2 (caddr ref-sonuc))

      ;; Yon
      (setq ref-dx (abs (- (kb:px ref-p2) (kb:px ref-p1))))
      (setq ref-dy (abs (- (kb:py ref-p2) (kb:py ref-p1))))
      (setq ref-yatay-mi (> ref-dx ref-dy))

      ;; Taraf
      (setq norm (kb:normal ref-p1 ref-p2))
      (setq proj-a (kb:closest-on-seg pa ref-p1 ref-p2))
      (if (> (+ (* (- (kb:px pa) (kb:px proj-a)) (kb:px norm))
                (* (- (kb:py pa) (kb:py proj-a)) (kb:py norm)))
             0)
        (setq taraf 1)
        (setq taraf -1)
      )

      ;; Offset koordinati
      (if ref-yatay-mi
        (setq off-coord (+ (kb:py ref-p1) (* (* (kb:py norm) offset) taraf)))
        (setq off-coord (+ (kb:px ref-p1) (* (* (kb:px norm) offset) taraf)))
      )

      (list ref-p1 ref-p2 off-coord ref-yatay-mi taraf)
    )
  )
)

;;; ============================================================
;;; TUM ROTA HESAPLAMA (2 FAZLI)
;;; ============================================================
;;; Faz 1: Her segment icin referans ve offset hatti bul
;;; Faz 2: Koselerde offset hatlarinin kesisimini hesapla
;;;        Centik ve carprazlik sorunlarini ortadan kaldirir

(defun kb:tum-rota-hesapla (noktalar offset /
                             n i
                             seg-refs  ;; Her segment icin referans bilgisi
                             ref-bilgi
                             rota      ;; Sonuc rota noktalari
                             ;; Segment bilgileri
                             ref-a ref-b
                             yatay-a yatay-b
                             off-a off-b
                             ;; Gecici
                             pa pb kose-pt
                             ilk-off son-off)

  (setq n (length noktalar))
  (if (< n 2) (progn (princ "\nYetersiz nokta.") (list)))

  ;; ============================================
  ;; FAZ 1: Her segment icin referans bul
  ;; ============================================
  (setq seg-refs '())
  (setq i 0)
  (while (< i (1- n))
    (setq pa (nth i noktalar))
    (setq pb (nth (1+ i) noktalar))
    (setq ref-bilgi (kb:segment-ref-bul pa pb offset))
    (if (null ref-bilgi)
      (progn
        (princ (strcat "\n>> Parca " (itoa (1+ i)) ": referans yok"))
        ;; Referans bulunamadiysa onceki segmentin referansini kullan
        (if seg-refs
          (setq ref-bilgi (last seg-refs))
        )
      )
      (princ (strcat "\n>> Parca " (itoa (1+ i)) ": "
                     (if (nth 3 ref-bilgi) "yatay" "dikey")
                     " offset=" (rtos (nth 2 ref-bilgi) 2 1)))
    )
    (setq seg-refs (append seg-refs (list ref-bilgi)))
    (setq i (1+ i))
  )

  ;; ============================================
  ;; FAZ 2: Rota noktalarini hesapla
  ;; ============================================
  ;; Her kose noktasinda:
  ;;   - Onceki segmentin offset hatti
  ;;   - Sonraki segmentin offset hatti
  ;;   Bu ikisinin kesisimi = temiz kose (centik yok)

  (setq rota '())

  ;; --- BASLANGIC NOKTASI ---
  ;; Ilk segmentin offset hattina dik baglan
  ;; Baslangic icin daha comert tolerans: offset*2
  ;; Kullanici biraz disaridan tiklamis olabilir, centik olmasin
  (setq ref-a (nth 0 seg-refs))
  (if ref-a
    (progn
      (setq off-a (nth 2 ref-a))
      (setq yatay-a (nth 3 ref-a))
      (setq pa (nth 0 noktalar))

      ;; Baslangic noktasi offset hizasinda mi?
      ;; Comert tolerans: offset * 2 (12cm) - centik olmasin
      (if yatay-a
        (if (< (abs (- (kb:py pa) off-a)) (* offset 2.0))
          ;; Hizada - direkt offset hattinda basla
          (setq rota (list (list (kb:px pa) off-a)))
          ;; Cok uzak - pa'dan dik inis
          (setq rota (list pa (list (kb:px pa) off-a)))
        )
        (if (< (abs (- (kb:px pa) off-a)) (* offset 2.0))
          (setq rota (list (list off-a (kb:py pa))))
          (setq rota (list pa (list off-a (kb:py pa))))
        )
      )
    )
    ;; Referans yok - sadece baslangic noktasi
    (setq rota (list (nth 0 noktalar)))
  )

  ;; --- ARA KOSE NOKTALARI ---
  ;; Her kullanici noktasi (2. den sonuncuya kadar) bir kose
  (setq i 1)
  (while (< i (1- n))
    (setq ref-a (nth (1- i) seg-refs))  ;; Onceki segmentin referansi
    (setq ref-b (nth i seg-refs))        ;; Sonraki segmentin referansi

    (if (and ref-a ref-b)
      (progn
        (setq off-a (nth 2 ref-a))
        (setq yatay-a (nth 3 ref-a))
        (setq off-b (nth 2 ref-b))
        (setq yatay-b (nth 3 ref-b))

        (cond
          ;; Ikisi de yatay referans - ayni Y'de devam (veya Y degisimi)
          ((and yatay-a yatay-b)
           (if (< (abs (- off-a off-b)) 1.0)
             ;; Ayni Y - kose noktasi: X degisimi
             ;; Kullanici noktasinin X'ini kullan
             (setq rota (append rota
               (list (list (kb:px (nth i noktalar)) off-a))))
             ;; Farkli Y - Z donusu gerekli
             ;; Onceki offset -> dik gecis -> sonraki offset
             (setq rota (append rota
               (list (list (kb:px (nth i noktalar)) off-a)
                     (list (kb:px (nth i noktalar)) off-b))))
           )
          )

          ;; Ikisi de dikey referans
          ((and (not yatay-a) (not yatay-b))
           (if (< (abs (- off-a off-b)) 1.0)
             (setq rota (append rota
               (list (list off-a (kb:py (nth i noktalar))))))
             (setq rota (append rota
               (list (list off-a (kb:py (nth i noktalar)))
                     (list off-b (kb:py (nth i noktalar))))))
           )
          )

          ;; Onceki yatay, sonraki dikey - L kose
          ((and yatay-a (not yatay-b))
           ;; Kesisim noktasi: (off-b, off-a)
           (setq rota (append rota
             (list (list off-b off-a))))
          )

          ;; Onceki dikey, sonraki yatay - L kose
          ((and (not yatay-a) yatay-b)
           ;; Kesisim noktasi: (off-a, off-b)
           (setq rota (append rota
             (list (list off-a off-b))))
          )
        )
      )
      ;; Referans eksik - kullanici noktasini kullan
      (setq rota (append rota (list (nth i noktalar))))
    )

    (setq i (1+ i))
  )

  ;; --- BITIS NOKTASI ---
  ;; Son segmentin offset hattindan bitis noktasina dik cikis
  ;; Bitis icin de comert tolerans: offset * 2
  (setq ref-a (last seg-refs))
  (if ref-a
    (progn
      (setq off-a (nth 2 ref-a))
      (setq yatay-a (nth 3 ref-a))
      (setq pb (last noktalar))

      (if yatay-a
        (progn
          ;; Son offset noktasi (yatay hat boyunca pb'nin X'ine kadar)
          (setq son-off (list (kb:px pb) off-a))
          ;; Eger son rota noktasi ile ayni degilse ekle
          (if (> (kb:dist (last rota) son-off) 0.5)
            (setq rota (append rota (list son-off)))
          )
          ;; pb offset hizasinda mi? Comert tolerans
          (if (> (abs (- (kb:py pb) off-a)) (* offset 2.0))
            ;; Cok uzak - dik cikis pb'ye
            (setq rota (append rota (list pb)))
          )
        )
        (progn
          (setq son-off (list off-a (kb:py pb)))
          (if (> (kb:dist (last rota) son-off) 0.5)
            (setq rota (append rota (list son-off)))
          )
          (if (> (abs (- (kb:px pb) off-a)) (* offset 2.0))
            (setq rota (append rota (list pb)))
          )
        )
      )
    )
    ;; Referans yok
    (setq rota (append rota (list (last noktalar))))
  )

  ;; Temizle
  (kb:rota-temizle rota)
)

;;; ============================================================
;;; ROTA TEMIZLEME
;;; ============================================================
;;; 1. Cok yakin noktalari kaldir (minik segmentler)
;;; 2. Ayni dogrultudaki ardisik segmentleri birlestir

(defun kb:rota-temizle (rota / temiz prev pt
                        sonuc i p1 p2 p3
                        dx1 dy1 dx2 dy2 ayni-yon)
  ;; Adim 1: Cok yakin noktalari kaldir
  (setq temiz (list (car rota)))
  (setq prev (car rota))
  (foreach pt (cdr (reverse (cdr (reverse rota)))) ; ilk ve son haric ortadakiler
    (if (> (kb:dist prev pt) 1.0)
      (progn
        (setq temiz (append temiz (list pt)))
        (setq prev pt)
      )
    )
  )
  ;; Son noktayi mutlaka ekle
  (setq temiz (append temiz (list (last rota))))

  ;; Adim 2: Ayni dogrultudaki ardisik segmentleri birlestir
  ;; Ornegin 3 nokta ayni yatay cizgideyse ortadakini at
  (if (< (length temiz) 3)
    temiz
    (progn
      (setq sonuc (list (car temiz)))
      (setq i 1)
      (while (< i (1- (length temiz)))
        (setq p1 (nth (1- i) temiz))
        (setq p2 (nth i temiz))
        (setq p3 (nth (1+ i) temiz))
        ;; Ayni yon mu?
        (setq dx1 (- (kb:px p2) (kb:px p1)))
        (setq dy1 (- (kb:py p2) (kb:py p1)))
        (setq dx2 (- (kb:px p3) (kb:px p2)))
        (setq dy2 (- (kb:py p3) (kb:py p2)))
        ;; Yatayda ayni mi? (ikisi de dy=0)
        ;; Dikeyde ayni mi? (ikisi de dx=0)
        (setq ayni-yon (or (and (< (abs dy1) 0.5) (< (abs dy2) 0.5))
                          (and (< (abs dx1) 0.5) (< (abs dx2) 0.5))))
        (if (not ayni-yon)
          (setq sonuc (append sonuc (list p2)))
        )
        (setq i (1+ i))
      )
      ;; Son noktayi ekle
      (setq sonuc (append sonuc (list (last temiz))))
      sonuc
    )
  )
)

;;; ============================================================
;;; ROTA CIZIMI
;;; ============================================================

(defun kb:rota-ciz (rota / i p1 p2 ent-list)
  (setq ent-list '())
  (setq i 0)
  (while (< i (1- (length rota)))
    (setq p1 (nth i rota))
    (setq p2 (nth (1+ i) rota))
    (if (> (kb:dist p1 p2) 0.1)
      (progn
        (entmake (list '(0 . "LINE")
                       (cons 8 *KB-LAYER*)
                       (cons 62 *KB-COLOR*)
                       (cons 10 (list (kb:px p1) (kb:py p1) 0.0))
                       (cons 11 (list (kb:px p2) (kb:py p2) 0.0))))
        (setq ent-list (cons (entlast) ent-list))
      )
    )
    (setq i (1+ i))
  )
  ent-list
)

;;; ============================================================
;;; Route length
;;; ============================================================

(defun kb:rota-uzunluk (rota / i total)
  (setq i 0 total 0.0)
  (while (< i (1- (length rota)))
    (setq total (+ total (kb:dist (nth i rota) (nth (1+ i) rota)))
          i (1+ i))
  )
  total
)

;;; ============================================================
;;; KABLO komutu
;;; ============================================================

(defun c:KABLO (/ *error* noktalar pt devam rota ent-list
                  toplam-uzunluk seg-sayisi devam-kablo kablo-no genel-toplam)
  (defun *error* (m) (ep:on-error m))
  (ep:begin '("OSMODE"))

  (princ "\n====================================================")
  (princ "\n  KABLO ROTALAMA")
  (princ "\n====================================================")
  (princ "\n  Sol tik  : Nokta koy (kose/gecis noktasi)")
  (princ "\n  Sag tik  : Bu kabloyu bitir, yeni kablo basla")
  (princ "\n  ESC      : Komuttan cik")
  (princ (strcat "\n  Mesafe   : " (rtos *KB-OFFSET* 2 1)
                 " (KABLO-AYAR ile degistir)"))
  (princ "\n====================================================")

  (ep:ensure-layer *KB-LAYER* *KB-COLOR*)
  (setq *KB-EXCLUDE* nil
        devam-kablo T
        kablo-no 0
        genel-toplam 0.0)

  (while devam-kablo
    (setq kablo-no (1+ kablo-no))
    ;; OSNAP: endpoint, midpoint, intersection, nearest for the first point
    (setvar "OSMODE" 39)
    (setq noktalar '() devam T)
    (setq pt (getpoint (strcat "\nKablo #" (itoa kablo-no)
                               " - Baslangic noktasi [ESC=cik]: ")))
    (if (null pt)
      (setq devam-kablo nil)
      (progn
        (setq noktalar (list (kb:2d pt)))
        (setvar "OSMODE" 0)
        (while devam
          (setq pt (getpoint (append (last noktalar) '(0.0))
                             (strcat "\nNokta " (itoa (1+ (length noktalar)))
                                     " [Sag tik=kabloyu bitir]: ")))
          (if (null pt)
            (setq devam nil)
            (progn
              (setq noktalar (append noktalar (list (kb:2d pt))))
              (grdraw (append (nth (- (length noktalar) 2) noktalar) '(0.0))
                      (append (last noktalar) '(0.0))
                      2 1)
            )
          )
        )
        (if (>= (length noktalar) 2)
          (progn
            (setq rota (kb:tum-rota-hesapla noktalar *KB-OFFSET*))
            (if (and rota (> (length rota) 1))
              (progn
                (setq ent-list (kb:rota-ciz rota))
                (setq *KB-EXCLUDE* (append *KB-EXCLUDE* ent-list))
                (setq seg-sayisi (1- (length rota))
                      toplam-uzunluk (kb:rota-uzunluk rota)
                      genel-toplam (+ genel-toplam toplam-uzunluk))
                (princ (strcat "\n>> OK: " (itoa seg-sayisi) " parca, "
                               (rtos toplam-uzunluk 2 1) " birim"))
              )
              (princ "\n!! Rota olusturulamadi.")
            )
          )
          (princ "\n>> Yetersiz nokta, atlaniyor.")
        )
        (princ "\n----------------------------------------------------")
      )
    )
  )
  (if (> genel-toplam 0.0)
    (princ (strcat "\n>> Toplam kablo: " (rtos genel-toplam 2 1) " birim"))
  )
  (ep:finish)
  (princ "\n>> Kablo cizim modu kapatildi.")
  (princ)
)

;;; ============================================================
;;; Ayarlar
;;; ============================================================

(defun c:KABLO-AYAR (/ tmp)
  (princ "\n--- KABLO AYARLARI ---")
  (setq tmp (getdist (strcat "\nDuvara mesafe <" (rtos *KB-OFFSET* 2 1) ">: ")))
  (if tmp (setq *KB-OFFSET* tmp))
  (setq tmp (getstring T (strcat "\nKatman <" *KB-LAYER* ">: ")))
  (if (/= tmp "") (setq *KB-LAYER* tmp))
  (setq tmp (getint (strcat "\nRenk (1-255) <" (itoa *KB-COLOR*) ">: ")))
  (if (and tmp (> tmp 0) (< tmp 256)) (setq *KB-COLOR* tmp))
  (setq tmp (getdist (strcat "\nReferans arama yaricapi <" (rtos *KB-ARAMA* 2 1) ">: ")))
  (if tmp (setq *KB-ARAMA* tmp))
  (princ "\nAyarlar guncellendi.")
  (princ)
)

;;; LAMBADIZ - Bir alana esit aralikli satir/sutun halinde blok (armatur, dedektor ...) yerlestirir.

(if (not *ld-nx*) (setq *ld-nx* 2))
(if (not *ld-ny*) (setq *ld-ny* 2))
(if (not *ld-sc*) (setq *ld-sc* 1.0))

(defun c:LAMBADIZ (/ *error* p1 p2 name v rot x0 y0 dx dy i j n)
  (defun *error* (m) (ep:on-error m))
  (if (and (setq p1 (getpoint "\nAlanin bir kosesi: "))
           (setq p2 (getcorner p1 "\nKarsi kose: "))
           (setq name (ep:ask-block *ld-last*)))
    (progn
      (setq *ld-last* name)
      (initget 6)
      (if (setq v (getint (strcat "\nYatayda (sutun) adet <" (itoa *ld-nx*) ">: "))) (setq *ld-nx* v))
      (initget 6)
      (if (setq v (getint (strcat "\nDikeyde (satir) adet <" (itoa *ld-ny*) ">: "))) (setq *ld-ny* v))
      (initget 6)
      (if (setq v (getreal (strcat "\nBlok olcegi <" (rtos *ld-sc* 2 2) ">: "))) (setq *ld-sc* v))
      (setq rot (getorient "\nBlok acisi <0>: "))
      (if (not rot) (setq rot 0.0))
      (ep:begin ep:*insert-vars*)
      (setq x0 (min (car p1) (car p2)) y0 (min (cadr p1) (cadr p2))
            dx (/ (abs (- (car p2) (car p1))) *ld-nx*)
            dy (/ (abs (- (cadr p2) (cadr p1))) *ld-ny*)
            n 0 j 0)
      (repeat *ld-ny*
        (setq i 0)
        (repeat *ld-nx*
          (ep:insert name (list (+ x0 (* dx (+ i 0.5))) (+ y0 (* dy (+ j 0.5))) 0.0) *ld-sc* rot (getvar "CLAYER"))
          (setq i (1+ i) n (1+ n))
        )
        (setq j (1+ j))
      )
      (princ (strcat "\n" (itoa n) " blok yerlestirildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; HATTABLOK - Cizginin uzerine, cizgi yonunde blok yerlestirir ve blok kadar boslugu acar (tek hat semalari icin).

(if (not *hb-gap*) (setq *hb-gap* 10.0))
(if (not *hb-sc*) (setq *hb-sc* 1.0))

(defun c:HATTABLOK (/ *error* name v sel q p ang n)
  (defun *error* (m) (ep:on-error m))
  (if (setq name (ep:ask-block *hb-last*))
    (progn
      (setq *hb-last* name)
      (if (setq v (getdist (strcat "\nBosluk uzunlugu (blok genisligi) <" (rtos *hb-gap* 2 2) ">: "))) (setq *hb-gap* v))
      (initget 6)
      (if (setq v (getreal (strcat "\nBlok olcegi <" (rtos *hb-sc* 2 2) ">: "))) (setq *hb-sc* v))
      (ep:begin ep:*insert-vars*)
      (setq n 0)
      (while (setq sel (entsel "\nCizgi uzerinde blok noktasi (Enter = bitir): "))
        (if (= (ep:dxf (car sel) 0) "LINE")
          (progn
            (setq q (ep:line-ucs (car sel))
                  p (ep:project (cadr sel) (car q) (cadr q))
                  ang (angle (car q) (cadr q)))
            ;; keep the block readable: point it to the right / upwards
            (if (and (> ang (/ pi 2.0)) (<= ang (* pi 1.5))) (setq ang (- ang pi)))
            (if (> *hb-gap* 0.0)
              (command "_.BREAK" (list (car sel) p) "_F"
                       "_non" (polar p ang (/ *hb-gap* -2.0))
                       "_non" (polar p ang (/ *hb-gap* 2.0)))
            )
            (ep:insert name p *hb-sc* ang (getvar "CLAYER"))
            (setq n (1+ n))
          )
          (princ "\nBir LINE secin.")
        )
      )
      (princ (strcat "\n" (itoa n) " blok yerlestirildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; METINDEGIS - Secilen yazilarin yuksekligini, acisini, stilini veya genisligini toplu degistirir.

(defun c:METINDEGIS (/ *error* ss ents opt v n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nDegistirilecek yazilari secin: ")
  (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    (progn
      (ep:begin nil)
      (setq ents (ep:ss-list ss) n 0)
      (princ (strcat "\n" (itoa (length ents)) " yazi secildi."))
      (initget "Yukseklik Aci Stil Genislik")
      (setq opt (getkword "\nNe degissin? [Yukseklik/Aci/Stil/Genislik] <Yukseklik>: "))
      (if (not opt) (setq opt "Yukseklik"))
      (cond
        ((= opt "Yukseklik")
          (if (setq v (getdist "\nYeni yazi yuksekligi: "))
            (foreach e ents (ep:set-dxf e 40 v) (setq n (1+ n))))
        )
        ((= opt "Aci")
          (if (setq v (getorient "\nYeni yazi acisi: "))
            (progn
              (setq v (+ v (ep:ucs-angle)))
              (foreach e ents
                (if (= (ep:dxf e 0) "MTEXT")
                  (ep:set-dxf e 11 (list (cos v) (sin v) 0.0))  ; MTEXT direction vector wins over 50
                  (ep:set-dxf e 50 v)
                )
                (setq n (1+ n))
              )
            )
          )
        )
        ((= opt "Stil")
          (setq v (getstring T (strcat "\nYazi stili <" (getvar "TEXTSTYLE") ">: ")))
          (if (= v "") (setq v (getvar "TEXTSTYLE")))
          (if (tblsearch "STYLE" v)
            (foreach e ents (ep:set-dxf e 7 v) (setq n (1+ n)))
            (princ (strcat "\nBoyle bir yazi stili yok: " v))
          )
        )
        ((= opt "Genislik")
          (initget 6)
          (if (setq v (getreal "\nGenislik katsayisi (orn. 0.8): "))
            (foreach e ents
              (if (= (ep:dxf e 0) "TEXT") (progn (ep:set-dxf e 41 v) (setq n (1+ n))))
            )
          )
        )
      )
      (princ (strcat "\n" (itoa n) " yazi degistirildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; BULVEDEGIS - Yazilarda ve blok niteliklerinde (attribute) metin bul / degistir.

;;; Replaces every occurrence of old in s. Returns (new-string . count).
(defun bvd:replace (s old new / pos start out n)
  (setq out "" n 0 start 0)
  (while (setq pos (vl-string-search old s start))
    (setq out (strcat out (substr s (1+ start) (- pos start)) new)
          start (+ pos (strlen old))
          n (1+ n))
  )
  (cons (strcat out (substr s (1+ start))) n)
)

;;; Changes group 1 of one entity; returns the number of replacements.
(defun bvd:fix (e old new / ed r)
  (setq ed (entget e)
        r (bvd:replace (cdr (assoc 1 ed)) old new))
  (if (> (cdr r) 0)
    (entmod (subst (cons 1 (car r)) (assoc 1 ed) ed))
  )
  (cdr r)
)

(defun c:BULVEDEGIS (/ *error* ss old new total objs e a k)
  (defun *error* (m) (ep:on-error m))
  (princ "\nYazilari ve bloklari secin (Enter = tum cizim): ")
  (setq ss (ssget '((0 . "TEXT,MTEXT,INSERT"))))
  (if (not ss) (setq ss (ssget "_X" '((0 . "TEXT,MTEXT,INSERT")))))
  (setq old (getstring T "\nAranacak metin: "))
  (if (and ss (/= old ""))
    (progn
      (setq new (getstring T "\nYeni metin: "))
      (ep:begin nil)
      (setq total 0 objs 0)
      (foreach e (ep:ss-list ss)
        (if (= (ep:dxf e 0) "INSERT")
          (progn
            (setq k 0 a (entnext e))
            (while (and a (= (ep:dxf a 0) "ATTRIB"))
              (setq k (+ k (bvd:fix a old new)) a (entnext a))
            )
            (if (> k 0) (progn (entupd e) (setq total (+ total k) objs (1+ objs))))
          )
          (if (> (setq k (bvd:fix e old new)) 0)
            (setq total (+ total k) objs (1+ objs))
          )
        )
      )
      (princ (strcat "\n" (itoa objs) " objede " (itoa total) " degisiklik yapildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; METINESLE - Bir yazinin icerigini secilen diger yazilara kopyalar.

(defun c:METINESLE (/ *error* src s ss n)
  (defun *error* (m) (ep:on-error m))
  (setq src (entsel "\nKaynak yaziyi secin: "))
  (if (and src (member (ep:dxf (car src) 0) '("TEXT" "MTEXT")))
    (progn
      (setq s (ep:dxf (car src) 1))
      (princ (strcat "\nKaynak: " s))
      (princ "\nDegistirilecek yazilari secin: ")
      (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
        (progn
          (ep:begin nil)
          (setq n 0)
          (foreach e (ep:ss-list ss)
            (if (not (equal e (car src)))
              (progn (ep:set-dxf e 1 s) (setq n (1+ n)))
            )
          )
          (princ (strcat "\n" (itoa n) " yazi guncellendi."))
          (ep:finish)
        )
      )
    )
    (princ "\nYazi (TEXT/MTEXT) secilmedi.")
  )
  (princ)
)

;;; METINTOPLA - Secilen yazilardaki sayilari toplar (toplam, ortalama, en kucuk, en buyuk).

(defun c:METINTOPLA (/ *error* ss v n total mn mx skipped pt s)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSayi iceren yazilari secin: ")
  (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    (progn
      (setq n 0 total 0.0 skipped 0 mn nil mx nil)
      (foreach e (ep:ss-list ss)
        (if (setq v (ep:first-number (ep:dxf e 1)))
          (setq n (1+ n)
                total (+ total v)
                mn (if mn (min mn v) v)
                mx (if mx (max mx v) v))
          (setq skipped (1+ skipped))
        )
      )
      (if (= n 0)
        (princ "\nSecilen yazilarda sayi bulunamadi.")
        (progn
          (princ "\n----------------------------------------")
          (princ (strcat "\n  Sayi adedi : " (itoa n)
                         (if (> skipped 0) (strcat "  (sayisiz: " (itoa skipped) ")") "")))
          (princ (strcat "\n  TOPLAM      : " (rtos total 2 3)))
          (princ (strcat "\n  Ortalama    : " (rtos (/ total n) 2 3)))
          (princ (strcat "\n  En kucuk    : " (rtos mn 2 3)))
          (princ (strcat "\n  En buyuk    : " (rtos mx 2 3)))
          (princ "\n----------------------------------------")
          (setq pt (getpoint "\nToplami cizime yazmak icin nokta secin (Enter = gec): "))
          (if pt
            (progn
              (setq s (rtos total 2 (if (equal total (fix total) 1e-9) 0 2)))
              (ep:text-j (trans pt 1 0) (getvar "TEXTSIZE") s (getvar "CLAYER") (ep:ucs-angle) 0 0)
            )
          )
        )
      )
    )
  )
  (princ)
)

;;; NUMARALA - Her tiklamada artan numara yazar (on ek, son ek, adim ayarli).

(if (not *num-start*) (setq *num-start* 1))
(if (not *num-step*) (setq *num-step* 1))
(if (not *num-pre*) (setq *num-pre* ""))
(if (not *num-suf*) (setq *num-suf* ""))

(defun c:NUMARALA (/ *error* v s pt h cur)
  (defun *error* (m) (ep:on-error m))
  (setq v (getint (strcat "\nBaslangic numarasi <" (itoa *num-start*) ">: ")))
  (if v (setq *num-start* v))
  (setq v (getint (strcat "\nArtis <" (itoa *num-step*) ">: ")))
  (if v (setq *num-step* v))
  (setq s (getstring T (strcat "\nOn ek (bosluk = yok) <" *num-pre* ">: ")))
  (if (/= s "") (setq *num-pre* (ep:trim s)))
  (setq s (getstring T (strcat "\nSon ek (bosluk = yok) <" *num-suf* ">: ")))
  (if (/= s "") (setq *num-suf* (ep:trim s)))
  (setq h (getdist (strcat "\nYazi yuksekligi <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
  (if (not h) (setq h (getvar "TEXTSIZE")))
  (ep:begin nil)
  (setq cur *num-start*)
  (while (setq pt (getpoint (strcat "\nKonum [" *num-pre* (itoa cur) *num-suf* "] (Enter = bitir): ")))
    (ep:text-j (trans pt 1 0) h (strcat *num-pre* (itoa cur) *num-suf*) (getvar "CLAYER") (ep:ucs-angle) 1 2)
    (setq cur (+ cur *num-step*))
  )
  (setq *num-start* cur)
  (ep:finish)
  (princ)
)

;;; METINDIZ - Yazilan satirlari esit aralikla alt alta dizer.

(defun c:METINDIZ (/ *error* pt h gap s i)
  (defun *error* (m) (ep:on-error m))
  (setq pt (getpoint "\nIlk satirin baslangic noktasi: "))
  (if pt
    (progn
      (setq h (getdist (strcat "\nYazi yuksekligi <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
      (if (not h) (setq h (getvar "TEXTSIZE")))
      (setq gap (getdist (strcat "\nSatir araligi <" (rtos (* h 1.6) 2 2) ">: ")))
      (if (not gap) (setq gap (* h 1.6)))
      (ep:begin nil)
      (setq i 0)
      (while (/= "" (setq s (getstring T (strcat "\nSatir " (itoa (1+ i)) " (Enter = bitir): "))))
        (ep:text-j (trans (list (car pt) (- (cadr pt) (* i gap)) 0.0) 1 0) h s (getvar "CLAYER") (ep:ucs-angle) 0 0)
        (setq i (1+ i))
      )
      (ep:finish)
    )
  )
  (princ)
)

;;; DOSYADANYAZI - Bir .txt dosyasinin satirlarini cizime yazi olarak aktarir.

(defun c:DOSYADANYAZI (/ *error* fn f pt h gap s i)
  (defun *error* (m) (if f (close f)) (ep:on-error m))
  (setq fn (getfiled "Metin dosyasi secin" (getvar "DWGPREFIX") "txt" 0))
  (if (and fn (setq pt (getpoint "\nIlk satirin baslangic noktasi: ")))
    (progn
      (setq h (getdist (strcat "\nYazi yuksekligi <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
      (if (not h) (setq h (getvar "TEXTSIZE")))
      (setq gap (getdist (strcat "\nSatir araligi <" (rtos (* h 1.6) 2 2) ">: ")))
      (if (not gap) (setq gap (* h 1.6)))
      (ep:begin nil)
      (setq f (open fn "r") i 0)
      (while (setq s (read-line f))
        (if (/= (ep:trim s) "")
          (ep:text-j (trans (list (car pt) (- (cadr pt) (* i gap)) 0.0) 1 0) h s (getvar "CLAYER") (ep:ucs-angle) 0 0)
        )
        (setq i (1+ i))
      )
      (close f)
      (setq f nil)
      (princ (strcat "\n" (itoa i) " satir aktarildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; ALANORTASI - Iki kose arasindaki alanin tam ortasina yazi yazar (oda adi vb.).

(defun c:ALANORTASI (/ *error* p1 p2 mid s h)
  (defun *error* (m) (ep:on-error m))
  (while (and (setq p1 (getpoint "\nAlanin bir kosesi (Enter = bitir): "))
              (setq p2 (getcorner p1 "\nKarsi kose: ")))
    (setq mid (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) 0.0))
    (setq s (getstring T "\nYazi: "))
    (if (/= s "")
      (progn
        (if (not h)
          (progn
            (setq h (getdist (strcat "\nYazi yuksekligi <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
            (if (not h) (setq h (getvar "TEXTSIZE")))
          )
        )
        (ep:text-j (trans mid 1 0) h s (getvar "CLAYER") (ep:ucs-angle) 1 2)
      )
    )
  )
  (princ)
)

;;; STILSEC - Secilen yazinin stilini aktif yazi stili yapar.

(defun c:STILSEC (/ e st)
  (setq e (entsel "\nStili alinacak yaziyi secin: "))
  (if (and e (member (ep:dxf (car e) 0) '("TEXT" "MTEXT" "ATTDEF")))
    (progn
      (setq st (ep:dxf (car e) 7))
      (setvar "TEXTSTYLE" st)
      (princ (strcat "\nAktif yazi stili: " st))
    )
    (princ "\nYazi secilmedi.")
  )
  (princ)
)

;;; YERINDEOLCEK - Her objeyi kendi yerlestirme noktasina gore olcekler (bloklar, yazilar).

;;; Base point of an object: justification point for aligned texts,
;;; insertion point for blocks and texts, nil otherwise.
(defun yo:base (e / ed typ)
  (setq ed (entget e) typ (cdr (assoc 0 ed)))
  (cond
    ((and (= typ "TEXT") (or (/= 0 (cdr (assoc 72 ed))) (/= 0 (cdr (assoc 73 ed)))))
      (cdr (assoc 11 ed)))
    ((member typ '("INSERT" "TEXT" "MTEXT" "CIRCLE" "ARC" "POINT")) (cdr (assoc 10 ed)))
    (T nil)
  )
)

(defun c:YERINDEOLCEK (/ *error* ss f n skip b)
  (defun *error* (m) (ep:on-error m))
  (princ "\nOlceklenecek bloklari / yazilari secin: ")
  (if (setq ss (ssget '((0 . "INSERT,TEXT,MTEXT,CIRCLE,ARC,POINT"))))
    (progn
      (initget 6)
      (if (setq f (getreal "\nOlcek katsayisi: "))
        (progn
          (ep:begin '("OSMODE"))
          (setvar "OSMODE" 0)
          (setq n 0 skip 0)
          (foreach e (ep:ss-list ss)
            (if (setq b (yo:base e))
              (progn
                (command "_.SCALE" e "" (trans b e 1) f)
                (setq n (1+ n))
              )
              (setq skip (1+ skip))
            )
          )
          (princ (strcat "\n" (itoa n) " obje olceklendi."))
          (ep:finish)
        )
      )
    )
  )
  (princ)
)

;;; KATMANSIL - Secilen objenin katmanindaki TUM objeleri siler (tum yerlesimlerde).

(defun c:KATMANSIL (/ *error* e lay ss n ans)
  (defun *error* (m) (ep:on-error m))
  (setq e (entsel "\nKatmani silinecek bir obje secin: "))
  (if e
    (progn
      (setq lay (ep:dxf (car e) 8)
            ss (ssget "_X" (list (cons 8 lay)))
            n (if ss (sslength ss) 0))
      (initget "Evet Hayir")
      (setq ans (getkword (strcat "\n" lay " katmanindaki " (itoa n)
                                  " obje silinsin mi? [Evet/Hayir] <Hayir>: ")))
      (if (= ans "Evet")
        (progn
          (ep:begin nil)
          (foreach x (ep:ss-list ss) (entdel x))
          (princ (strcat "\n" (itoa n) " obje silindi. Geri almak icin U."))
          (ep:finish)
        )
        (princ "\nIptal edildi.")
      )
    )
  )
  (princ)
)

;;; KATMANDEGIS - Secilen objeleri, ornek olarak gosterilen objenin katmanina tasir.

(defun c:KATMANDEGIS (/ *error* ss e lay n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nKatmani degisecek objeleri secin: ")
  (if (and (setq ss (ssget))
           (setq e (entsel "\nHedef katmandaki bir objeyi gosterin: ")))
    (progn
      (setq lay (ep:dxf (car e) 8) n 0)
      (ep:begin nil)
      (foreach x (ep:ss-list ss) (ep:set-dxf x 8 lay) (setq n (1+ n)))
      (princ (strcat "\n" (itoa n) " obje " lay " katmanina tasindi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; AKTIFKATMANA - Secilen objeleri aktif (gecerli) katmana tasir.

(defun c:AKTIFKATMANA (/ *error* ss n)
  (defun *error* (m) (ep:on-error m))
  (princ (strcat "\nAktif katmana (" (getvar "CLAYER") ") tasinacak objeleri secin: "))
  (if (setq ss (ssget))
    (progn
      (ep:begin nil)
      (setq n 0)
      (foreach x (ep:ss-list ss) (ep:set-dxf x 8 (getvar "CLAYER")) (setq n (1+ n)))
      (princ (strcat "\n" (itoa n) " obje tasindi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; KATMANSEC - Secilen objenin katmanini aktif katman yapar.

(defun c:KATMANSEC (/ e lay)
  (setq e (entsel "\nKatmani aktif yapilacak objeyi secin: "))
  (if e
    (progn
      (setq lay (ep:dxf (car e) 8))
      (setvar "CLAYER" lay)
      (princ (strcat "\nAktif katman: " lay))
    )
  )
  (princ)
)

;;; OBJDONDUR - Tiklanan objelerin katmanlarini dondurur (freeze).

(defun c:OBJDONDUR (/ *error* e lay done)
  (defun *error* (m) (ep:on-error m))
  (ep:begin nil)
  (setq done nil)
  (while (setq e (entsel "\nKatmani dondurulacak obje (Enter = bitir): "))
    (setq lay (ep:dxf (car e) 8))
    (if (= (strcase lay) (strcase (getvar "CLAYER")))
      (princ (strcat "\n" lay " aktif katman, dondurulamaz."))
      (progn
        (command "_.-LAYER" "_F" lay "")
        (setq done (cons lay done))
        (princ (strcat "\n" lay " donduruldu."))
      )
    )
  )
  (if done (princ (strcat "\n" (itoa (length done)) " katman donduruldu. Geri acmak icin LAYTHW veya LAYER.")))
  (ep:finish)
  (princ)
)

;;; RENK - Secilen objelerin rengini tek komutla degistirir (KIRMIZI, SARI, ... RENK11 ...).

(defun renk:set (c / *error* ss n)
  (defun *error* (m) (ep:on-error m))
  (princ (strcat "\nRenk " (cond ((= c 256) "ByLayer") ((= c 0) "ByBlock") (T (itoa c)))
                 " - objeleri secin: "))
  (if (setq ss (ssget))
    (progn
      (ep:begin nil)
      (setq n 0)
      (foreach x (ep:ss-list ss) (ep:set-dxf x 62 c) (setq n (1+ n)))
      (princ (strcat "\n" (itoa n) " objenin rengi degisti."))
      (ep:finish)
    )
  )
  (princ)
)

(defun c:RENKVER (/ c)
  (initget 4 "ByLayer ByBlock")
  (setq c (getint "\nRenk numarasi (1-255) veya [ByLayer/ByBlock]: "))
  (cond
    ((= c "ByLayer") (renk:set 256))
    ((= c "ByBlock") (renk:set 0))
    ((and c (> c 0) (< c 256)) (renk:set c))
    (c (princ "\nGecersiz renk."))
  )
  (princ)
)

(defun c:KIRMIZI () (renk:set 1))
(defun c:SARI () (renk:set 2))
(defun c:YESIL () (renk:set 3))
(defun c:ACMAVI () (renk:set 4))
(defun c:MAVI () (renk:set 5))
(defun c:MOR () (renk:set 6))
(defun c:BEYAZ () (renk:set 7))
(defun c:KOGRI () (renk:set 8))
(defun c:ACGRI () (renk:set 9))
(defun c:KATMANRENGI () (renk:set 256))
(defun c:RENK11 () (renk:set 11))
(defun c:RENK12 () (renk:set 12))
(defun c:RENK21 () (renk:set 21))
(defun c:RENK25 () (renk:set 25))
(defun c:RENK30 () (renk:set 30))
(defun c:RENK33 () (renk:set 33))
(defun c:RENK40 () (renk:set 40))
(defun c:RENK41 () (renk:set 41))
(defun c:RENK125 () (renk:set 125))
(defun c:RENK140 () (renk:set 140))
(defun c:RENK175 () (renk:set 175))
(defun c:RENK215 () (renk:set 215))
(defun c:RENK230 () (renk:set 230))

;;; KESIKCI - Secilen objelerin cizgi tipini kesikli (HIDDEN) yapar; gerekirse yukler.

(defun c:KESIKCI (/ *error* ss lin n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nKesikli yapilacak objeleri secin: ")
  (if (setq ss (ssget))
    (progn
      (ep:begin nil)
      (if (not (tblsearch "LTYPE" "HIDDEN"))
        (progn
          ;; AutoCAD: acadiso.lin / acad.lin, GstarCAD: gcadiso.lin / gcad.lin
          (setq lin (vl-some 'findfile
                             (if (= (getvar "MEASUREMENT") 1)
                               '("acadiso.lin" "gcadiso.lin" "acad.lin" "gcad.lin")
                               '("acad.lin" "gcad.lin" "acadiso.lin" "gcadiso.lin"))))
          (if lin
            (command "_.-LINETYPE" "_L" "HIDDEN" lin "")
          )
        )
      )
      (if (tblsearch "LTYPE" "HIDDEN")
        (progn
          (setq n 0)
          (foreach x (ep:ss-list ss) (ep:set-dxf x 6 "HIDDEN") (setq n (1+ n)))
          (princ (strcat "\n" (itoa n) " obje kesikli yapildi. Cizgiler gorunmuyorsa LTSCALE degerini ayarlayin."))
        )
        (princ "\nHIDDEN cizgi tipi yuklenemedi.")
      )
      (ep:finish)
    )
  )
  (princ)
)

;;; PARALEL - Verilen genislikte cift cizgi (iki paralel polyline) cizer; koseler temiz birlesir.

(if (not *par-w*) (setq *par-w* 10.0))
(if (not *par-j*) (setq *par-j* "Orta"))

;;; Offsets a 2D WCS point chain by d (positive = left of the drawing direction).
;;; Corners are mitred: neighbouring offset segments are intersected.
(defun par:offset (pts d closed / n m i a b u segs res k s1 s2 p)
  (setq n (length pts) segs nil i 0)
  (repeat (if closed n (1- n))
    (setq a (nth i pts)
          b (nth (rem (1+ i) n) pts)
          u (+ (angle a b) (/ pi 2.0)))
    (setq segs (append segs (list (list (polar a u d) (polar b u d))))
          i (1+ i))
  )
  (setq m (length segs) res nil k 0)
  (repeat n
    (cond
      ((and (not closed) (= k 0)) (setq p (car (nth 0 segs))))
      ((and (not closed) (= k (1- n))) (setq p (cadr (last segs))))
      (T
        (setq s1 (nth (rem (+ k m -1) m) segs)
              s2 (nth (rem k m) segs))
        (setq p (inters (car s1) (cadr s1) (car s2) (cadr s2) nil))
        (if (not p) (setq p (car s2)))
      )
    )
    (setq res (append res (list p)) k (1+ k))
  )
  res
)

(defun c:PARALEL (/ *error* v r pts closed w d1 d2 lay)
  (defun *error* (m) (redraw) (ep:on-error m))
  (setq v (getdist (strcat "\nGenislik <" (rtos *par-w* 2 2) ">: ")))
  (if v (setq *par-w* v))
  (initget "Orta Sol Sag")
  (setq v (getkword (strcat "\nHizalama [Orta/Sol/Sag]] <" *par-j* ">: ")))
  (if v (setq *par-j* v))
  (setq r (ep:collect-points "\nBaslangic noktasi: ")
        pts (car r)
        closed (cadr r))
  (if (> (length pts) 1)
    (progn
      (ep:begin nil)
      (setq w *par-w*
            lay (getvar "CLAYER")
            pts (mapcar '(lambda (p) (ep:2d (trans p 1 0))) pts))
      (cond
        ((= *par-j* "Sol") (setq d1 w d2 0.0))
        ((= *par-j* "Sag") (setq d1 0.0 d2 (- w)))
        (T (setq d1 (/ w 2.0) d2 (/ w -2.0)))
      )
      (ep:lwpoly (par:offset pts d1 closed) closed lay)
      (ep:lwpoly (par:offset pts d2 closed) closed lay)
      (ep:finish)
    )
  )
  (princ)
)

;;; CITSEC - Cizilen bir cit (fence) cizgisinin kestigi tum cizgileri kesisim noktalarindan boler.

(defun c:CITSEC (/ *error* r fence ss hits a b p q pieces piece found n i e)
  (defun *error* (m) (redraw) (ep:on-error m))
  (setq r (ep:collect-points "\nCit cizgisinin ilk noktasi: ")
        fence (car r))
  (if (and (> (length fence) 1) (setq ss (ssget "_F" fence '((0 . "LINE")))))
    (progn
      (ep:begin nil)
      ;; intersection points per line
      (setq hits nil)
      (foreach e (ep:ss-list ss)
        (setq q (ep:line-ucs e) i 0)
        (while (< i (1- (length fence)))
          (setq a (nth i fence) b (nth (1+ i) fence))
          (if (and (setq p (inters a b (car q) (cadr q) T))
                   (> (distance (ep:2d p) (ep:2d (car q))) 1e-6)
                   (> (distance (ep:2d p) (ep:2d (cadr q))) 1e-6))
            (setq hits (cons (list e p) hits))
          )
          (setq i (1+ i))
        )
      )
      ;; break; a line broken once becomes two pieces, so track the pieces
      (setq n 0 pieces nil)
      (foreach h hits
        (setq e (car h) p (cadr h))
        (if (not (assoc e pieces)) (setq pieces (cons (list e e) pieces)))
        (setq found nil)
        (foreach piece (cdr (assoc e pieces))
          (if (and (not found) (entget piece))
            (progn
              (setq q (ep:line-ucs piece))
              (if (ep:on-seg p (car q) (cadr q) 1e-6) (setq found piece))
            )
          )
        )
        (if found
          (progn
            (command "_.BREAK" (list found p) "_F" "_non" p "_non" "@")
            (setq pieces (subst (append (assoc e pieces) (list (entlast))) (assoc e pieces) pieces)
                  n (1+ n))
          )
        )
      )
      (princ (strcat "\n" (itoa n) " noktadan bolundu."))
      (ep:finish)
    )
    (if fence (princ "\nCitin kestigi cizgi (LINE) bulunamadi."))
  )
  (princ)
)

;;; ARAKESME - Iki kesme cizgisi arasinda kalan kisimlari secilen cizgilerden siler.

(defun c:ARAKESME (/ *error* c1 c2 k1 k2 ss n q p1 p2)
  (defun *error* (m) (ep:on-error m))
  (setq c1 (entsel "\nBirinci kesme cizgisi: "))
  (if (and c1 (= (ep:dxf (car c1) 0) "LINE")
           (setq c2 (entsel "\nIkinci kesme cizgisi: "))
           (= (ep:dxf (car c2) 0) "LINE"))
    (progn
      (setq k1 (ep:line-ucs (car c1)) k2 (ep:line-ucs (car c2)))
      (princ "\nKesilecek cizgileri secin: ")
      (if (setq ss (ssget '((0 . "LINE"))))
        (progn
          (ep:begin nil)
          (setq n 0)
          (foreach e (ep:ss-list ss)
            (if (not (member e (list (car c1) (car c2))))
              (progn
                (setq q (ep:line-ucs e)
                      p1 (inters (car k1) (cadr k1) (car q) (cadr q) nil)
                      p2 (inters (car k2) (cadr k2) (car q) (cadr q) nil))
                (if (and p1 p2
                         (ep:on-seg p1 (car q) (cadr q) 1e-6)
                         (ep:on-seg p2 (car q) (cadr q) 1e-6))
                  (progn
                    (command "_.BREAK" (list e p1) "_F" "_non" p1 "_non" p2)
                    (setq n (1+ n))
                  )
                )
              )
            )
          )
          (princ (strcat "\n" (itoa n) " cizgi kesildi."))
          (ep:finish)
        )
      )
    )
    (princ "\nKesme cizgileri LINE olmali.")
  )
  (princ)
)

;;; BOSLUKAC - Cift cizgili duvarda kapi/pencere boslugu acar ve bosluk kenarlarini kapatir.

(defun c:BOSLUKAC (/ *error* w1 w2 q1 q2 p1 p2 a1 b1 a2 b2 lay)
  (defun *error* (m) (ep:on-error m))
  (setq w1 (entsel "\nDuvarin birinci cizgisi: "))
  (if (and w1 (= (ep:dxf (car w1) 0) "LINE")
           (setq w2 (entsel "\nDuvarin ikinci cizgisi: "))
           (= (ep:dxf (car w2) 0) "LINE")
           (setq p1 (getpoint "\nBoslugun baslangic noktasi: "))
           (setq p2 (getpoint p1 "\nBoslugun bitis noktasi: ")))
    (progn
      (setq q1 (ep:line-ucs (car w1)) q2 (ep:line-ucs (car w2))
            a1 (ep:project p1 (car q1) (cadr q1)) b1 (ep:project p2 (car q1) (cadr q1))
            a2 (ep:project p1 (car q2) (cadr q2)) b2 (ep:project p2 (car q2) (cadr q2)))
      (if (and (ep:on-seg a1 (car q1) (cadr q1) 1e-6) (ep:on-seg b1 (car q1) (cadr q1) 1e-6)
               (ep:on-seg a2 (car q2) (cadr q2) 1e-6) (ep:on-seg b2 (car q2) (cadr q2) 1e-6))
        (progn
          (ep:begin nil)
          (setq lay (ep:dxf (car w1) 8))
          (command "_.BREAK" (list (car w1) a1) "_F" "_non" a1 "_non" b1)
          (command "_.BREAK" (list (car w2) a2) "_F" "_non" a2 "_non" b2)
          (ep:line (trans a1 1 0) (trans a2 1 0) lay)
          (ep:line (trans b1 1 0) (trans b2 1 0) lay)
          (princ "\nBosluk acildi.")
          (ep:finish)
        )
        (princ "\nBosluk noktalari duvar cizgilerinin disinda kaliyor.")
      )
    )
  )
  (princ)
)

;;; YERDEGIS - Iki obje grubunun yerini birbiriyle degistirir.

(defun c:YERDEGIS (/ *error* ss1 ss2 b1 b2)
  (defun *error* (m) (ep:on-error m))
  (princ "\nBirinci grubu secin: ")
  (if (and (setq ss1 (ssget))
           (princ "\nIkinci grubu secin: ")
           (setq ss2 (ssget))
           (setq b1 (getpoint "\nBirinci grubun referans noktasi: "))
           (setq b2 (getpoint "\nIkinci grubun referans noktasi: ")))
    (progn
      (ep:begin nil)
      (command "_.MOVE" ss1 "" "_non" b1 "_non" b2)
      (command "_.MOVE" ss2 "" "_non" b2 "_non" b1)
      (princ "\nYer degistirildi.")
      (ep:finish)
    )
  )
  (princ)
)

;;; BLOKDEGIS - Secilen bloklari baska bir blokla degistirir; konum, aci, olcek, katman ve nitelik degerleri korunur.

(defun c:BLOKDEGIS (/ *error* ss name ed pt sx sy sz rot lay vals new n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nDegistirilecek bloklari secin: ")
  (if (and (setq ss (ssget '((0 . "INSERT"))))
           (setq name (ep:ask-block *bd-last*)))
    (progn
      (setq *bd-last* name n 0)
      (ep:begin ep:*insert-vars*)
      (foreach e (ep:ss-list ss)
        (setq ed (entget e)
              pt (trans (cdr (assoc 10 ed)) e 1)
              sx (cdr (assoc 41 ed)) sy (cdr (assoc 42 ed)) sz (cdr (assoc 43 ed))
              rot (- (cdr (assoc 50 ed)) (ep:ucs-angle))
              lay (cdr (assoc 8 ed))
              vals (ep:attribs-get e))
        (entdel e)
        (if (setq new (ep:insert name pt (abs sx) rot lay))
          (progn
            (ep:set-dxf new 41 sx)
            (ep:set-dxf new 42 sy)
            (ep:set-dxf new 43 sz)
            (if vals (ep:attribs-set new vals))
            (setq n (1+ n))
          )
        )
      )
      (princ (strcat "\n" (itoa n) " blok degistirildi."))
      (ep:finish)
    )
  )
  (princ)
)

;;; YONLU UZATMA - Capraz pencereyle secilen kismi sola/saga/yukari/asagi verilen mesafe kadar uzatir (STRETCH).

(if (not *yu-d*) (setq *yu-d* 10.0))

(defun yu:run (ang / *error* d p1 p2)
  (defun *error* (m) (ep:on-error m))
  (setq d (getdist (strcat "\nMesafe <" (rtos *yu-d* 2 2) ">: ")))
  (if d (setq *yu-d* d))
  (if (and (setq p1 (getpoint "\nCapraz pencerenin birinci kosesi: "))
           (setq p2 (getcorner p1 "\nKarsi kose: ")))
    (progn
      (ep:begin nil)
      (command "_.STRETCH" "_C" "_non" p1 "_non" p2 "" "_non" '(0.0 0.0 0.0) "_non" (polar '(0.0 0.0 0.0) ang *yu-d*))
      (ep:finish)
    )
  )
  (princ)
)

(defun c:SOLUZAT () (yu:run pi))
(defun c:SAGUZAT () (yu:run 0.0))
(defun c:YUKARIUZAT () (yu:run (/ pi 2.0)))
(defun c:ASAGIUZAT () (yu:run (/ pi -2.0)))


(princ "\n[eplisp] yuklendi. Komutlar: ...")
(princ)