;; ============================================================
;; PC V2
;; - 폐합 폴리선 내부에서 가장 가까운 유효 평행 장변을 반대 벽면으로 선택
;; - 두 벽면 사이 정확한 1/2 위치에 중심선 생성
;; - 접합/연장은 잠시 제외하고 중심 위치 정확도만 검증
;; ============================================================

(vl-load-com)

;; ============================================================
;; PC V1 - 폐합 폴리선 벽체 중심선
;; 명령어 : PC
;;
;; 사용:
;; 1) 벽체 외곽을 하나의 CLOSED LWPOLYLINE으로 만든다.
;; 2) PC 실행
;; 3) 폐합 폴리선 선택
;; 4) 내부 장변쌍을 자동 분석하여 중심선 생성
;;
;; 출력:
;; - 도면층 : 벽체중심선
;; - 색상   : 빨강(1)
;;
;; 목적:
;; - 마구리/단부선 제외
;; - 같은 폴리선 내부의 장변끼리만 짝찾기
;; - T / ㄱ 접합부는 가까운 경우 교점까지 연결
;; ============================================================

(setq *PC-MIN-THK* 50.0
      *PC-MAX-THK* 1000.0
      *PC-MIN-LEN* 300.0
      *PC-MIN-OV* 200.0
      *PC-MIN-RATIO* 0.65
      *PC-LONG-RATIO* 2.2
      *PC-JOIN-MAX* 1200.0
      *PC-AXIS-TOL* 8.0)

(defun pc:add (a b)
  (list (+ (car a)(car b))
        (+ (cadr a)(cadr b))
        0.0))

(defun pc:sub (a b)
  (list (- (car a)(car b))
        (- (cadr a)(cadr b))
        0.0))

(defun pc:mul (v k)
  (list (* (car v) k)
        (* (cadr v) k)
        0.0))

(defun pc:dot (a b)
  (+ (* (car a)(car b))
     (* (cadr a)(cadr b))))

(defun pc:cross (a b)
  (- (* (car a)(cadr b))
     (* (cadr a)(car b))))

(defun pc:p3 (p)
  (list (car p)(cadr p) 0.0))

(defun pc:unit (a b / v l)
  (setq v (pc:sub b a)
        l (distance a b))
  (if (> l 1e-9)
    (pc:mul v (/ 1.0 l))
    nil))

(defun pc:ensure-layer (/ doc lays lay)
  (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object))
        lays (vla-get-Layers doc))
  (if (tblsearch "LAYER" "벽체중심선")
    (setq lay (vla-Item lays "벽체중심선"))
    (setq lay (vla-Add lays "벽체중심선")))
  (vla-put-Color lay 1)
  "벽체중심선")

