;;; eplisp - All tools in one file
;;; eplisp 2.0.0 - https://eplisp.com/en/
;;; Free. For AutoCAD and GstarCAD. To load: APPLOAD
;;; Provided as is, without warranty; always check the results.
;;; Commands: LOADSCHED, LOADSCHED-LEGEND, LOADSCHED-CIRCUIT, LOADSCHED-EXPORT, LOADSCHED-SET, BOQ, SUMLEN, CABLEROUTE, CABLEROUTE-SET, AREAGRID, BLOCKONLINE, TXTMOD, TXTREPLACE, TXTMATCH, TXTSUM, TXTSEQ, TXTCOLUMN, TXTIMPORT, TXTCENTER, STYLEPICK, SCALEEACH, LAYERASE, LAYTOPICK, LAYTOCUR, LAYSETPICK, LAYFRZPICK, SETCOLOR, CRED, CYELLOW, CGREEN, CCYAN, CBLUE, CMAGENTA, CWHITE, CGRAY, CLGRAY, CBYLAYER, COL11, COL12, COL21, COL25, COL30, COL33, COL40, COL41, COL125, COL140, COL175, COL215, COL230, LTHIDDEN, DOUBLELINE, FENCEBREAK, BRKBETWEEN, WALLGAP, SWAPOBJ, BLKSWAP, STRETCHL, STRETCHR, STRETCHU, STRETCHD

;;; ------------------------------------------------------------
;;; 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 "\nError: " 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 saved: " path))
          path
        )
        (progn
          (princ (strcat "\nCould not write file: " path))
          nil
        )
      )
    )
    (progn (princ "\nCSV export skipped.") 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 "\nTable drawn: "
                 (itoa (length rows)) " rows"))
)

