Incsuff+

[(gile)]

Salut

 

Incsuff est une routine polyvalente d'incrémentation de chaîne fonctionnant avec les caractères numériques et/ou alphabétiques.

 

Pour une encore plus grande polyvalence, Incsuff+ permet de considérer le caractère spécifié dans un nouvel argument comme séparateur décimal.

 

Exemples :

 

(incsuff+ "B_ZZ" 1 2 nil) retourne "B_AAA"

 

(incsuff+ "B_ZZ" 1 2 "_") retourne "C_AA"

 

(incsuff+ "1.2.9.9" 1 1 ".") retourne "1.3.0.0"

 

(incsuff+ "PK9+900" 100 1 "+") retourne "PK10+000"

 

;; INCSUFF+ (version 1.0.0) -Gilles Chanteau- 09/03/10
;; Incrémente le suffixe d'une chaîne de caractères de la valeur spécifiée.
;; Est pris en compte comme suffixe, l'ensemble des caractères [0-9] et/ou [A-Z]
;; et/ou [a-z] depuis la fin du texte, en fonction de la valeur de 'alpha'.
;;
;; Arguments
;; str : une chaîne avec un suffixe valide
;; inc : un entier positif
;; alpha : un entier, somme des codes binaires suivant
;;         1 pour les caractères [0-9]
;;         2 pour les caractères [A-Z]
;;         4 pour les caractères [a-z]
;; sep : un caractère, "" ou nil pour aucun
;;
;; Retour
;; la chaîne avec son suffixe incrémenté (ou nil si aucun suffixe valide)
;;
;; Exemples :
;; (incsuff+ "N°002" 12 1 "") = "N°014"
;; (incsuff+ "Dessin 9" 1 1 nil) = "Dessin 10"
;; (incsuff+ "B_ZZ9" 1 1 nil) = "B_ZZ10"
;; (incsuff+ "B_ZZ9" 1 3 nil) = "B_AAA0"
;; (incsuff+ "B_ZZ9" 1 3 "_") = "C_AA0"
;; (incsuff+ "1.2.9.9" 1 1 ".") = "1.3.0.0"
;; (incsuff+ "PK3+900" 100 1 "+") = "PK4+000"
;;
;; Modification (13/02/08) : codes binaires pour l'argument alpha
;;
;; Modification (09/03/10) : possibilité d'utiliser un caractère comme séparateur décimal

(defun incsuff+	(str	inc    alpha  sep    /	    number upper
	 lower	lst    crt    pas    ind    val	   quo
	 ret
	)
 (defun number (x) (and (  (defun upper (x) (and (  (defun lower (x) (and (  (setq	lst (reverse (vl-string->list str))
sep (if	sep
      (ascii sep)
      0
    )
 )
 (while
   (and
     (setq crt (car lst))
     (if (= sep crt)
(if (or
      (setq num (number (cadr lst)))
      (setq upr (upper (cadr lst)))
      (setq lwr (lower (cadr lst)))
    )
  (setq	lst (cdr lst)
	crt (car lst)
	ret (cons sep ret)
  )
  T
)
(or
  (setq num (number crt))
  (setq upr (upper crt))
  (setq lwr (lower crt))
  T
)
     )
     (cond
(num
 (setq pas 10
       ind 48
 )
)
(upr
 (setq pas 26
       ind 65
 )
)
(lwr
 (setq pas 26
       ind 97
 )
)
((	 (setq crt (if (= 10 pas)
	     ind
	     (1- ind)
	   )
       lst (cons (car lst) lst)
 )
)
     )
   )
    (setq val (- crt ind)
   quo (/ (+ val inc) pas)
   ret (cons (+ ind (rem (+ val inc) pas)) ret)
    )
    (if (zerop quo)
      (setq ret (append (reverse (cdr lst)) ret)
     lst nil
      )
      (if (cdr lst)
 (setq lst (cdr lst)
       inc quo
 )
 (setq lst (list ind)
       inc (if (= 10 pas)
	     quo
	     (1- quo)
	   )
 )
      )
    )
 )
 (if ret
   (vl-list->string ret)
 )
)