(vl-load-com)

;;; ============================================================
;;; HUEFLOW_WALLDIM.lsp
;;; Internal room dimension generator from WALL layer linework.
;;;
;;; Commands
;;;   HWD    - pick inside one room, create internal width/height dims
;;;   HWDA   - auto scan orthogonal WALL linework and dim detected rooms
;;;   HWDSET - edit layer/tolerance/probe/offset settings
;;;   HWDDEL - delete generated dimensions on the HWD dim layer
;;;
;;; Best input
;;;   - WALL layer contains LINE/LWPOLYLINE/POLYLINE wall boundary lines
;;;   - Mostly horizontal/vertical floor plans
;;;   - Closed or visually bounded room wall lines
;;; ============================================================

(if (null HWD:WALL-LAYER) (setq HWD:WALL-LAYER "WALL"))
(if (null HWD:DIM-LAYER)  (setq HWD:DIM-LAYER  "HF-DIM-INTERNAL"))
(if (null HWD:TOL)        (setq HWD:TOL        20.0))
(if (null HWD:PROBE)      (setq HWD:PROBE      450.0))
(if (null HWD:OFFSET)     (setq HWD:OFFSET     250.0))
(if (null HWD:MIN-DIM)    (setq HWD:MIN-DIM    600.0))

(setq HWD:OLD-OSMODE nil)
(setq HWD:OLD-CMDECHO nil)
(setq HWD:OLD-CLAYER nil)
(setq HWD:OLD-ERROR nil)

(defun hwd:min (a b) (if (< a b) a b))
(defun hwd:max (a b) (if (> a b) a b))
(defun hwd:abs (a) (if (< a 0.0) (- a) a))
(defun hwd:pt (x y) (list x y 0.0))

(defun hwd:restore ( / )
  (if HWD:OLD-OSMODE
    (progn (setvar "OSMODE" HWD:OLD-OSMODE) (setq HWD:OLD-OSMODE nil))
  )
  (if HWD:OLD-CMDECHO
    (progn (setvar "CMDECHO" HWD:OLD-CMDECHO) (setq HWD:OLD-CMDECHO nil))
  )
  (if HWD:OLD-CLAYER
    (progn (setvar "CLAYER" HWD:OLD-CLAYER) (setq HWD:OLD-CLAYER nil))
  )
  (if HWD:OLD-ERROR
    (progn (setq *error* HWD:OLD-ERROR) (setq HWD:OLD-ERROR nil))
  )
)

(defun hwd:error (msg)
  (if (not (member msg '("Function cancelled" "quit / exit abort" "console break")))
    (princ (strcat "\n[HWD error] " msg))
    (princ "\n[HWD] Cancelled.")
  )
  (hwd:restore)
  (princ)
)

(defun hwd:begin ( / )
  (setq HWD:OLD-OSMODE (getvar "OSMODE"))
  (setq HWD:OLD-CMDECHO (getvar "CMDECHO"))
  (setq HWD:OLD-CLAYER (getvar "CLAYER"))
  (setq HWD:OLD-ERROR *error*)
  (setq *error* hwd:error)
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
)

(defun hwd:end ( / )
  (hwd:restore)
  (princ)
)

(defun hwd: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")
      )
    )
  )
)

(defun hwd:get-string-default (prompt def / s)
  (setq s (getstring T (strcat prompt " <" def ">: ")))
  (if (= s "") def s)
)

(defun hwd:get-real-default (prompt def / v)
  (setq v (getreal (strcat prompt " <" (rtos def 2 1) ">: ")))
  (if v v def)
)

(defun hwd:between (v a b tol)
  (and
    (>= v (- (hwd:min a b) tol))
    (<= v (+ (hwd:max a b) tol))
  )
)