;;; Asks where to put the table and the text height, then draws it.
(defun ep:place-table (rows lay / pt h def)
  (initget "Yes No")
  (if (/= (getkword "\nInsert the table into the drawing? [Yes/No] <Yes>: ")
          "No")
    (progn
      (setq pt (getpoint "\nTop-left corner of the table (Enter = skip): "))
      (if pt
        (progn
          (setq def (getvar "TEXTSIZE"))
          (setq h (getdist pt (strcat "\nText height <" (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 P 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 "\nBlock name (P = pick a sample block)"
                               (if default (strcat " <" default ">") "") ": ")))
  (cond
    ((= s "") (setq s default))
    ((= (strcase s) "P")
      (setq e (entsel "\nPick a sample block: "))
      (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 "\nNo such block in the drawing: " 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 "Close Undo")
        (setq pt (getpoint (last pts) "\nNext point [Close/Undo] (Enter = finish): "))
        (cond
          ((null pt) (setq done T))
          ((= pt "Close")
            (if (> (length pts) 2) (setq closed T done T)
              (princ "\nAt least 3 points are needed to close.")))
          ((= pt "Undo")
            (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)
)

;;; LOADSCHED - Electrical load schedule for building installations.
;;; Reads block types and powers from the legend, traces the selected circuits,
;;; and computes points, load, current, cable, breaker and phase balance.
;;; Calculations follow the Turkish wiring regulation (220/380 V, IEC practice).

;;; ---- 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) "ANH")  ; TR: network switch, EN: light switch
    ((yukcel:str-find "TELEPHONE" upper) "ZAY")
    ((yukcel:str-find "PHONE" upper) "ZAY")
    ((yukcel:str-find "SMOKE" upper) "ZAY")
    ((yukcel:str-find "FIRE ALARM" upper) "ZAY")
    ((yukcel:str-find "SPEAKER" upper) "ZAY")
    ((yukcel:str-find "DOORBELL" upper) "ZAY")
    ((yukcel:str-find "ACCESS CONTROL" upper) "ZAY")
    ((yukcel:str-find "CARD READER" upper) "ZAY")
    ((yukcel:str-find "NETWORK" upper) "ZAY")
    ((yukcel:str-find "ETHERNET" upper) "ZAY")
    ((yukcel:str-find "ACCESS POINT" upper) "ZAY")
    ((yukcel:str-find "WIFI" upper) "ZAY")
    ((yukcel:str-find "CAMERA" upper) "ZAY")
    ((yukcel:str-find "SECURITY" upper) "ZAY")
    ((yukcel:str-find "NURSE CALL" upper) "ZAY")
    ((yukcel:str-find "SATELLITE" upper) "ZAY")
    ;; =============== 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
    ((yukcel:str-find "LIGHT SWITCH" upper) "ANH")
    ((yukcel:str-find "TWO-WAY" upper) "ANH")
    ((yukcel:str-find "2-WAY" upper) "ANH")
    ((yukcel:str-find "INTERMEDIATE" upper) "ANH")
    ((yukcel:str-find "PUSH BUTTON" upper) "ANH")
    ((yukcel:str-find "PUSHBUTTON" upper) "ANH")
    ;; =============== 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")
    ((yukcel:str-find "DISHWASHER" upper) "CIH")
    ((yukcel:str-find "WASHING" upper) "CIH")
    ((yukcel:str-find "WASHER" upper) "CIH")
    ((yukcel:str-find "DRYER" upper) "CIH")
    ((yukcel:str-find "OVEN" upper) "CIH")
    ((yukcel:str-find "COOKER" upper) "CIH")
    ((yukcel:str-find "HOB" upper) "CIH")
    ((yukcel:str-find "STOVE" upper) "CIH")
    ((yukcel:str-find "WATER HEATER" upper) "CIH")
    ((yukcel:str-find "HEATER" upper) "CIH")
    ((yukcel:str-find "FRIDGE" upper) "CIH")
    ((yukcel:str-find "REFRIGERATOR" upper) "CIH")
    ((yukcel:str-find "FREEZER" upper) "CIH")
    ((yukcel:str-find "EXTRACTOR" upper) "CIH")
    ((yukcel:str-find "HOOD" upper) "CIH")
    ((yukcel:str-find "MICROWAVE" upper) "CIH")
    ((yukcel:str-find "AIR CONDITION" upper) "CIH")
    ((yukcel:str-find "A/C" upper) "CIH")
    ((yukcel:str-find "HVAC" upper) "CIH")
    ((yukcel:str-find "PUMP" upper) "CIH")
    ((yukcel:str-find "COMPRESSOR" upper) "CIH")
    ((yukcel:str-find "FAN" 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")
    ((yukcel:str-find "SOCKET" upper) "PRZ")
    ((yukcel:str-find "OUTLET" upper) "PRZ")
    ((yukcel:str-find "RECEPTACLE" upper) "PRZ")
    ((yukcel:str-find "POWER POINT" upper) "PRZ")
    ((yukcel:str-find "GPO" 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")
    ((yukcel:str-find "JUNCTION" upper) "BUA")
    ((yukcel:str-find "J-BOX" upper) "BUA")
    ((yukcel:str-find "JBOX" upper) "BUA")
    ((yukcel:str-find "PULL BOX" 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
    ((yukcel:str-find "LUMINAIRE" upper) "AYD")
    ((yukcel:str-find "FIXTURE" upper) "AYD")
    ((yukcel:str-find "LIGHT" upper) "AYD")
    ((yukcel:str-find "LAMP" upper) "AYD")
    ((yukcel:str-find "SPOTLIGHT" upper) "AYD")
    ((yukcel:str-find "FLOODLIGHT" upper) "AYD")
    ((yukcel:str-find "PENDANT" upper) "AYD")
    ((yukcel:str-find "CHANDELIER" upper) "AYD")
    ((yukcel:str-find "FLUORESCENT" upper) "AYD")
    ((yukcel:str-find "EMERGENCY" upper) "AYD")
    ((yukcel:str-find "BULKHEAD" upper) "AYD")
    ((yukcel:str-find "BOLLARD" upper) "AYD")
    ((yukcel:str-find "TRACK" upper) "AYD")
    ;; 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)
        ((yukcel:str-find "WASH" upper) 2500.0)
        ((yukcel:str-find "DRYER" upper) 2500.0)
        ((yukcel:str-find "OVEN" upper) 2000.0)
        ((yukcel:str-find "COOKER" upper) 2000.0)
        ((yukcel:str-find "HOB" upper) 2000.0)
        ((yukcel:str-find "HEATER" upper) 2000.0)
        ((yukcel:str-find "AIR CONDITION" upper) 1500.0)
        ((yukcel:str-find "FRIDGE" upper) 300.0)
        ((yukcel:str-find "MICROWAVE" 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  Reference layer: " ref-layer
                 ", color: " (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  Scanning: " (itoa idx) "/" (itoa (length dizi)) "..."))
    )
  )
  
  (princ (strcat "\n  Circuit: " (itoa (length dizi)) " lines found."))
  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)))
            " -> NOT IN LEGEND")))
        (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") "LGT")
    ((= tip "PRZ") "SKT")
    ((= tip "CIH") "APP")
    ((= tip "ANH") "SW")
    ((= tip "BUA") "JB")
    ((= tip "ZAY") "LV")
    ((= tip "KRM") "MIX")
    (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)
  )
)

;;; ============================================================
;;; Step 1: legend
;;; ============================================================

(defun c:LOADSCHED-LEGEND (/ *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=== LOAD SCHEDULE - READ LEGEND ===")
  (setq pt1 (getpoint "\nLower-left corner of the legend table: "))
  (if (not pt1) (exit))
  (setq pt2 (getcorner pt1 "\nUpper-right corner: "))
  (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 "\nNo blocks found in the selected area!") (exit))
  )
  (princ (strcat "\nBlocks: " (itoa (sslength ss-b))
                 ", texts: " (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 "\nBlock name          Type Power(W) Description")
  (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)) " legend entries created."))
  (if (assoc "???" (mapcar '(lambda (x) (cons (nth 3 x) x)) lejant))
    (princ "\nWARNING: ??? entries were not recognised; check their descriptions.")
  )
  (princ "\nNext: LOADSCHED-CIRCUIT")
  (princ)
)

;;; ============================================================
;;; Step 2: circuits
;;; ============================================================

(defun c:LOADSCHED-CIRCUIT (/ *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*** Run LOADSCHED-LEGEND first! ***") (exit))
  )
  (setq *yukcel-linyeler* nil linye-no 0 devam T)
  (princ "\n=== LOAD SCHEDULE - CIRCUITS ===")
  (princ "\nLeft click : pick a line of the circuit (connected lines are found automatically)")
  (princ "\nLeft click : add a missed line to the same circuit")
  (princ "\nRight click: finish this circuit, go to the next")
  (princ "\nRight click on an empty circuit: done\n")

  (while devam
    (setq linye-no (1+ linye-no) hat-list nil linye-devam T)
    (princ (strcat "\n===== CIRCUIT " (itoa linye-no) " ====="))
    (while linye-devam
      (princ (strcat "\n  Circuit " (itoa linye-no) " [" (itoa (length hat-list))
                     " lines] - left click=add, right click=finish: "))
      (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)) " blocks found."))
            (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) " - pick a LINE/LWPOLYLINE/POLYLINE!"))
          (if (yukcel:member-ent ent hat-list)
            (princ "\n  This line is already selected.")
            (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  Total: " (itoa (length hat-list)) " lines"))
            )
          )
        )
      )
    )
  )
  (if *yukcel-linyeler*
    (progn
      (yukcel:print-summary)
      (princ "\nFor the report: LOADSCHED-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-- CIRCUIT " (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)) " points, " (rtos (nth 4 ls) 2 0) "W")))
  (if (> (nth 5 ls) 0)
    (princ (strcat "\n    >> " (yukcel:tip-ad "PRZ") ": " (itoa (nth 5 ls)) " points, " (rtos (nth 6 ls) 2 0) "W")))
  (if (> (nth 7 ls) 0)
    (princ (strcat "\n    >> " (yukcel:tip-ad "CIH") ": " (itoa (nth 7 ls)) " points, " (rtos (nth 8 ls) 2 0) "W")))
  (if (> (nth 11 ls) 0)
    (princ (strcat "\n    >> ???: " (itoa (nth 11 ls)) " items (unknown - check them)")))
  (princ (strcat "\n    Points: " (itoa sorti-cnt)
                 "  |  Power: " (rtos linye-w 2 0) "W"
                 "  |  Current: " (rtos (/ linye-w 220.0) 2 1) "A"
                 "  |  Cable: " (nth 14 ls)
                 "  |  Breaker: " (nth 15 ls)))
  (if (> cable-len 0)
    (princ (strcat "\n    Cable length: " (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    *** WARNING: more than 9 lighting points on one circuit (max 9)"))
  (if (and (or (= linye-tip "PRZ") (= linye-tip "KRM")) (> (nth 5 ls) 7))
    (princ "\n    *** WARNING: more than 7 sockets on one circuit (max 7)"))
  (if (> linye-w 2000.0)
    (princ (strcat "\n    *** WARNING: circuit load " (rtos linye-w 2 0) "W > 2000W")))
  (if (and (> sorti-cnt 0) (= linye-w 0.0))
    (princ "\n    *** WARNING: points found but total power is 0W - power data missing!"))
  (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            LOAD SCHEDULE - SUMMARY")
  (princ "\n====================================================")
  (princ (strcat "\nCircuits            : " (itoa (yukcel:tv "linye" tot))))
  (princ (strcat "\nPoints              : " (itoa (yukcel:tv "sorti" tot))))
  (princ (strcat "\nLighting total      : " (rtos (yukcel:tv "ayd" tot) 2 0) " W"))
  (princ (strcat "\nSockets total       : " (rtos (yukcel:tv "prz" tot) 2 0) " W"))
  (princ (strcat "\nAppliances total    : " (rtos (yukcel:tv "cih" tot) 2 0) " W"))
  (princ "\n--------------------------------------------")
  (princ (strcat "\nInstalled load      : " (rtos (yukcel:tv "kurulu" tot) 2 0) " W"))
  (princ (strcat "\nDemand load         : " (rtos (yukcel:tv "talep" tot) 2 0) " W"))
  (princ (strcat "\nDemand current (3ph): " (rtos (yukcel:tv "akim" tot) 2 1) " A"))
  (princ (strcat "\nMain breaker        : " (itoa (yukcel:tv "sigorta" tot)) " A"))
  (princ (strcat "\nMain cable          : " (yukcel:tv "kablo" tot) " mm2"))
  (if (> (yukcel:tv "kablo-m" tot) 0)
    (princ (strcat "\nTotal cable         : " (rtos (yukcel:tv "kablo-m" tot) 2 1) " m")))
  (princ "\n\n--- Phase balance ---")
  (setq faz-idx 0)
  (foreach ls *yukcel-linyeler*
    (princ (strcat "\nCircuit " (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 "\nImbalance: " (rtos (yukcel:tv "denge" tot) 2 0) " W"))
  (princ "\n====================================================")
)

;;; ============================================================
;;; Step 3: report (CSV + table in the drawing)
;;; ============================================================

(defun c:LOADSCHED-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*** No circuit data yet! Run LOADSCHED-CIRCUIT first. ***") (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 "Save load schedule"
    (strcat (ep:dwg-base "Project") "-LoadSchedule")
    (append
      (list (list "ELECTRICAL LOAD SCHEDULE")
            (list "Project" (ep:dwg-base ""))
            (list "")
            (list "No" "Circuit" "Type" "Points"
                  "Lighting (W)" "Sockets (W)" "Appliances (W)"
                  "Total (W)" "Current (A)" "Cable"
                  "Cable length (m)" "Breaker" "Phase" "Notes"))
      rows
      (list (list "")
            (list "Installed load (W)" (ep:num (yukcel:tv "kurulu" tot) 0))
            (list "Demand load (W)" (ep:num (yukcel:tv "talep" tot) 0))
            (list "Demand current (A)" (ep:num (yukcel:tv "akim" tot) 1))
            (list "Main breaker (A)" (itoa (yukcel:tv "sigorta" tot)))
            (list "Main cable" (yukcel:tv "kablo" tot))
            (list "Phase R (W)" (ep:num (yukcel:tv "R" tot) 0))
            (list "Phase S (W)" (ep:num (yukcel:tv "S" tot) 0))
            (list "Phase T (W)" (ep:num (yukcel:tv "T" tot) 0))
            (list "Phase imbalance (W)" (ep:num (yukcel:tv "denge" tot) 0))
            (list "Total cable (m)" (ep:num (yukcel:tv "kablo-m" tot) 1)))
    )
  )

  (ep:place-table
    (append
      (list (list "Circuit" "Type" "Points" "Load (W)" "Current (A)"
                  "Cable" "Length (m)" "Breaker" "Phase"))
      table
      (list (list "Installed" "" "" (ep:num (yukcel:tv "kurulu" tot) 0) "" "" "" "" "")
            (list "Demand" "" "" (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-TABLE")
  (ep:finish)
  (princ)
)

;;; ============================================================
;;; Info and settings
;;; ============================================================

(defun c:LOADSCHED ()
  (princ "\n====================================================")
  (princ "\n  LOADSCHED - Electrical Load Schedule")
  (princ "\n====================================================")
  (princ "\n  1) LOADSCHED-LEGEND  : read the legend table")
  (princ "\n  2) LOADSCHED-CIRCUIT : pick and analyse the circuits")
  (princ "\n  3) LOADSCHED-EXPORT  : CSV report + table in the drawing")
  (princ "\n     LOADSCHED-SET     : tolerance and search settings")
  (princ (strcat "\n\n  Connection tolerance: " (rtos *yukcel-tol* 2 2)))
  (princ (strcat "\n  Block search margin : " (rtos *yukcel-blok-margin* 2 2)))
  (princ (strcat "\n  1 drawing unit      : " (rtos (yukcel:mpu) 2 4) " m (INSUNITS)"))
  (princ "\n====================================================")
  (princ)
)

(defun c:LOADSCHED-SET (/ v)
  (setq v (getdist (strcat "\nLine connection tolerance <" (rtos *yukcel-tol* 2 2) ">: ")))
  (if v (setq *yukcel-tol* v))
  (setq v (getdist (strcat "\nBlock search margin <" (rtos *yukcel-blok-margin* 2 2) ">: ")))
  (if v (setq *yukcel-blok-margin* v))
  (princ "\nSettings updated.")
  (princ)
)

;;; BOQ - Builds a bill of quantities from an electrical drawing.
;;; 1) Every block in the legend area is matched with its nearest description text.
;;; 2) All of those blocks in the drawing are counted.
;;; 3) The length of the chosen cable layer+color groups is computed in metres.
;;; 4) The result is written to a CSV file (Excel) and, optionally, as a table in the drawing.

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

(defun kesif:color-name (c)
  (cond
    ((= c 1) "Red")
    ((= c 2) "Yellow")
    ((= c 3) "Green")
    ((= c 4) "Cyan")
    ((= c 5) "Blue")
    ((= c 6) "Magenta")
    ((= c 7) "White")
    (T (strcat "Color-" (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) "inch")
    ((= u 2) "feet")
    ((= u 4) "millimetres")
    ((= u 5) "centimetres")
    ((= u 6) "metres")
    ((= u 7) "kilometres")
    (T "unitless (treated as mm)")
  )
)

;;; 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:BOQ (/ *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  BOQ - Bill of Quantities")
  (princ "\n============================================")

  ;; --- 1. Scale and units ---
  (setq s (getstring (strcat "\nDrawing scale (1:1, 1:50 ...) <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>> Scale 1:" (rtos scale 2 0)
                 ", drawing units: " (kesif:unit-name insunits)))

  ;; --- 2. Legend ---
  (princ "\n\n--- LEGEND ---")
  (setq p1 (getpoint "\nFirst corner of the legend area: "))
  (if (not p1) (exit))
  (setq p2 (getcorner p1 "\nOpposite corner: "))
  (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>> Nothing found in the legend area.") (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>> No blocks in the legend area.") (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)) " block-to-item matches"))

  ;; --- 3. Cable groups (layer + color) ---
  (princ "\n\n--- CABLES ---")
  (setq groups nil more T)
  (while more
    (setq sel (entsel "\nPick one cable of each type (Enter to finish): "))
    (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) " already listed"))
          (progn
            (setq groups (append groups (list key)))
            (princ (strcat "\n>> Added: " lay " | " (kesif:color-name col)))
          )
        )
      )
      (setq more nil)
    )
  )

  ;; --- 4. Counting ---
  (princ "\n\n--- COUNTING ---")
  (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 "No" "Item / Description" "Unit" "Quantity"))
        sira 0)
  (foreach c counts
    (setq sira (1+ sira))
    (setq rows (append rows (list (list (itoa sira) (cdr (assoc (car c) dict)) "pcs" (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  BILL OF QUANTITIES")
  (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  Total " (itoa sira) " items"
                 (if (> total-m 0) (strcat ", cable " (rtos total-m 2 2) " m") "")))

  (if (> sira 0)
    (progn
      (setq proj (strcat (ep:dwg-base "Project") "-BOQ"))
      (ep:csv-save "Save bill of quantities" proj
        (append
          (list (list "ELECTRICAL BILL OF QUANTITIES")
                (list "Project" (ep:dwg-base ""))
                (list "Scale" (strcat "1:" (rtos scale 2 0)))
                (list "")
                (list "No" "Ref" "Item / Description" "Unit" "Quantity" "Unit Price" "Total"))
          (mapcar '(lambda (r) (list (nth 0 r) "" (nth 1 r) (nth 2 r) (nth 3 r) "" "")) (cdr rows))
        )
      )
      (ep:place-table rows "EP-TABLE")
    )
  )
  (ep:finish)
  (princ)
)

;;; SUMLEN - Adds up the lengths of the selected lines, arcs, circles and polylines.

(defun c:SUMLEN (/ *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 "\nSelect the objects to measure: ")
  (setq ss (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,POLYLINE,ELLIPSE,SPLINE"))))
  (if (not ss)
    (princ "\nNo suitable objects selected.")
    (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  Lines          (" (itoa n-line) ") : " (rtos t-line 2 2))))
      (if (> n-arc 0)
        (princ (strcat "\n  Arcs + circles  (" (itoa n-arc) ") : " (rtos t-arc 2 2))))
      (if (> n-poly 0)
        (princ (strcat "\n  Polylines      (" (itoa n-poly) ") : " (rtos t-poly 2 2))))
      (if (> n-other 0)
        (princ (strcat "\n  Ellipses + splines (" (itoa n-other) ") : " (rtos t-other 2 2))))
      (princ "\n----------------------------------------")
      (princ (strcat "\n  TOTAL LENGTH : " (rtos total 2 2) " units"))
      (princ "\n----------------------------------------")
    )
  )
  (ep:finish)
  (princ)
)

;;; CABLEROUTE - Orthogonal cable routing (parallel to walls, 90 degree turns only).
;;; The user clicks points; for every pair of points the nearest wall/line
;;; is found and the cable runs at a fixed distance from it, horizontal/vertical only.

;;; --- GLOBAL AYARLAR ---
(if (not *KB-OFFSET*) (setq *KB-OFFSET* 6.0))        ; distance from the reference line
(if (not *KB-LAYER*)  (setq *KB-LAYER* "E-CABLE"))
(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 "\nNot enough points.") (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>> Segment " (itoa (1+ i)) ": no reference"))
        ;; Referans bulunamadiysa onceki segmentin referansini kullan
        (if seg-refs
          (setq ref-bilgi (last seg-refs))
        )
      )
      (princ (strcat "\n>> Segment " (itoa (1+ i)) ": "
                     (if (nth 3 ref-bilgi) "horizontal" "vertical")
                     " 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
)

;;; ============================================================
;;; CABLEROUTE command
;;; ============================================================

(defun c:CABLEROUTE (/ *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  CABLE ROUTING")
  (princ "\n====================================================")
  (princ "\n  Left click  : add a point (corner / pass-through)")
  (princ "\n  Right click : finish this cable, start a new one")
  (princ "\n  ESC         : exit the command")
  (princ (strcat "\n  Offset      : " (rtos *KB-OFFSET* 2 1)
                 " (change with CABLEROUTE-SET)"))
  (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 "\nCable #" (itoa kablo-no)
                               " - start point [ESC=exit]: ")))
    (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 "\nPoint " (itoa (1+ (length noktalar)))
                                     " [Right click=finish cable]: ")))
          (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) " segments, "
                               (rtos toplam-uzunluk 2 1) " units"))
              )
              (princ "\n!! Could not build the route.")
            )
          )
          (princ "\n>> Not enough points, skipped.")
        )
        (princ "\n----------------------------------------------------")
      )
    )
  )
  (if (> genel-toplam 0.0)
    (princ (strcat "\n>> Total cable: " (rtos genel-toplam 2 1) " units"))
  )
  (ep:finish)
  (princ "\n>> Cable drawing finished.")
  (princ)
)

