;;; CABLEROUTE - Orthogonal cable routing
;;; 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: CABLEROUTE, CABLEROUTE-SET

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

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


(princ "\n[eplisp] loaded. Commands: CABLEROUTE, CABLEROUTE-SET")
(princ)