Un petit lisp, avec IA

[Dan]

Bonjour à tous,

L’autre jour, je m’amusais (ou pas ) à compter le nombre de blocs, de portes et de fenêtres dans un projet. Et là, l’idée m’a frappé, comme une porte en plein dans le nez : pourquoi ne pas demander à mon ami Claude de créer un petit outil bien pratique ?

Voici le résultat, avec trois commandes différentes :

« BCOMPTE » = comptabilise tous les blocs et les insère dans un tableau AutoCAD®.

« RCHPOR » = comptabilise tous les blocs de type Porte, à condition que leur nom contienne les mots « Doors », « Portes » ou « Por », puis les insère dans un tableau AutoCAD® avec leur nombre correspondant.

« RCHFEN » = sensiblement la même chose que la fonction Porte, mais pour les fenêtres, à condition que le nom des blocs contienne les mots « Window », « Fenêtre » ou « Fen ».

Je vous laisse le soin d’améliorer ceci ou encore de le démonter pour voir comment cela fonctionne.
Il me semble que @DenisH cherchait un moyen d’utiliser une LISP pour créer des tableaux sans passer par Excel, donc à vous de voir.

Mes amitiés, mes camarades AutoCadiens.

;;; ====================================================================
;;; COMPTAGE-BLOCS.LSP
;;; Système de comptage de blocs et création d'échelles automatiques
;;; 
;;; Commandes disponibles:
;;;   BCOMPTE    - Compte tous les blocs dans le dessin
;;;   BFILTRE    - Compte les blocs correspondant à un filtre
;;;   RCHPOR     - Crée l'échelle des portes
;;;   RCHFEN     - Crée l'échelle des fenêtres
;;;   RCHPF      - Crée les deux échelles (portes et fenêtres)
;;;
;;; Installation: APPLOAD > Charger ce fichier
;;; 
;;; 
;;; Created by Dan T - Not for commercial use and distribution.
;;; ====================================================================