;;; ============================================================
;;; Settings
;;; ============================================================

(defun c:CABLEROUTE-SET (/ tmp)
  (princ "\n--- CABLE SETTINGS ---")
  (setq tmp (getdist (strcat "\nOffset from wall <" (rtos *KB-OFFSET* 2 1) ">: ")))
  (if tmp (setq *KB-OFFSET* tmp))
  (setq tmp (getstring T (strcat "\nLayer <" *KB-LAYER* ">: ")))
  (if (/= tmp "") (setq *KB-LAYER* tmp))
  (setq tmp (getint (strcat "\nColor (1-255) <" (itoa *KB-COLOR*) ">: ")))
  (if (and tmp (> tmp 0) (< tmp 256)) (setq *KB-COLOR* tmp))
  (setq tmp (getdist (strcat "\nReference search radius <" (rtos *KB-ARAMA* 2 1) ">: ")))
  (if tmp (setq *KB-ARAMA* tmp))
  (princ "\nSettings updated.")
  (princ)
)

;;; AREAGRID - Places blocks (luminaires, detectors ...) in evenly spaced rows and columns inside an area.

(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:AREAGRID (/ *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 "\nOne corner of the area: "))
           (setq p2 (getcorner p1 "\nOpposite corner: "))
           (setq name (ep:ask-block *ld-last*)))
    (progn
      (setq *ld-last* name)
      (initget 6)
      (if (setq v (getint (strcat "\nColumns <" (itoa *ld-nx*) ">: "))) (setq *ld-nx* v))
      (initget 6)
      (if (setq v (getint (strcat "\nRows <" (itoa *ld-ny*) ">: "))) (setq *ld-ny* v))
      (initget 6)
      (if (setq v (getreal (strcat "\nBlock scale <" (rtos *ld-sc* 2 2) ">: "))) (setq *ld-sc* v))
      (setq rot (getorient "\nBlock rotation <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) " blocks placed."))
      (ep:finish)
    )
  )
  (princ)
)

