;; =====================================================================
;; AreaLabels.lsp - etykiety powierzchni zamknietych polilinii
;;                  + sumy powierzchni wg warstw w pliku CSV
;; Polecenie: AREALABELS
;; AutoCAD / GstarCAD (AutoLISP). Opis i instalacja:
;; https://fixcontrol.pl/narzedzia/skrypty-autocad
;;
;; USTAWIENIA (na poczatku funkcji ponizej):
;;   textSize    - wysokosc tekstu etykiety (jednostki rysunku)
;;   areaDivisor - przeliczenie pola na m2:
;;                 rysunek w cm -> 10000.0, w mm -> 1000000.0, w m -> 1.0
;; Wynik CSV: Dokumenty\AreaExport.csv (nadpisywany przy kazdym uruchomieniu)
;; UWAGA: przed opisaniem usuwa WSZYSTKIE teksty z warstwy AREA_LABELS.
;; =====================================================================

(defun c:AreaLabels (/ *error* logmsg oldLayer ss i ent entData layer area adjustedArea centroidPt oldEnts
                       textSize areaDivisor areaDict csvFile csvPath item cleanLayer dictItem areaStr)
  (vl-load-com)

  ;; ---- USTAWIENIA ----
  (setq textSize 40.0)
  (setq areaDivisor 10000.0)

  (defun logmsg (msg)
    (princ msg)
    (princ "\n")
  )

  (defun *error* (msg)
    (logmsg (strcat "! ERROR: " msg))
    (if oldLayer (setvar 'CLAYER oldLayer))
    (logmsg "--------------------------------------------------")
    (princ)
  )

  (logmsg "==================================================")
  (logmsg "Starting AreaLabels command")

  (setq oldLayer (getvar 'CLAYER))
  (logmsg (strcat "Current layer: " oldLayer))
  (logmsg (strcat "Text size: " (rtos textSize 2 4)))

  ;; warstwa etykiet
  (if (not (tblsearch "LAYER" "AREA_LABELS"))
    (progn
      (command "_.-LAYER" "_M" "AREA_LABELS" "_C" "7" "" "")
      (logmsg "Created layer AREA_LABELS")
    )
    (logmsg "Layer AREA_LABELS already exists")
  )
  (setvar 'CLAYER "AREA_LABELS")

  ;; styl tekstu Arial
  (if (not (tblsearch "STYLE" "ARIAL"))
    (progn
      (command "_.-STYLE" "ARIAL" "Arial" 0 1 0 "" "" "")
      (logmsg "Created text style ARIAL")
    )
    (logmsg "Text style ARIAL already exists")
  )
  (setvar 'TEXTSTYLE "ARIAL")

  ;; usuniecie starych etykiet
  (setq oldEnts (ssget "_X" (list '(0 . "TEXT,MTEXT") (cons 8 "AREA_LABELS"))))
  (if oldEnts
    (progn
      (command "_.ERASE" oldEnts "")
      (logmsg (strcat "Removed old labels: " (itoa (sslength oldEnts)) " objects"))
    )
    (logmsg "No old labels to remove")
  )

  (setq areaDict nil)

  ;; zamkniete polilinie
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
    (progn
      (logmsg (strcat "Found " (itoa (sslength ss)) " closed polylines"))
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (setq entData (entget ent))
        (setq layer (cdr (assoc 8 entData)))

        (setq area (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))
        (if (vl-catch-all-error-p area)
          (progn
            (setq area 0.0)
            (logmsg "  ! ERROR calculating area")
          )
          (progn
            (setq adjustedArea (/ area areaDivisor))
            ;; suma dla warstwy (tylko dodatnie pola)
            (if (> area 0)
              (if (setq dictItem (assoc layer areaDict))
                (setq areaDict (subst (cons layer (+ adjustedArea (cdr dictItem))) dictItem areaDict))
                (setq areaDict (cons (cons layer adjustedArea) areaDict))
              )
            )
          )
        )

        (setq centroidPt (AreaLabels-center ent))

        (if (and (> area 0) centroidPt)
          (entmake
            (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 10 centroidPt)
              (cons 40 textSize)
              (cons 1 (strcat layer "\\P" (rtos adjustedArea 2 2) " m2"))
              (cons 7 "ARIAL")
              (cons 71 5)
              (cons 8 "AREA_LABELS")
            )
          )
        )
        (setq i (1+ i))
      )
    )
    (logmsg "No closed polylines found")
  )

  ;; eksport do CSV (srednik, przecinek dziesietny)
  (if areaDict
    (progn
      (setq csvPath (strcat (getenv "USERPROFILE") "\\Documents\\AreaExport.csv"))
      (setq csvFile (open csvPath "w"))
      (write-line "symbol;powierzchnia" csvFile)
      (foreach item areaDict
        (setq cleanLayer (vl-string-trim "_" (car item)))
        (setq areaStr (vl-string-subst "," "." (rtos (cdr item) 2 2)))
        (write-line (strcat cleanLayer ";" areaStr) csvFile)
      )
      (close csvFile)
      (logmsg (strcat "Exported CSV to: " csvPath))
    )
  )

  (setvar 'CLAYER oldLayer)
  (logmsg "Command completed successfully")
  (logmsg "==================================================")
  (princ)
)

;; srodek prostokata otaczajacego obiekt
(defun AreaLabels-center (ent / minpt maxpt)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (setq minpt (vlax-safearray->list minpt))
  (setq maxpt (vlax-safearray->list maxpt))
  (list
    (/ (+ (car minpt) (car maxpt)) 2.0)
    (/ (+ (cadr minpt) (cadr maxpt)) 2.0)
    0.0
  )
)

(princ "\nAREALABELS loaded. Type AREALABELS to run.")
(princ)