;;; --------------------------------------------------------------------
;;; BCOMPTE - Compte tous les blocs
;;; --------------------------------------------------------------------
(defun C:BCOMPTE (/ ss i blk-name blk-list blk-count unique-blocks table-data)
  (princ "\nComptage des blocs...")
  
  ;; Sélectionner tous les objets INSERT (blocs)
  (setq ss (ssget "X" '((0 . "INSERT"))))
  
  (if ss
    (progn
      ;; Initialiser la liste vide
      (setq blk-list '())
      
      ;; Parcourir tous les blocs et collecter les noms
      (setq i 0)
      (repeat (sslength ss)
        (setq blk-name (cdr (assoc 2 (entget (ssname ss i)))))
        ;; Ajouter à la liste (avec doublons)
        (setq blk-list (cons blk-name blk-list))
        (setq i (1+ i))
      )
      
      ;; Obtenir les noms de blocs uniques
      (setq unique-blocks '())
      (foreach blk blk-list
        (if (not (member blk unique-blocks))
          (setq unique-blocks (cons blk unique-blocks))
        )
      )
      
      ;; Trier alphabétiquement
      (setq unique-blocks (acad_strlsort unique-blocks))
      
      ;; Compter chaque bloc unique
      (setq table-data '())
      (foreach blk unique-blocks
        (setq blk-count 0)
        (foreach item blk-list
          (if (= item blk)
            (setq blk-count (1+ blk-count))
          )
        )
        ;; Stocker comme (nom . quantité)
        (setq table-data (cons (cons blk blk-count) table-data))
      )
      
      ;; Inverser pour obtenir l'ordre de tri original
      (setq table-data (reverse table-data))
      
      ;; Afficher les résultats dans la ligne de commande
      (princ "\n\n=== COMPTAGE DES BLOCS ===")
      (princ "\n--------------------------")
      (foreach item table-data
        (princ (strcat "\n" (car item) ": " (itoa (cdr item))))
      )
      (princ "\n--------------------------")
      (princ (strcat "\nBlocs uniques: " (itoa (length unique-blocks))))
      (princ (strcat "\nTotal d'instances: " (itoa (length blk-list))))
      
      ;; Demander si l'utilisateur veut créer un tableau
      (initget "Oui Non")
      (setq create-table (getkword "\nCréer un tableau AutoCAD? [Oui/Non] <Oui>: "))
      (if (or (= create-table "Oui") (= create-table nil))
        (creer-tableau-blocs table-data "ÉCHELLE DES BLOCS")
      )
    )
    (princ "\nAucun bloc trouvé dans le dessin.")
  )
  (princ)
)

;;; --------------------------------------------------------------------
;;; BFILTRE - Compte les blocs avec filtre
;;; --------------------------------------------------------------------
(defun C:BFILTRE (/ ss filter-string i blk-name blk-list blk-count unique-blocks table-data)
  (setq filter-string (getstring T "\nEntrer le filtre de nom de bloc (ex: 'PORTE' ou 'FEN'): "))
  
  (if (= filter-string "")
    (princ "\nAnnulé.")
    (progn
      (princ (strcat "\nComptage des blocs contenant: " filter-string))
      
      ;; Sélectionner tous les objets INSERT
      (setq ss (ssget "X" '((0 . "INSERT"))))
      
      (if ss
        (progn
          (setq blk-list '())
          
          ;; Parcourir et filtrer
          (setq i 0)
          (repeat (sslength ss)
            (setq blk-name (cdr (assoc 2 (entget (ssname ss i)))))
            ;; Vérifier si le nom du bloc contient la chaîne de filtrage
            (if (wcmatch (strcase blk-name) (strcat "*" (strcase filter-string) "*"))
              (setq blk-list (cons blk-name blk-list))
            )
            (setq i (1+ i))
          )
          
          (if blk-list
            (progn
              ;; Obtenir les noms de blocs uniques
              (setq unique-blocks '())
              (foreach blk blk-list
                (if (not (member blk unique-blocks))
                  (setq unique-blocks (cons blk unique-blocks))
                )
              )
              
              ;; Trier
              (setq unique-blocks (acad_strlsort unique-blocks))
              
              ;; Compter
              (setq table-data '())
              (foreach blk unique-blocks
                (setq blk-count 0)
                (foreach item blk-list
                  (if (= item blk)
                    (setq blk-count (1+ blk-count))
                  )
                )
                (setq table-data (cons (cons blk blk-count) table-data))
              )
              
              (setq table-data (reverse table-data))
              
              ;; Afficher les résultats
              (princ (strcat "\n\n=== BLOCS CORRESPONDANT À '" filter-string "' ==="))
              (princ "\n--------------------------")
              (foreach item table-data
                (princ (strcat "\n" (car item) ": " (itoa (cdr item))))
              )
              (princ "\n--------------------------")
              (princ (strcat "\nTotal de blocs correspondants: " (itoa (length blk-list))))
              
              ;; Créer le tableau
              (initget "Oui Non")
              (setq create-table (getkword "\nCréer un tableau? [Oui/Non] <Oui>: "))
              (if (or (= create-table "Oui") (= create-table nil))
                (creer-tableau-blocs table-data (strcat "BLOCS - " (strcase filter-string)))
              )
            )
            (princ (strcat "\nAucun bloc trouvé correspondant à: " filter-string))
          )
        )
        (princ "\nAucun bloc trouvé dans le dessin.")
      )
    )
  )
  (princ)
)

;;; --------------------------------------------------------------------
;;; RCHPOR - Échelle des portes
;;; --------------------------------------------------------------------
(defun C:RCHPOR (/ ss i blk-name porte-list porte-count unique-portes table-data total)
  (princ "\nComptage des portes...")
  
  ;; Sélectionner tous les blocs avec "DOOR" ou "PORTE" dans le nom
  (setq ss (ssget "X" '((0 . "INSERT"))))
  
  (if ss
    (progn
      (setq porte-list '())
      
      ;; Filtrer pour les portes
      (setq i 0)
      (repeat (sslength ss)
        (setq blk-name (cdr (assoc 2 (entget (ssname ss i)))))
        ;; Vérifier si le nom contient DOOR, PORTE, ou POR
        (if (or (wcmatch (strcase blk-name) "*DOOR*")
                (wcmatch (strcase blk-name) "*PORTE*")
                (wcmatch (strcase blk-name) "*POR*"))
          (setq porte-list (cons blk-name porte-list))
        )
        (setq i (1+ i))
      )
      
      (if porte-list
        (progn
          ;; Obtenir les portes uniques
          (setq unique-portes '())
          (foreach porte porte-list
            (if (not (member porte unique-portes))
              (setq unique-portes (cons porte unique-portes))
            )
          )
          
          ;; Trier
          (setq unique-portes (acad_strlsort unique-portes))
          
          ;; Compter
          (setq table-data '())
          (foreach porte unique-portes
            (setq porte-count 0)
            (foreach item porte-list
              (if (= item porte)
                (setq porte-count (1+ porte-count))
              )
            )
            (setq table-data (cons (list porte porte-count) table-data))
          )
          
          (setq table-data (reverse table-data))
          
          ;; Calculer le total
          (setq total (length porte-list))
          
          ;; Afficher les résultats
          (princ "\n\n=== ÉCHELLE DES PORTES ===")
          (princ "\n--------------------------")
          (foreach item table-data
            (princ (strcat "\n" (car item) ": " (itoa (cadr item))))
          )
          (princ "\n--------------------------")
          (princ (strcat "\nTotal de portes: " (itoa total)))
          
          ;; Créer le tableau
          (creer-tableau-portes-fenetres table-data "ÉCHELLE DES PORTES" total)
        )
        (princ "\nAucune porte trouvée. Les noms de blocs doivent contenir 'DOOR', 'PORTE' ou 'POR'.")
      )
    )
    (princ "\nAucun bloc trouvé dans le dessin.")
  )
  (princ)
)

;;; --------------------------------------------------------------------
;;; RCHFEN - Échelle des fenêtres
;;; --------------------------------------------------------------------
(defun C:RCHFEN (/ ss i blk-name fen-list fen-count unique-fens table-data total)
  (princ "\nComptage des fenêtres...")
  
  ;; Sélectionner tous les blocs
  (setq ss (ssget "X" '((0 . "INSERT"))))
  
  (if ss
    (progn
      (setq fen-list '())
      
      ;; Filtrer pour les fenêtres
      (setq i 0)
      (repeat (sslength ss)
        (setq blk-name (cdr (assoc 2 (entget (ssname ss i)))))
        ;; Vérifier si le nom contient WIN, WINDOW, FENETRE, ou FEN
        (if (or (wcmatch (strcase blk-name) "*WIN*")
                (wcmatch (strcase blk-name) "*WINDOW*")
                (wcmatch (strcase blk-name) "*FENETRE*")
                (wcmatch (strcase blk-name) "*FENÊTRE*")
                (wcmatch (strcase blk-name) "*FEN*"))
          (setq fen-list (cons blk-name fen-list))
        )
        (setq i (1+ i))
      )
      
      (if fen-list
        (progn
          ;; Obtenir les fenêtres uniques
          (setq unique-fens '())
          (foreach fen fen-list
            (if (not (member fen unique-fens))
              (setq unique-fens (cons fen unique-fens))
            )
          )
          
          ;; Trier
          (setq unique-fens (acad_strlsort unique-fens))
          
          ;; Compter
          (setq table-data '())
          (foreach fen unique-fens
            (setq fen-count 0)
            (foreach item fen-list
              (if (= item fen)
                (setq fen-count (1+ fen-count))
              )
            )
            (setq table-data (cons (list fen fen-count) table-data))
          )
          
          (setq table-data (reverse table-data))
          
          ;; Calculer le total
          (setq total (length fen-list))
          
          ;; Afficher les résultats
          (princ "\n\n=== ÉCHELLE DES FENÊTRES ===")
          (princ "\n----------------------------")
          (foreach item table-data
            (princ (strcat "\n" (car item) ": " (itoa (cadr item))))
          )
          (princ "\n----------------------------")
          (princ (strcat "\nTotal de fenêtres: " (itoa total)))
          
          ;; Créer le tableau
          (creer-tableau-portes-fenetres table-data "ÉCHELLE DES FENÊTRES" total)
        )
        (princ "\nAucune fenêtre trouvée. Les noms de blocs doivent contenir 'WIN', 'WINDOW', 'FENETRE' ou 'FEN'.")
      )
    )
    (princ "\nAucun bloc trouvé dans le dessin.")
  )
  (princ)
)

;;; --------------------------------------------------------------------
;;; RCHPF - Échelles des portes et fenêtres combinées
;;; --------------------------------------------------------------------
(defun C:RCHPF (/ )
  (princ "\nCréation des échelles de portes et fenêtres...\n")
  (C:RCHPOR)
  (terpri)
  (C:RCHFEN)
  (princ)
)

;;; ====================================================================
;;; FONCTIONS AUXILIAIRES
;;; ====================================================================

;;; Fonction pour créer un tableau AutoCAD (version générique)
(defun creer-tableau-blocs (data titre / pt rows cols table row)
  (setq pt (getpoint "\nChoisir le point d'insertion du tableau: "))
  (if pt
    (progn
      ;; Calculer la taille du tableau
      (setq rows (+ (length data) 2))  ; +2 pour l'en-tête et le titre
      (setq cols 2)
      
      ;; Créer le tableau
      (setq table (vla-addtable 
                    (vla-get-modelspace 
                      (vla-get-activedocument (vlax-get-acad-object)))
                    (vlax-3d-point pt)
                    rows
                    cols
                    10  ; hauteur de ligne (mm)
                    60  ; largeur de colonne (mm)
                  ))
      
      ;; Définir le titre
      (vla-settext table 0 0 titre)
      (vla-mergecells table 0 0 0 1)
      
      ;; Définir les en-têtes
      (vla-settext table 1 0 "NOM DU BLOC")
      (vla-settext table 1 1 "QTÉ")
      
      ;; Remplir les données
      (setq row 2)
      (foreach item data
        (vla-settext table row 0 (car item))
        (vla-settext table row 1 (itoa (cdr item)))
        (setq row (1+ row))
      )
      
      ;; Formater le tableau
      (vla-setalignment table 0 acMiddleCenter)  ; Titre centré
      (vla-setalignment table 1 acMiddleCenter)  ; En-têtes centrés
      
      ;; Définir les largeurs de colonnes
      (vla-setcolumnwidth table 0 100)  ; Colonne nom plus large
      (vla-setcolumnwidth table 1 40)   ; Colonne quantité plus étroite
      
      (princ "\nTableau créé avec succès!")
    )
    (princ "\nAnnulé.")
  )
  (princ)
)

;;; Fonction pour créer un tableau de portes/fenêtres (avec total)
(defun creer-tableau-portes-fenetres (data titre total / pt rows cols table row)
  (initget "Oui Non")
  (setq create-tbl (getkword "\nCréer un tableau AutoCAD? [Oui/Non] <Oui>: "))
  
  (if (or (= create-tbl "Oui") (= create-tbl nil))
    (progn
      (setq pt (getpoint "\nChoisir le point d'insertion du tableau: "))
      (if pt
        (progn
          ;; Taille du tableau (+3 pour titre, en-tête, et ligne de total)
          (setq rows (+ (length data) 3))
          (setq cols 2)
          
          ;; Créer le tableau
          (setq table (vla-addtable 
                        (vla-get-modelspace 
                          (vla-get-activedocument (vlax-get-acad-object)))
                        (vlax-3d-point pt)
                        rows
                        cols
                        8   ; hauteur de ligne
                        80  ; largeur de colonne
                      ))
          
          ;; Titre
          (vla-settext table 0 0 titre)
          (vla-mergecells table 0 0 0 1)
          
          ;; En-têtes
          (vla-settext table 1 0 "TYPE")
          (vla-settext table 1 1 "QTÉ")
          
          ;; Données
          (setq row 2)
          (foreach item data
            (vla-settext table row 0 (car item))
            (vla-settext table row 1 (itoa (cadr item)))
            (setq row (1+ row))
          )
          
          ;; Ligne de total
          (vla-settext table row 0 "TOTAL")
          (vla-settext table row 1 (itoa total))
          
          ;; Formater
          (vla-setcolumnwidth table 0 120)
          (vla-setcolumnwidth table 1 40)
          
          ;; Centrer les en-têtes
          (vla-setalignment table 0 acMiddleCenter)  ; Titre
          (vla-setalignment table 1 acMiddleCenter)  ; En-têtes
          
          (princ "\nTableau créé!")
        )
        (princ "\nAnnulé.")
      )
    )
  )
  (princ)
)

;;; ====================================================================
;;; MESSAGES DE CHARGEMENT
;;; ====================================================================

(princ "\n")
(princ "\n╔════════════════════════════════════════════════════╗")
(princ "\n║   SYSTÈME DE COMPTAGE DE BLOCS CHARGÉ             ║")
(princ "\n╚════════════════════════════════════════════════════╝")
(princ "\n")
(princ "\n  Commandes disponibles:")
(princ "\n  ─────────────────────────────────────────────────")
(princ "\n  BCOMPTE  - Compter tous les blocs")
(princ "\n  BFILTRE  - Compter les blocs avec filtre")
(princ "\n  RCHPOR   - Échelle des portes")
(princ "\n  RCHFEN   - Échelle des fenêtres")
(princ "\n  RCHPF    - Les deux échelles")
(princ "\n  ─────────────────────────────────────────────────")
(princ "\n")
(princ)

;;; FIN DU FICHIER

[DenisH]

Bonjour à la communauté.
Un grand merci à @Dan, je vais regarder ce code avec la plus grande attention.
Denis.

[Patrick]

Merci bien.

Pour information pour ceux qui publient des programmes LISP ici, vous avez plusieurs possibilités. Vous pouvez simplement faire glisser votre programme Lisp d’extension LSP dans le post. Il s’insérera comme fichier téléchargeable, il est inutile de le renommer en .txt

Deuxième possibilité, afficher le code source du programme LISP directement dans l’éditeur pour qu’on le voit avec un formatage et une reconnaissance linguistique. Les instructions sont données ici:

Comment formatter du code?

Lorsque vous utilisez des triples « backticks » pour entourer des blocs de code, Discourse tentera d’autodétecter la langue à l’aide de highlight.js. Si cela ne donne pas les résultats escomptés, vous pouvez saisir un nom de langue après la première série de backticks : Voici ci-dessous un exemple de code en langage AutoLISP correctement formaté: (defun display-msg (msg mode / ) (if (= mode 0) (prompt (strcat "\n" msg)) (alert msg) ) (princ) ) [image] voir aussi:

[Dan]

Ah okay, dans le doute j’ai préféré le mettre en version .txt, mais c’est noté pour le prochaine fois.

Voilà qui devrait être mieux.

[Patrick]

Petit souci de mise en évidence de la syntaxe qui ne fonctionne pas dans le code que tu as publié alors qu’il fonctionne dans tous les autres posts, le souci est en cours d’examen.

[Dan]

Pas de soucis Patrick.

[DenisH]

Bonjour à la communauté.
@Dan, j’ai commencé à étudier ton code et j’ai une petite observation.

        (if (or (wcmatch (strcase blk-name) "*WIN*")
                (wcmatch (strcase blk-name) "*WINDOW*")
                (wcmatch (strcase blk-name) "*FENETRE*")
                (wcmatch (strcase blk-name) "*FENÊTRE*")
                (wcmatch (strcase blk-name) "*FEN*"))
          (setq fen-list (cons blk-name fen-list))
        )

Je pense que « WIN » inclu « WINDOW », pareil pour « FEN » avec « FENETRE » et « FENÊTRE », et aussi un peu plus haut dans le code avec « POR » et « PORTE ».

Ne t’inquiète pas, je fais aussi souvent cette erreur dans mes Lisp, que je fini par observé et corrigé, parfois longtemps après !

Encore merci pour ce code.

Denis…

[Dan]

Bien vu, j’avais oublié que c’étaient des « jokers » et donc pouvaient se capter entre eux, mais du moment que ce lisp corresponde à ce que vous cherchez, c’est le principal.

[DenisH]

J’ai pensé aussi que tu pourrais ne faire qu’un seul programme avec des options à saisir.
Avec quelque-chose comme ça en début de prog. :

  (princ "\nComptage des blocs...")
  (initget 2 "Portes Fenetres Tous")
  (setq	Option
	 (getkword
	   "\nQuels blocs comptabiliser ? [Portes/Fenetres/Tous] <Tous>: "
	 )
  )
  (if (= Option nil)(setq Option "Tous"))
  (cond	((= Option "Portes")
	 (setq ss (ssget "X" '((0 . "INSERT") (2 . "*POR"))))
	)
	((= Option "Fenetres")
	 (setq ss (ssget "X" '((0 . "INSERT") (2 . "*FEN"))))
	)
	((= Option "Tous")
	 (setq ss (ssget "X" '((0 . "INSERT"))))
	)
  )
  ;;; Programme principale...

Ce sera peut-être plus facile pour l’utilisation, et ne ferait qu’un seul icone dans un menu ou une palette.

Mais on peut toujours faire trois icones avec option « intégrées » dans chaque :

(defun C:BCOMPTE (Option / ss i blk-name blk-list blk-count unique-blocks table-data)

Ce qui donnerait en ligne de commande : "^c^c(c:BCOMPTE "Portes");" par exemple.

C’est juste une idée, une proposition…