;;; BLOCKONLINE - Inserts a block on a line, aligned with it, and opens a gap for it (single-line diagrams).

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

(defun c:BLOCKONLINE (/ *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 "\nGap length (block width) <" (rtos *hb-gap* 2 2) ">: "))) (setq *hb-gap* v))
      (initget 6)
      (if (setq v (getreal (strcat "\nBlock scale <" (rtos *hb-sc* 2 2) ">: "))) (setq *hb-sc* v))
      (ep:begin ep:*insert-vars*)
      (setq n 0)
      (while (setq sel (entsel "\nPoint on a line for the block (Enter = finish): "))
        (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 "\nPick a LINE.")
        )
      )
      (princ (strcat "\n" (itoa n) " blocks placed."))
      (ep:finish)
    )
  )
  (princ)
)

;;; TXTMOD - Changes the height, rotation, style or width factor of many texts at once.

(defun c:TXTMOD (/ *error* ss ents opt v n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect the texts to change: ")
  (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)) " texts selected."))
      (initget "Height Rotation Style Width")
      (setq opt (getkword "\nWhat to change? [Height/Rotation/Style/Width] <Height>: "))
      (if (not opt) (setq opt "Height"))
      (cond
        ((= opt "Height")
          (if (setq v (getdist "\nNew text height: "))
            (foreach e ents (ep:set-dxf e 40 v) (setq n (1+ n))))
        )
        ((= opt "Rotation")
          (if (setq v (getorient "\nNew rotation angle: "))
            (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 "Style")
          (setq v (getstring T (strcat "\nText style <" (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 "\nNo such text style: " v))
          )
        )
        ((= opt "Width")
          (initget 6)
          (if (setq v (getreal "\nWidth factor (e.g. 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) " texts changed."))
      (ep:finish)
    )
  )
  (princ)
)

;;; TXTREPLACE - Find and replace in texts, multiline texts and block attributes.

;;; 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:TXTREPLACE (/ *error* ss old new total objs e a k)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect texts and blocks (Enter = whole drawing): ")
  (setq ss (ssget '((0 . "TEXT,MTEXT,INSERT"))))
  (if (not ss) (setq ss (ssget "_X" '((0 . "TEXT,MTEXT,INSERT")))))
  (setq old (getstring T "\nFind: "))
  (if (and ss (/= old ""))
    (progn
      (setq new (getstring T "\nReplace with: "))
      (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) " objects, " (itoa total) " replacements made."))
      (ep:finish)
    )
  )
  (princ)
)

;;; TXTMATCH - Copies the content of one text into other texts.

(defun c:TXTMATCH (/ *error* src s ss n)
  (defun *error* (m) (ep:on-error m))
  (setq src (entsel "\nPick the source text: "))
  (if (and src (member (ep:dxf (car src) 0) '("TEXT" "MTEXT")))
    (progn
      (setq s (ep:dxf (car src) 1))
      (princ (strcat "\nSource: " s))
      (princ "\nSelect the texts to overwrite: ")
      (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) " texts updated."))
          (ep:finish)
        )
      )
    )
    (princ "\nNo text (TEXT/MTEXT) picked.")
  )
  (princ)
)

;;; TXTSUM - Adds up the numbers written in the selected texts (sum, average, min, max).

(defun c:TXTSUM (/ *error* ss v n total mn mx skipped pt s)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect texts that contain numbers: ")
  (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 "\nNo numbers found in the selected texts.")
        (progn
          (princ "\n----------------------------------------")
          (princ (strcat "\n  Numbers : " (itoa n)
                         (if (> skipped 0) (strcat "  (without a number: " (itoa skipped) ")") "")))
          (princ (strcat "\n  TOTAL      : " (rtos total 2 3)))
          (princ (strcat "\n  Average    : " (rtos (/ total n) 2 3)))
          (princ (strcat "\n  Minimum    : " (rtos mn 2 3)))
          (princ (strcat "\n  Maximum    : " (rtos mx 2 3)))
          (princ "\n----------------------------------------")
          (setq pt (getpoint "\nPick a point to write the total in the drawing (Enter = skip): "))
          (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)
)

;;; TXTSEQ - Writes an increasing number at every click (prefix, suffix and step).

(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:TXTSEQ (/ *error* v s pt h cur)
  (defun *error* (m) (ep:on-error m))
  (setq v (getint (strcat "\nStart number <" (itoa *num-start*) ">: ")))
  (if v (setq *num-start* v))
  (setq v (getint (strcat "\nIncrement <" (itoa *num-step*) ">: ")))
  (if v (setq *num-step* v))
  (setq s (getstring T (strcat "\nPrefix (space = none) <" *num-pre* ">: ")))
  (if (/= s "") (setq *num-pre* (ep:trim s)))
  (setq s (getstring T (strcat "\nSuffix (space = none) <" *num-suf* ">: ")))
  (if (/= s "") (setq *num-suf* (ep:trim s)))
  (setq h (getdist (strcat "\nText height <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
  (if (not h) (setq h (getvar "TEXTSIZE")))
  (ep:begin nil)
  (setq cur *num-start*)
  (while (setq pt (getpoint (strcat "\nPosition [" *num-pre* (itoa cur) *num-suf* "] (Enter = finish): ")))
    (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)
)

;;; TXTCOLUMN - Types lines of text one under another at equal spacing.

(defun c:TXTCOLUMN (/ *error* pt h gap s i)
  (defun *error* (m) (ep:on-error m))
  (setq pt (getpoint "\nStart point of the first line: "))
  (if pt
    (progn
      (setq h (getdist (strcat "\nText height <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
      (if (not h) (setq h (getvar "TEXTSIZE")))
      (setq gap (getdist (strcat "\nLine spacing <" (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 "\nLine " (itoa (1+ i)) " (Enter = finish): "))))
        (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)
)

;;; TXTIMPORT - Imports the lines of a .txt file into the drawing as texts.

(defun c:TXTIMPORT (/ *error* fn f pt h gap s i)
  (defun *error* (m) (if f (close f)) (ep:on-error m))
  (setq fn (getfiled "Choose a text file" (getvar "DWGPREFIX") "txt" 0))
  (if (and fn (setq pt (getpoint "\nStart point of the first line: ")))
    (progn
      (setq h (getdist (strcat "\nText height <" (rtos (getvar "TEXTSIZE") 2 2) ">: ")))
      (if (not h) (setq h (getvar "TEXTSIZE")))
      (setq gap (getdist (strcat "\nLine spacing <" (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) " lines imported."))
      (ep:finish)
    )
  )
  (princ)
)

;;; TXTCENTER - Writes a text exactly in the middle of a rectangular area (room names etc.).

(defun c:TXTCENTER (/ *error* p1 p2 mid s h)
  (defun *error* (m) (ep:on-error m))
  (while (and (setq p1 (getpoint "\nOne corner of the area (Enter = finish): "))
              (setq p2 (getcorner p1 "\nOpposite corner: ")))
    (setq mid (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0) 0.0))
    (setq s (getstring T "\nText: "))
    (if (/= s "")
      (progn
        (if (not h)
          (progn
            (setq h (getdist (strcat "\nText height <" (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)
)

;;; STYLEPICK - Makes the style of a picked text the current text style.

(defun c:STYLEPICK (/ e st)
  (setq e (entsel "\nPick a text to take its style: "))
  (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 "\nCurrent text style: " st))
    )
    (princ "\nNo text picked.")
  )
  (princ)
)

;;; SCALEEACH - Scales every object about its own insertion point (blocks, texts).

;;; 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:SCALEEACH (/ *error* ss f n skip b)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect the blocks / texts to scale: ")
  (if (setq ss (ssget '((0 . "INSERT,TEXT,MTEXT,CIRCLE,ARC,POINT"))))
    (progn
      (initget 6)
      (if (setq f (getreal "\nScale factor: "))
        (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) " objects scaled."))
          (ep:finish)
        )
      )
    )
  )
  (princ)
)

;;; LAYERASE - Erases ALL objects on the layer of a picked object (in every layout).

(defun c:LAYERASE (/ *error* e lay ss n ans)
  (defun *error* (m) (ep:on-error m))
  (setq e (entsel "\nPick an object on the layer to clear: "))
  (if e
    (progn
      (setq lay (ep:dxf (car e) 8)
            ss (ssget "_X" (list (cons 8 lay)))
            n (if ss (sslength ss) 0))
      (initget "Yes No")
      (setq ans (getkword (strcat "\n" lay " layer: " (itoa n)
                                  " objects will be erased. Continue? [Yes/No] <No>: ")))
      (if (= ans "Yes")
        (progn
          (ep:begin nil)
          (foreach x (ep:ss-list ss) (entdel x))
          (princ (strcat "\n" (itoa n) " objects erased. Use U to undo."))
          (ep:finish)
        )
        (princ "\nCancelled.")
      )
    )
  )
  (princ)
)

;;; LAYTOPICK - Moves the selected objects to the layer of a picked sample object.

(defun c:LAYTOPICK (/ *error* ss e lay n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect the objects to move: ")
  (if (and (setq ss (ssget))
           (setq e (entsel "\nPick an object on the target layer: ")))
    (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) " objects moved to " lay "."))
      (ep:finish)
    )
  )
  (princ)
)

;;; LAYTOCUR - Moves the selected objects to the current layer.

(defun c:LAYTOCUR (/ *error* ss n)
  (defun *error* (m) (ep:on-error m))
  (princ (strcat "\nSelect objects to move to the current layer (" (getvar "CLAYER") ") : "))
  (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) " objects moved."))
      (ep:finish)
    )
  )
  (princ)
)

;;; LAYSETPICK - Makes the layer of a picked object the current layer.

(defun c:LAYSETPICK (/ e lay)
  (setq e (entsel "\nPick an object to make its layer current: "))
  (if e
    (progn
      (setq lay (ep:dxf (car e) 8))
      (setvar "CLAYER" lay)
      (princ (strcat "\nCurrent layer: " lay))
    )
  )
  (princ)
)

;;; LAYFRZPICK - Freezes the layers of the objects you click.

(defun c:LAYFRZPICK (/ *error* e lay done)
  (defun *error* (m) (ep:on-error m))
  (ep:begin nil)
  (setq done nil)
  (while (setq e (entsel "\nObject whose layer to freeze (Enter = finish): "))
    (setq lay (ep:dxf (car e) 8))
    (if (= (strcase lay) (strcase (getvar "CLAYER")))
      (princ (strcat "\n" lay " is the current layer and cannot be frozen."))
      (progn
        (command "_.-LAYER" "_F" lay "")
        (setq done (cons lay done))
        (princ (strcat "\n" lay " frozen."))
      )
    )
  )
  (if done (princ (strcat "\n" (itoa (length done)) " layers frozen. Use LAYTHW or LAYER to thaw them.")))
  (ep:finish)
  (princ)
)

;;; COLOR TOOLS - Change the color of selected objects with one command (CRED, CYELLOW, ... COL11 ...).

(defun renk:set (c / *error* ss n)
  (defun *error* (m) (ep:on-error m))
  (princ (strcat "\nColor " (cond ((= c 256) "ByLayer") ((= c 0) "ByBlock") (T (itoa c)))
                 " - select objects: "))
  (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) " objects recolored."))
      (ep:finish)
    )
  )
  (princ)
)

(defun c:SETCOLOR (/ c)
  (initget 4 "ByLayer ByBlock")
  (setq c (getint "\nColor number (1-255) or [ByLayer/ByBlock]: "))
  (cond
    ((= c "ByLayer") (renk:set 256))
    ((= c "ByBlock") (renk:set 0))
    ((and c (> c 0) (< c 256)) (renk:set c))
    (c (princ "\nInvalid color."))
  )
  (princ)
)

(defun c:CRED () (renk:set 1))
(defun c:CYELLOW () (renk:set 2))
(defun c:CGREEN () (renk:set 3))
(defun c:CCYAN () (renk:set 4))
(defun c:CBLUE () (renk:set 5))
(defun c:CMAGENTA () (renk:set 6))
(defun c:CWHITE () (renk:set 7))
(defun c:CGRAY () (renk:set 8))
(defun c:CLGRAY () (renk:set 9))
(defun c:CBYLAYER () (renk:set 256))
(defun c:COL11 () (renk:set 11))
(defun c:COL12 () (renk:set 12))
(defun c:COL21 () (renk:set 21))
(defun c:COL25 () (renk:set 25))
(defun c:COL30 () (renk:set 30))
(defun c:COL33 () (renk:set 33))
(defun c:COL40 () (renk:set 40))
(defun c:COL41 () (renk:set 41))
(defun c:COL125 () (renk:set 125))
(defun c:COL140 () (renk:set 140))
(defun c:COL175 () (renk:set 175))
(defun c:COL215 () (renk:set 215))
(defun c:COL230 () (renk:set 230))

;;; LTHIDDEN - Sets the linetype of the selected objects to HIDDEN (loads it when needed).

(defun c:LTHIDDEN (/ *error* ss lin n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect objects to make dashed: ")
  (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) " objects set to HIDDEN. Adjust LTSCALE if the dashes are not visible."))
        )
        (princ "\nCould not load the HIDDEN linetype.")
      )
      (ep:finish)
    )
  )
  (princ)
)

;;; DOUBLELINE - Draws a double line (two parallel polylines) of a given width with clean corners.

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

;;; 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:DOUBLELINE (/ *error* v r pts closed w d1 d2 lay)
  (defun *error* (m) (redraw) (ep:on-error m))
  (setq v (getdist (strcat "\nWidth <" (rtos *par-w* 2 2) ">: ")))
  (if v (setq *par-w* v))
  (initget "Center Left Right")
  (setq v (getkword (strcat "\nJustification [Center/Left/Right] <" *par-j* ">: ")))
  (if v (setq *par-j* v))
  (setq r (ep:collect-points "\nStart point: ")
        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* "Left") (setq d1 w d2 0.0))
        ((= *par-j* "Right") (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)
)

;;; FENCEBREAK - Breaks every line crossed by a fence you draw at the crossing points.

(defun c:FENCEBREAK (/ *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 "\nFirst point of the fence: ")
        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) " breaks made."))
      (ep:finish)
    )
    (if fence (princ "\nNo LINE crosses the fence."))
  )
  (princ)
)

