;;; KESIF - Elektrik projesi malzeme listesi (kesif)
;;; eplisp 2.0.0 - https://eplisp.com/tr/
;;; Ucretsiz. AutoCAD ve GstarCAD icin. Yuklemek icin: APPLOAD
;;; Hicbir garanti verilmez; sonuclari kontrol ederek kullanin.
;;; Komutlar: KESIF

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

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


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