(defun hwd:normal-seg (p1 p2 tol ent / x1 y1 x2 y2 dx dy y x)
  (setq x1 (car p1))
  (setq y1 (cadr p1))
  (setq x2 (car p2))
  (setq y2 (cadr p2))
  (setq dx (- x2 x1))
  (setq dy (- y2 y1))
  (cond
    ((< (distance (hwd:pt x1 y1) (hwd:pt x2 y2)) tol)
      nil
    )
    ((<= (hwd:abs dy) tol)
      (setq y (/ (+ y1 y2) 2.0))
      (list "H" (hwd:min x1 x2) y (hwd:max x1 x2) y ent)
    )
    ((<= (hwd:abs dx) tol)
      (setq x (/ (+ x1 x2) 2.0))
      (list "V" x (hwd:min y1 y2) x (hwd:max y1 y2) ent)
    )
    (T
      nil
    )
  )
)

(defun hwd:lwpoly-points (ent / ed pts d p)
  (setq ed (entget ent))
  (setq pts '())
  (foreach d ed
    (if (= (car d) 10)
      (progn
        (setq p (cdr d))
        (setq pts (append pts (list (hwd:pt (car p) (cadr p)))))
      )
    )
  )
  pts
)

(defun hwd:oldpoly-points (ent / e ed pts p)
  (setq e (entnext ent))
  (setq pts '())
  (while (and e (/= (cdr (assoc 0 (setq ed (entget e)))) "SEQEND"))
    (if (= (cdr (assoc 0 ed)) "VERTEX")
      (progn
        (setq p (cdr (assoc 10 ed)))
        (setq pts (append pts (list (hwd:pt (car p) (cadr p)))))
      )
    )
    (setq e (entnext e))
  )
  pts
)

(defun hwd:segments-from-points (pts closed tol ent / q segs seg)
  (setq q pts)
  (setq segs '())
  (while (and q (cdr q))
    (setq seg (hwd:normal-seg (car q) (cadr q) tol ent))
    (if seg (setq segs (cons seg segs)))
    (setq q (cdr q))
  )
  (if (and closed (> (length pts) 2))
    (progn
      (setq seg (hwd:normal-seg (car (last pts)) (car pts) tol ent))
      (if seg (setq segs (cons seg segs)))
    )
  )
  segs
)

(defun hwd:collect-segments (layer tol / ss i ent ed typ p1 p2 pts closed seg all)
  (setq ss (ssget "_X" (list (cons 8 layer) (cons 0 "LINE,LWPOLYLINE,POLYLINE"))))
  (setq all '())
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (setq ed (entget ent))
        (setq typ (cdr (assoc 0 ed)))
        (cond
          ((= typ "LINE")
            (setq p1 (cdr (assoc 10 ed)))
            (setq p2 (cdr (assoc 11 ed)))
            (setq seg (hwd:normal-seg p1 p2 tol ent))
            (if seg (setq all (cons seg all)))
          )
          ((= typ "LWPOLYLINE")
            (setq pts (hwd:lwpoly-points ent))
            (setq closed (= 1 (logand 1 (cdr (assoc 70 ed)))))
            (setq all (append (hwd:segments-from-points pts closed tol ent) all))
          )
          ((= typ "POLYLINE")
            (setq pts (hwd:oldpoly-points ent))
            (setq closed (= 1 (logand 1 (cdr (assoc 70 ed)))))
            (setq all (append (hwd:segments-from-points pts closed tol ent) all))
          )
        )
        (setq i (1+ i))
      )
    )
  )
  all
)

(defun hwd:ray-x (pt segs tol / px py left right s x)
  (setq px (car pt))
  (setq py (cadr pt))
  (setq left nil)
  (setq right nil)
  (foreach s segs
    (if (and (= (car s) "V") (hwd:between py (nth 2 s) (nth 4 s) tol))
      (progn
        (setq x (nth 1 s))
        (cond
          ((< x (- px tol))
            (if (or (null left) (> x left)) (setq left x))
          )
          ((> x (+ px tol))
            (if (or (null right) (< x right)) (setq right x))
          )
        )
      )
    )
  )
  (if (and left right) (list left right) nil)
)

(defun hwd:ray-y (pt segs tol / px py bottom top s y)
  (setq px (car pt))
  (setq py (cadr pt))
  (setq bottom nil)
  (setq top nil)
  (foreach s segs
    (if (and (= (car s) "H") (hwd:between px (nth 1 s) (nth 3 s) tol))
      (progn
        (setq y (nth 2 s))
        (cond
          ((< y (- py tol))
            (if (or (null bottom) (> y bottom)) (setq bottom y))
          )
          ((> y (+ py tol))
            (if (or (null top) (< y top)) (setq top y))
          )
        )
      )
    )
  )
  (if (and bottom top) (list bottom top) nil)
)

(defun hwd:add-pair-cluster (pair clusters tol / out done c cnt sum1 sum2 avg1 avg2)
  (setq out '())
  (setq done nil)
  (foreach c clusters
    (if
      (and
        (not done)
        (<= (hwd:abs (- (car pair) (nth 0 c))) tol)
        (<= (hwd:abs (- (cadr pair) (nth 1 c))) tol)
      )
      (progn
        (setq cnt (1+ (nth 2 c)))
        (setq sum1 (+ (nth 3 c) (car pair)))
        (setq sum2 (+ (nth 4 c) (cadr pair)))
        (setq avg1 (/ sum1 cnt))
        (setq avg2 (/ sum2 cnt))
        (setq out (cons (list avg1 avg2 cnt sum1 sum2) out))
        (setq done T)
      )
      (setq out (cons c out))
    )
  )
  (if (not done)
    (setq out (cons (list (car pair) (cadr pair) 1 (car pair) (cadr pair)) out))
  )
  out
)

(defun hwd:best-pair (clusters / best c)
  (setq best nil)
  (foreach c clusters
    (if
      (or
        (null best)
        (> (nth 2 c) (nth 2 best))
        (and (= (nth 2 c) (nth 2 best))
             (< (- (nth 1 c) (nth 0 c)) (- (nth 1 best) (nth 0 best))))
      )
      (setq best c)
    )
  )
  (if best (list (nth 0 best) (nth 1 best) (nth 2 best)) nil)
)

(defun hwd:sample-offsets (probe)
  (list (- probe) (- (/ probe 2.0)) 0.0 (/ probe 2.0) probe)
)

(defun hwd:stable-x-pair (pt segs probe tol / clusters off pair)
  (setq clusters '())
  (foreach off (hwd:sample-offsets probe)
    (setq pair (hwd:ray-x (hwd:pt (car pt) (+ (cadr pt) off)) segs tol))
    (if pair (setq clusters (hwd:add-pair-cluster pair clusters (* tol 2.0))))
  )
  (hwd:best-pair clusters)
)

(defun hwd:stable-y-pair (pt segs probe tol / clusters off pair)
  (setq clusters '())
  (foreach off (hwd:sample-offsets probe)
    (setq pair (hwd:ray-y (hwd:pt (+ (car pt) off) (cadr pt)) segs tol))
    (if pair (setq clusters (hwd:add-pair-cluster pair clusters (* tol 2.0))))
  )
  (hwd:best-pair clusters)
)

(defun hwd:find-room (pt segs probe tol minDim / xp yp left right bottom top)
  (setq xp (hwd:stable-x-pair pt segs probe tol))
  (setq yp (hwd:stable-y-pair pt segs probe tol))
  (if (and xp yp)
    (progn
      (setq left (nth 0 xp))
      (setq right (nth 1 xp))
      (setq bottom (nth 0 yp))
      (setq top (nth 1 yp))
      (if (and (> (- right left) minDim) (> (- top bottom) minDim))
        (list left right bottom top (nth 2 xp) (nth 2 yp))
        nil
      )
    )
    nil
  )
)

(defun hwd:dim-linear (p1 p2 loc /)
  (command "_.DIMLINEAR" p1 p2 loc)
)

(defun hwd:room-dims (room / left right bottom top cx cy w h hloc vloc off)
  (setq left (nth 0 room))
  (setq right (nth 1 room))
  (setq bottom (nth 2 room))
  (setq top (nth 3 room))
  (setq cx (/ (+ left right) 2.0))
  (setq cy (/ (+ bottom top) 2.0))
  (setq w (- right left))
  (setq h (- top bottom))
  (setq off HWD:OFFSET)
  (setq hloc (if (> h (* off 3.0)) (+ bottom off) cy))
  (setq vloc (if (> w (* off 3.0)) (+ left off) cx))
  (hwd:dim-linear (hwd:pt left cy) (hwd:pt right cy) (hwd:pt cx hloc))
  (hwd:dim-linear (hwd:pt cx bottom) (hwd:pt cx top) (hwd:pt vloc cy))
)

(defun hwd:unique-sorted (vals tol / sorted out lastv v)
  (setq sorted (vl-sort vals '<))
  (setq out '())
  (setq lastv nil)
  (foreach v sorted
    (if (or (null lastv) (> (hwd:abs (- v lastv)) tol))
      (progn
        (setq out (append out (list v)))
        (setq lastv v)
      )
    )
  )
  out
)

(defun hwd:grid-values (segs / xs ys s)
  (setq xs '())
  (setq ys '())
  (foreach s segs
    (cond
      ((= (car s) "V") (setq xs (cons (nth 1 s) xs)))
      ((= (car s) "H") (setq ys (cons (nth 2 s) ys)))
    )
  )
  (list
    (hwd:unique-sorted xs (* HWD:TOL 2.0))
    (hwd:unique-sorted ys (* HWD:TOL 2.0))
  )
)

(defun hwd:room-exists (room rooms tol / found r)
  (setq found nil)
  (foreach r rooms
    (if
      (and
        (<= (hwd:abs (- (nth 0 room) (nth 0 r))) tol)
        (<= (hwd:abs (- (nth 1 room) (nth 1 r))) tol)
        (<= (hwd:abs (- (nth 2 room) (nth 2 r))) tol)
        (<= (hwd:abs (- (nth 3 room) (nth 3 r))) tol)
      )
      (setq found T)
    )
  )
  found
)

(defun hwd:add-room (room rooms tol)
  (if (hwd:room-exists room rooms tol)
    rooms
    (cons room rooms)
  )
)

(defun hwd:auto-detect-rooms (segs / gv xs ys rooms i j x1 x2 y1 y2 cx cy room maxcells cells)
  (setq gv (hwd:grid-values segs))
  (setq xs (car gv))
  (setq ys (cadr gv))
  (setq rooms '())
  (setq maxcells 4000)
  (setq cells (* (hwd:max 0 (1- (length xs))) (hwd:max 0 (1- (length ys)))))
  (if (> cells maxcells)
    (progn
      (princ (strcat "\n[HWD] Too many scan cells (" (itoa cells) "). Use HWD on picked rooms, or clean/split WALL layer."))
      nil
    )
    (progn
      (setq i 0)
      (while (< i (1- (length xs)))
        (setq x1 (nth i xs))
        (setq x2 (nth (1+ i) xs))
        (if (> (- x2 x1) HWD:MIN-DIM)
          (progn
            (setq j 0)
            (while (< j (1- (length ys)))
              (setq y1 (nth j ys))
              (setq y2 (nth (1+ j) ys))
              (if (> (- y2 y1) HWD:MIN-DIM)
                (progn
                  (setq cx (/ (+ x1 x2) 2.0))
                  (setq cy (/ (+ y1 y2) 2.0))
                  (setq room (hwd:find-room (hwd:pt cx cy) segs HWD:PROBE HWD:TOL HWD:MIN-DIM))
                  (if room
                    (setq rooms (hwd:add-room room rooms (* HWD:TOL 3.0)))
                  )
                )
              )
              (setq j (1+ j))
            )
          )
        )
        (setq i (1+ i))
      )
      (reverse rooms)
    )
  )
)

(defun c:HWDSET ( / )
  (setq HWD:WALL-LAYER (hwd:get-string-default "\nWall layer" HWD:WALL-LAYER))
  (setq HWD:DIM-LAYER  (hwd:get-string-default "\nDimension layer" HWD:DIM-LAYER))
  (setq HWD:TOL        (hwd:get-real-default "\nAxis snap tolerance" HWD:TOL))
  (setq HWD:PROBE      (hwd:get-real-default "\nOpening bypass probe distance" HWD:PROBE))
  (setq HWD:OFFSET     (hwd:get-real-default "\nDimension line offset" HWD:OFFSET))
  (setq HWD:MIN-DIM    (hwd:get-real-default "\nMinimum room dimension" HWD:MIN-DIM))
  (princ "\n[HWDSET] Saved for this drawing session.")
  (princ)
)

(defun c:HWDDEL ( / ss)
  (setq ss (ssget "_X" (list (cons 8 HWD:DIM-LAYER) (cons 0 "DIMENSION"))))
  (if ss
    (progn
      (command "_.ERASE" ss "")
      (princ (strcat "\n[HWDDEL] Deleted dimensions on " HWD:DIM-LAYER "."))
    )
    (princ (strcat "\n[HWDDEL] No dimensions found on " HWD:DIM-LAYER "."))
  )
  (princ)
)

(defun c:HWD ( / segs pt room)
  (hwd:begin)
  (hwd:ensure-layer HWD:DIM-LAYER 1)
  (setvar "CLAYER" HWD:DIM-LAYER)
  (princ
    (strcat
      "\n[HWD] WALL=" HWD:WALL-LAYER
      ", DIM=" HWD:DIM-LAYER
      ", TOL=" (rtos HWD:TOL 2 1)
      ". Use HWDSET to change."
    )
  )
  (setq segs (hwd:collect-segments HWD:WALL-LAYER HWD:TOL))
  (if (null segs)
    (princ (strcat "\n[HWD] No usable orthogonal LINE/POLYLINE objects found on layer " HWD:WALL-LAYER "."))
    (progn
      (princ (strcat "\n[HWD] Usable wall segments: " (itoa (length segs))))
      (setq pt (getpoint "\nPick inside room: "))
      (if pt
        (progn
          (setq room (hwd:find-room pt segs HWD:PROBE HWD:TOL HWD:MIN-DIM))
          (if room
            (progn
              (hwd:room-dims room)
              (princ
                (strcat
                  "\n[HWD] Internal dims created: "
                  (rtos (- (nth 1 room) (nth 0 room)) 2 0)
                  " x "
                  (rtos (- (nth 3 room) (nth 2 room)) 2 0)
                )
              )
            )
            (princ "\n[HWD] Room boundary not found. Try a point nearer the room center or run HWDSET with larger probe/tolerance.")
          )
        )
      )
    )
  )
  (hwd:end)
)

(defun c:HWDA ( / segs rooms n)
  (hwd:begin)
  (hwd:ensure-layer HWD:DIM-LAYER 1)
  (setvar "CLAYER" HWD:DIM-LAYER)
  (princ
    (strcat
      "\n[HWDA] Auto scan WALL=" HWD:WALL-LAYER
      ", DIM=" HWD:DIM-LAYER
      ". Use HWDSET to change."
    )
  )
  (setq segs (hwd:collect-segments HWD:WALL-LAYER HWD:TOL))
  (if (null segs)
    (princ (strcat "\n[HWDA] No usable orthogonal LINE/POLYLINE objects found on layer " HWD:WALL-LAYER "."))
    (progn
      (princ (strcat "\n[HWDA] Usable wall segments: " (itoa (length segs))))
      (setq rooms (hwd:auto-detect-rooms segs))
      (if rooms
        (progn
          (foreach room rooms (hwd:room-dims room))
          (setq n (length rooms))
          (princ (strcat "\n[HWDA] Rooms dimensioned: " (itoa n)))
        )
        (princ "\n[HWDA] No room candidates found. Try HWD point mode or adjust HWDSET.")
      )
    )
  )
  (hwd:end)
)

(princ "\nHUEFLOW_WALLDIM loaded. Commands: HWD, HWDA, HWDSET, HWDDEL.")
(princ)