(defun pc:closed-lwpoly-p (e / ed)
  (and e
       (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
       (= 1 (logand 1 (cdr (assoc 70 (entget e)))))))

(defun pc:get-segs (e / ed pts bulges n i p1 p2 b out)
  (setq ed (entget e)
        pts nil
        bulges nil
        out nil)

  ;; vertex / bulge
  (foreach x ed
    (cond
      ((= (car x) 10)
       (setq pts (append pts (list (pc:p3 (cdr x)))))
       (setq bulges (append bulges (list 0.0))))
      ((and (= (car x) 42) (> (length bulges) 0))
       (setq bulges
         (append
           (reverse (cdr (reverse bulges)))
           (list (cdr x)))))))

  (setq n (length pts)
        i 0)

  ;; consecutive segments
  (while (< i (1- n))
    (setq p1 (nth i pts)
          p2 (nth (1+ i) pts)
          b  (nth i bulges))
    (if (and (< (abs b) 1e-10)
             (>= (distance p1 p2) *PC-MIN-LEN*))
      (setq out (cons (list p1 p2 i) out)))
    (setq i (1+ i)))

  ;; closing segment
  (if (> n 2)
    (progn
      (setq p1 (nth (1- n) pts)
            p2 (nth 0 pts)
            b  (nth (1- n) bulges))
      (if (and (< (abs b) 1e-10)
               (>= (distance p1 p2) *PC-MIN-LEN*))
        (setq out (cons (list p1 p2 (1- n)) out)))))

  (reverse out))

(defun pc:seglen (s)
  (distance (nth 0 s)(nth 1 s)))

(defun pc:parallel-p (a b / ua ub)
  (setq ua (pc:unit (nth 0 a)(nth 1 a))
        ub (pc:unit (nth 0 b)(nth 1 b)))
  (and ua ub (> (abs (pc:dot ua ub)) 0.9995)))

(defun pc:perp-dist (a b / u v)
  (setq u (pc:unit (nth 0 a)(nth 1 a))
        v (pc:sub (nth 0 b)(nth 0 a)))
  (if u
    (abs (pc:cross u v))
    1e99))

(defun pc:proj (base u p)
  (pc:dot (pc:sub p base) u))

(defun pc:pairdata (a b / base u a1 a2 b1 b2 tmp lo hi ov la lb d rat)
  (if (pc:parallel-p a b)
    (progn
      (setq d (pc:perp-dist a b))
      (if (and (>= d *PC-MIN-THK*)
               (<= d *PC-MAX-THK*))
        (progn
          (setq base (nth 0 a)
                u    (pc:unit (nth 0 a)(nth 1 a))
                a1   0.0
                a2   (pc:proj base u (nth 1 a))
                b1   (pc:proj base u (nth 0 b))
                b2   (pc:proj base u (nth 1 b)))

          (if (> a1 a2) (setq tmp a1 a1 a2 a2 tmp))
          (if (> b1 b2) (setq tmp b1 b1 b2 b2 tmp))

          (setq lo (max a1 b1)
                hi (min a2 b2)
                ov (- hi lo)
                la (- a2 a1)
                lb (- b2 b1))

          ;; 장변만 인정:
          ;; 짧은 쪽 길이가 벽두께의 2배 이상
          (if (and (>= ov *PC-MIN-OV*)
                   (> (min la lb) 1e-6)
                   (>= (min la lb) (* d *PC-LONG-RATIO*)))
            (progn
              (setq rat (/ ov (min la lb)))
              (if (>= rat *PC-MIN-RATIO*)
                (list d rat ov base u lo hi)
                nil))
            nil))
        nil))
    nil))

(defun pc:score (a b / pd la lb sim d ratio ov)
  (setq pd (pc:pairdata a b))
  (if pd
    (progn
      (setq d     (nth 0 pd)
            ratio (nth 1 pd)
            ov    (nth 2 pd)
            la    (pc:seglen a)
            lb    (pc:seglen b)
            sim   (/ (min la lb)(max la lb)))

      ;; V2 핵심:
      ;; 같은 벽의 반대면은 "가장 가까운 유효 평행선"일 가능성이 가장 높음.
      ;; 거리 우선, 그 다음 겹침률/길이유사도.
      (+ (- 100000.0 (* d 100.0))
         (* ratio 1000.0)
         (* sim 500.0)
         (* ov 0.05)))
    nil))

(defun pc:best-mate (i segs / j sc best bestsc)
  (setq j 0
        best nil
        bestsc -1e99)
  (while (< j (length segs))
    (if (/= i j)
      (progn
        (setq sc (pc:score (nth i segs)(nth j segs)))
        (if (and sc (> sc bestsc))
          (setq best j
                bestsc sc))))
    (setq j (1+ j)))
  best)

(defun pc:center-seg (a b / pd d base u lo hi p1 p2 n side off)
  (setq pd (pc:pairdata a b))
  (if pd
    (progn
      (setq d    (nth 0 pd)
            base (nth 3 pd)
            u    (nth 4 pd)
            lo   (nth 5 pd)
            hi   (nth 6 pd)
            p1   (pc:add base (pc:mul u lo))
            p2   (pc:add base (pc:mul u hi))
            n    (list (- (cadr u))(car u) 0.0)
            side (pc:dot (pc:sub (nth 0 b) p1) n))
      (if (< side 0.0)
        (setq n (pc:mul n -1.0)))
      (setq off (pc:mul n (/ d 2.0)))
      (list
        (pc:add p1 off)
        (pc:add p2 off)))
    nil))

(defun pc:key (i j)
  (if (< i j)
    (strcat (itoa i) ":" (itoa j))
    (strcat (itoa j) ":" (itoa i))))

(defun pc:draw (s / e)
  (if (and s (> (distance (car s)(cadr s)) 1e-6))
    (progn
      (setq e
        (entmakex
          (list '(0 . "LINE")
                (cons 8 "벽체중심선")
                (cons 62 1)
                (cons 10 (car s))
                (cons 11 (cadr s)))))
      (if e (setq *PC-CREATED* (cons e *PC-CREATED*)))
      e)))

;; -----------------------------
;; 후처리: 같은 축 조각 병합
;; -----------------------------
(defun pc:get-centers (/ ss i e ed out)
  (setq ss (ssget "_X" '((0 . "LINE")(8 . "벽체중심선")))
        i 0
        out nil)
  (if ss
    (while (< i (sslength ss))
      (setq e  (ssname ss i)
            ed (entget e))
      (setq out
        (cons
          (list e
                (pc:p3 (cdr (assoc 10 ed)))
                (pc:p3 (cdr (assoc 11 ed))))
          out))
      (setq i (1+ i))))
  (reverse out))

(defun pc:center-parallel-p (a b / ua ub)
  (setq ua (pc:unit (nth 1 a)(nth 2 a))
        ub (pc:unit (nth 1 b)(nth 2 b)))
  (and ua ub (> (abs (pc:dot ua ub)) 0.9995)))

(defun pc:center-axisdist (a b / u)
  (setq u (pc:unit (nth 1 a)(nth 2 a)))
  (if u
    (abs (pc:cross u (pc:sub (nth 1 b)(nth 1 a))))
    1e99))

(defun pc:endgap (a b)
  (apply 'min
    (list
      (distance (nth 1 a)(nth 1 b))
      (distance (nth 1 a)(nth 2 b))
      (distance (nth 2 a)(nth 1 b))
      (distance (nth 2 a)(nth 2 b)))))

(defun pc:setline (e p1 p2 / ed)
  (setq ed (entget e))
  (setq ed (subst (cons 10 p1)(assoc 10 ed) ed))
  (setq ed (subst (cons 11 p2)(assoc 11 ed) ed))
  (entmod ed)
  (entupd e))

(defun pc:mergegeom (a b / base u vals lo hi)
  (setq base (nth 1 a)
        u (pc:unit (nth 1 a)(nth 2 a))
        vals
        (list
          (pc:proj base u (nth 1 a))
          (pc:proj base u (nth 2 a))
          (pc:proj base u (nth 1 b))
          (pc:proj base u (nth 2 b)))
        lo (apply 'min vals)
        hi (apply 'max vals))
  (list
    (pc:add base (pc:mul u lo))
    (pc:add base (pc:mul u hi))))

(defun pc:merge-pass (/ ls i j a b g done)
  (setq ls (pc:get-centers)
        i 0
        done nil)
  (while (and (< i (length ls))(not done))
    (setq j (1+ i))
    (while (and (< j (length ls))(not done))
      (setq a (nth i ls)
            b (nth j ls))
      (if (and (pc:center-parallel-p a b)
               (<= (pc:center-axisdist a b) *PC-AXIS-TOL*)
               (<= (pc:endgap a b) *PC-JOIN-MAX*))
        (progn
          (setq g (pc:mergegeom a b))
          (pc:setline (car a)(car g)(cadr g))
          (entdel (car b))
          (setq done T)))
      (setq j (1+ j)))
    (setq i (1+ i)))
  done)

(defun pc:merge-all (/ n)
  (setq n 0)
  (while (and (< n 500)(pc:merge-pass))
    (setq n (1+ n))))

;; -----------------------------
;; 후처리: T / ㄱ 교점 연결
;; 기존선 수정은 끝점만 교점까지
;; -----------------------------
(defun pc:inter (a b)
  (inters
    (nth 1 a)(nth 2 a)
    (nth 1 b)(nth 2 b)
    nil))

(defun pc:near-end-p (p a)
  (<=
    (min (distance p (nth 1 a))
         (distance p (nth 2 a)))
    *PC-JOIN-MAX*))

(defun pc:extend-end (a p / p1 p2)
  (setq p1 (nth 1 a)
        p2 (nth 2 a))
  (if (< (distance p p1)(distance p p2))
    (pc:setline (car a) p p2)
    (pc:setline (car a) p1 p)))

(defun pc:join-pass (/ ls i j a b p changed)
  (setq ls (pc:get-centers)
        i 0
        changed nil)
  (while (< i (length ls))
    (setq j (1+ i))
    (while (< j (length ls))
      (setq a (nth i ls)
            b (nth j ls))
      (if (not (pc:center-parallel-p a b))
        (progn
          (setq p (pc:inter a b))
          (if (and p
                   (pc:near-end-p p a)
                   (pc:near-end-p p b))
            (progn
              (pc:extend-end a p)
              (pc:extend-end b p)
              (setq changed T)))))
      (setq j (1+ j)))
    (setq i (1+ i)))
  changed)

(defun pc:post (/ k)
  (pc:merge-all)
  (setq k 0)
  (while (< k 2)
    (pc:join-pass)
    (pc:merge-all)
    (setq k (1+ k))))


;; ============================================================
;; PC V3 코너 접합
;; - PC V2가 이번 실행에서 만든 중심선만 대상으로 함
;; - ㄱ자: 두 선 끝을 실제 교점까지 연장
;; - T자: 한 선 끝만 상대 중심축까지 연장
;; - 대각선 연결/헌치 생성 없음
;; ============================================================

(setq *PC3-JOINMAX* 1200.0
      *PC3-PERP-DOT* 0.20
      *PC3-SPAN-TOL* 20.0)

(defun pc3:edata (e / ed)
  (if (and e (entget e))
    (progn
      (setq ed (entget e))
      (list e
            (pc:p3 (cdr (assoc 10 ed)))
            (pc:p3 (cdr (assoc 11 ed)))))
    nil))

(defun pc3:setline (e p1 p2 / ed)
  (if (and e (entget e))
    (progn
      (setq ed (entget e))
      (setq ed (subst (cons 10 p1) (assoc 10 ed) ed))
      (setq ed (subst (cons 11 p2) (assoc 11 ed) ed))
      (entmod ed)
      (entupd e))))

(defun pc3:parallel-p (a b / ua ub)
  (setq ua (pc:unit (nth 1 a) (nth 2 a))
        ub (pc:unit (nth 1 b) (nth 2 b)))
  (and ua ub (> (abs (pc:dot ua ub)) 0.9995)))

(defun pc3:perpendicular-p (a b / ua ub)
  (setq ua (pc:unit (nth 1 a) (nth 2 a))
        ub (pc:unit (nth 1 b) (nth 2 b)))
  (and ua ub (< (abs (pc:dot ua ub)) *PC3-PERP-DOT*)))

(defun pc3:inter (a b)
  (inters
    (nth 1 a) (nth 2 a)
    (nth 1 b) (nth 2 b)
    nil))

(defun pc3:param-on-line (p a / p1 p2 v vv)
  (setq p1 (nth 1 a)
        p2 (nth 2 a)
        v  (pc:sub p2 p1)
        vv (pc:dot v v))
  (if (> vv 1e-9)
    (/ (pc:dot (pc:sub p p1) v) vv)
    nil))

(defun pc3:on-span-p (p a / tval)
  (setq tval (pc3:param-on-line p a))
  (and tval
       (>= tval -0.001)
       (<= tval 1.001)))

(defun pc3:end-near-p (p a)
  (<=
    (min (distance p (nth 1 a))
         (distance p (nth 2 a)))
    *PC3-JOINMAX*))

(defun pc3:extend-nearest-end (a p / p1 p2)
  (setq p1 (nth 1 a)
        p2 (nth 2 a))
  (if (< (distance p p1) (distance p p2))
    (pc3:setline (car a) p p2)
    (pc3:setline (car a) p1 p)))

(defun pc3:refresh-created (/ out e d)
  (setq out nil)
  (foreach e *PC-CREATED*
    (setq d (pc3:edata e))
    (if d (setq out (cons d out))))
  (reverse out))

(defun pc3:join-pass (/ ls i j a b p aon bon changed)
  (setq ls (pc3:refresh-created)
        i 0
        changed nil)

  (while (< i (length ls))
    (setq j (1+ i))
    (while (< j (length ls))
      (setq a (nth i ls)
            b (nth j ls))

      ;; 수평/수직 계열만 코너 접합
      (if (pc3:perpendicular-p a b)
        (progn
          (setq p (pc3:inter a b))
          (if p
            (progn
              (setq aon (pc3:on-span-p p a)
                    bon (pc3:on-span-p p b))

              (cond
                ;; ㄱ자: 둘 다 실제 선 끝 근처 -> 둘 다 교점까지
                ((and (not aon) (not bon)
                      (pc3:end-near-p p a)
                      (pc3:end-near-p p b))
                 (pc3:extend-nearest-end a p)
                 (pc3:extend-nearest-end b p)
                 (setq changed T))

                ;; T자: A축은 이미 교점을 지나고, B 끝만 부족
                ((and aon (not bon)
                      (pc3:end-near-p p b))
                 (pc3:extend-nearest-end b p)
                 (setq changed T))

                ;; T자 반대
                ((and bon (not aon)
                      (pc3:end-near-p p a))
                 (pc3:extend-nearest-end a p)
                 (setq changed T))

                ;; 둘 다 교점이 각 선 구간 안이면 이미 연결 상태
                (T nil))))))

      (setq j (1+ j)))
    (setq i (1+ i)))
  changed)

(defun pc3:corner-join (/ k)
  ;; 수정 후 좌표가 바뀌므로 3회 재검사
  (setq k 0)
  (while (< k 3)
    (pc3:join-pass)
    (setq k (1+ k)))
  (princ))

(defun c:PC (/ *error* oldcm sel e segs i j used key cen made)
  (vl-load-com)
  (setq oldcm (getvar "CMDECHO"))

  (defun *error* (m)
    (setvar "CMDECHO" oldcm)
    (if (and m
             (/= m "Function cancelled")
             (/= m "quit / exit abort"))
      (prompt (strcat "\nPC 오류: " m)))
    (princ))

  (setvar "CMDECHO" 0)
  (setq *PC-CREATED* nil)
  (pc:ensure-layer)

  (prompt "\n[PC V3] 정중앙 + 코너자동접합")
  (setq sel (entsel "\n흰색처럼 만든 CLOSED LWPOLYLINE 선택: "))

  (if (null sel)
    (prompt "\n선택 취소.")
    (progn
      (setq e (car sel))
      (if (not (pc:closed-lwpoly-p e))
        (alert "폐합된 LWPOLYLINE을 선택하세요.")
        (progn
          (setq segs (pc:get-segs e)
                i 0
                used nil
                made 0)

          (prompt
            (strcat
              "\n장변 후보 세그먼트: "
              (itoa (length segs))
              "개"))

          ;; 각 장변마다 최적 평행 상대선 찾기
          (while (< i (length segs))
            (setq j (pc:best-mate i segs))
            (if (numberp j)
              (progn
                (setq key (pc:key i j))
                (if (not (member key used))
                  (progn
                    (setq cen
                      (pc:center-seg
                        (nth i segs)
                        (nth j segs)))
                    (if cen
                      (progn
                        (pc:draw cen)
                        (setq made (1+ made))))
                    (setq used (cons key used))))))
            (setq i (1+ i)))

          ;; V3: 정중앙 계산은 V2 그대로, 코너 접합만 추가
          (pc3:corner-join)

          (prompt
            (strcat
              "\n완료: 중심선 "
              (itoa made)
              "개 생성 / 정중앙 + 코너접합 V3"))))))

  (setvar "CMDECHO" oldcm)
  (princ))

(prompt "\nPC V3 로드완료 - 명령어: PC")
(princ)