;;; YUKCEL - Elektrik yukleme cetveli
;;; 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

;;; ------------------------------------------------------------
;;; 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)
)


(princ "\n[eplisp] yuklendi. Komutlar: YUKCEL, YUKCEL-LEJANT, YUKCEL-LINYE, YUKCEL-EXPORT, YUKCEL-AYAR")
(princ)