;;; BRKBETWEEN - Removes the part of the selected lines that lies between two cutting lines.

(defun c:BRKBETWEEN (/ *error* c1 c2 k1 k2 ss n q p1 p2)
  (defun *error* (m) (ep:on-error m))
  (setq c1 (entsel "\nFirst cutting line: "))
  (if (and c1 (= (ep:dxf (car c1) 0) "LINE")
           (setq c2 (entsel "\nSecond cutting line: "))
           (= (ep:dxf (car c2) 0) "LINE"))
    (progn
      (setq k1 (ep:line-ucs (car c1)) k2 (ep:line-ucs (car c2)))
      (princ "\nSelect the lines to cut: ")
      (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) " lines cut."))
          (ep:finish)
        )
      )
    )
    (princ "\nThe cutting lines must be LINE objects.")
  )
  (princ)
)

;;; WALLGAP - Opens a door/window gap in a double-line wall and closes the jambs.

(defun c:WALLGAP (/ *error* w1 w2 q1 q2 p1 p2 a1 b1 a2 b2 lay)
  (defun *error* (m) (ep:on-error m))
  (setq w1 (entsel "\nFirst line of the wall: "))
  (if (and w1 (= (ep:dxf (car w1) 0) "LINE")
           (setq w2 (entsel "\nSecond line of the wall: "))
           (= (ep:dxf (car w2) 0) "LINE")
           (setq p1 (getpoint "\nStart of the gap: "))
           (setq p2 (getpoint p1 "\nEnd of the gap: ")))
    (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 "\nGap opened.")
          (ep:finish)
        )
        (princ "\nThe gap points fall outside the wall lines.")
      )
    )
  )
  (princ)
)

