;; =====================================================================
;; LineLabels.lsp - etykiety dlugosci linii
;;                  + sumy dlugosci wg warstw w pliku CSV
;; Polecenie: LINELABELS
;; AutoCAD / GstarCAD (AutoLISP). Opis i instalacja:
;; https://fixcontrol.pl/narzedzia/skrypty-autocad
;;
;; USTAWIENIA (na poczatku funkcji ponizej):
;;   textSize      - wysokosc tekstu etykiety (jednostki rysunku)
;;   lengthDivisor - przeliczenie dlugosci na metry:
;;                   rysunek w cm -> 100.0, w mm -> 1000.0, w m -> 1.0
;; Wynik CSV: Dokumenty\LengthExport.csv (nadpisywany przy kazdym uruchomieniu)
;; UWAGA: przed opisaniem usuwa WSZYSTKIE teksty z warstwy LENGTH_LABELS.
;; =====================================================================

(defun c:LineLabels (/ *error* logmsg oldLayer ss i ent entData layer len adjustedLength startPt endPt midPt oldEnts
                       textSize lengthDivisor lengthDict csvFile csvPath item cleanLayer dictItem numStr)
  ;; ---- USTAWIENIA ----
  (setq textSize 40.0)
  (setq lengthDivisor 100.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 LineLabels command")

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

  ;; warstwa etykiet
  (if (not (tblsearch "LAYER" "LENGTH_LABELS"))
    (progn
      (command "_.-LAYER" "_M" "LENGTH_LABELS" "_C" "7" "" "")
      (logmsg "Created layer LENGTH_LABELS")
    )
    (logmsg "Layer LENGTH_LABELS already exists")
  )
  (setvar 'CLAYER "LENGTH_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 "LENGTH_LABELS"))))
  (if oldEnts
    (progn
      (command "_.ERASE" oldEnts "")
      (logmsg (strcat "Removed old labels: " (itoa (sslength oldEnts)) " objects"))
    )
    (logmsg "No old labels to remove")
  )

  (setq lengthDict nil)

  ;; tylko linie (LINE), polilinie sa pomijane
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (logmsg (strcat "Found " (itoa (sslength ss)) " lines"))
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (setq entData (entget ent))
        (setq layer (cdr (assoc 8 entData)))

        (setq startPt (cdr (assoc 10 entData)))
        (setq endPt (cdr (assoc 11 entData)))

        (setq len (distance startPt endPt))
        (setq adjustedLength (/ len lengthDivisor))

        ;; srodek linii
        (setq midPt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) startPt endPt))
        (setq midPt (list (car midPt) (cadr midPt) 0.0))

        ;; suma dla warstwy
        (if (setq dictItem (assoc layer lengthDict))
          (setq lengthDict (subst (cons layer (+ adjustedLength (cdr dictItem))) dictItem lengthDict))
          (setq lengthDict (cons (cons layer adjustedLength) lengthDict))
        )

        (entmake
          (list
            '(0 . "MTEXT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbMText")
            (cons 10 midPt)
            (cons 40 textSize)
            (cons 1 (strcat layer "\\P" (rtos adjustedLength 2 2) " m"))
            (cons 7 "ARIAL")
            (cons 71 5)
            (cons 8 "LENGTH_LABELS")
          )
        )
        (setq i (1+ i))
      )
    )
    (logmsg "No lines found")
  )

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

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

(princ "\nLINELABELS loaded. Type LINELABELS to run.")
(princ)