;; TXTTAB.lsp
;; Sous licence Creative Commons Attribution 4.0 International (CC BY 4.0)
;; Ce programme est mis à disposition selon les termes de la Licence CC BY 4.0.
;; Copie, distribution et modification autorisées, sous réserve de maintenir cette notice et les informations d'en-tête intactes.
;; Production : https://dessein-tech.com/
;; L'assistant IA AutoCAD et AutoLISP https://go.dessein-tech.com/autocad-ia

;;; ---------------------------------------------------------
;;; 1. ALGORITHME DE TRI NATUREL (ROBUSTE)
;;; ---------------------------------------------------------

(defun str-split-alpha-num (str / i len char lst buf mode)
  (setq i 1 len (strlen str) buf "" mode 'none lst '())
  (repeat len
    (setq char (substr str i 1))
    (cond
      ((wcmatch char "#")
       (if (eq mode 'txt) (setq lst (cons buf lst) buf ""))
       (setq mode 'num buf (strcat buf char))
      )
      (T 
       (if (eq mode 'num) (setq lst (cons (atoi buf) lst) buf ""))
       (setq mode 'txt buf (strcat buf char))
      )
    )
    (setq i (1+ i))
  )
  (if (/= buf "") (setq lst (cons (if (eq mode 'num) (atoi buf) buf) lst)))
  (reverse lst)
)

(defun compare-natural-strict (s1 s2 / l1 l2 x1 x2 diff)
  (setq l1 (str-split-alpha-num s1) l2 (str-split-alpha-num s2) diff nil)
  (while (and l1 l2 (not diff))
    (setq x1 (car l1) x2 (car l2))
    (cond
      ((not (equal x1 x2))
       (setq diff T)
       (cond
         ((and (numberp x1) (numberp x2)) (< x1 x2))
         ((and (eq (type x1) 'STR) (eq (type x2) 'STR)) (< (strcase x1) (strcase x2)))
         ((numberp x1) T)
         (T nil)
       )
      )
      (T (setq l1 (cdr l1) l2 (cdr l2)))
    )
  )
  (if diff
    (cond 
       ((and (numberp x1) (numberp x2)) (< x1 x2))
       ((and (eq (type x1) 'STR) (eq (type x2) 'STR)) (< (strcase x1) (strcase x2)))
       ((numberp x1) T)
       (T nil)
    )
    (if (and (null l1) l2) T nil)
  )
)

;;; ---------------------------------------------------------
;;; 2. COMMANDE PRINCIPALE
;;; ---------------------------------------------------------

(defun c:TXTTAB (/ ss lst i ent obj str pt ans table mspace pt_var row txtHeight tb data width maxW)
  (vl-load-com)
  
  (prompt "\nSélectionnez les textes (TEXT) pour le tableau : ")
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq lst '())
      (setq i 0)
      (setq maxW 0.0)
      
      ;; Récupération de la hauteur du premier texte sélectionné
      (setq txtHeight (vla-get-Height (vlax-ename->vla-object (ssname ss 0))))
      
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (setq obj (vlax-ename->vla-object ent))
        (setq str (vla-get-TextString obj))
        
        ;; Calcul Largeur
        (setq data (entget ent))
        (setq tb (textbox data)) 
        (if tb 
          (setq width (- (car (cadr tb)) (car (car tb))))
          (setq width (* (strlen str) txtHeight 0.8))
        )
        (if (> width maxW) (setq maxW width))
        
        (setq lst (cons str lst))
        (setq i (1+ i))
      )
      
      ;; Marge de sécurité 20%
      (setq maxW (* maxW 1.2))
      
      ;; Tri
      (initget "Alphabétique Naturel Non")
      (setq ans (getkword "\nType de tri ? [Alphabétique/Naturel/Non] <Non>: "))
      (cond
        ((= ans "Alphabétique") (setq lst (acad_strlsort lst)))
        ((= ans "Naturel")      (setq lst (vl-sort lst 'compare-natural-strict)))
        (T                      (setq lst (reverse lst))) 
      )

      ;; Création Tableau
      (setq pt (getpoint "\nPoint d'insertion du tableau : "))
      (if pt
        (progn
          (setq mspace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
          (setq pt_var (vlax-3d-point pt))
          
          ;; Création simple (sans calcul complexe de hauteur de ligne)
          (setq table (vla-AddTable mspace pt_var (length lst) 1 (* txtHeight 1.5) maxW))
          
          ;; Suppression Titres
          (vla-put-TitleSuppressed table :vlax-true)
          (vla-put-HeaderSuppressed table :vlax-true)
          
          (setq row 0)
          (foreach txt lst
            ;; Remplissage standard
            (vla-setText table row 0 txt)
            (vla-setCellAlignment table row 0 acMiddleLeft)
            
            ;; On garde uniquement le forçage de la hauteur du texte (qui fonctionnait)
            (vla-SetCellTextHeight table row 0 txtHeight)
            
            (setq row (1+ row))
          )
          
          (vla-RecomputeTableBlock table :vlax-true)
          (princ (strcat "\nTableau créé avec " (itoa (length lst)) " lignes."))
        )
      )
    )
    (princ "\nAucun texte sélectionné.")
  )
  (princ)
)