;;; SWAPOBJ - Swaps the positions of two groups of objects.

(defun c:SWAPOBJ (/ *error* ss1 ss2 b1 b2)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect the first group: ")
  (if (and (setq ss1 (ssget))
           (princ "\nSelect the second group: ")
           (setq ss2 (ssget))
           (setq b1 (getpoint "\nReference point of the first group: "))
           (setq b2 (getpoint "\nReference point of the second group: ")))
    (progn
      (ep:begin nil)
      (command "_.MOVE" ss1 "" "_non" b1 "_non" b2)
      (command "_.MOVE" ss2 "" "_non" b2 "_non" b1)
      (princ "\nSwapped.")
      (ep:finish)
    )
  )
  (princ)
)

;;; BLKSWAP - Replaces the selected blocks with another block, keeping position, rotation, scale, layer and attribute values.

(defun c:BLKSWAP (/ *error* ss name ed pt sx sy sz rot lay vals new n)
  (defun *error* (m) (ep:on-error m))
  (princ "\nSelect the blocks to replace: ")
  (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) " blocks replaced."))
      (ep:finish)
    )
  )
  (princ)
)

;;; DIRECTIONAL STRETCH - Stretches a crossing-window selection left/right/up/down by a given distance.

(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 "\nDistance <" (rtos *yu-d* 2 2) ">: ")))
  (if d (setq *yu-d* d))
  (if (and (setq p1 (getpoint "\nFirst corner of the crossing window: "))
           (setq p2 (getcorner p1 "\nOpposite corner: ")))
    (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:STRETCHL () (yu:run pi))
(defun c:STRETCHR () (yu:run 0.0))
(defun c:STRETCHU () (yu:run (/ pi 2.0)))
(defun c:STRETCHD () (yu:run (/ pi -2.0)))


(princ "\n[eplisp] loaded. Commands: ...")
(princ)