Tabloblo version Blocs Dynamiques

[Morgul]

Bonjour à Tous,

 

Alors, voilà, tout d'abord, je voulais remercier Tramber qui avait créé le super Lisp Tabloblo qui sera le point de départ de mes demandes.

En effet ce lisp est super, mais comme beaucoup aujourd'hui, j'utilise beaucoup des blocs dynamiques avec paramètre de visibilité.

Ce lisp fonctionne très bien, mais il ne prend pas en compte le paramètre de visibilité appliqué sur les blocs, il ne reprend que la valeur par défaut du bloc.

Ensuite, comme je travail entre autre sur des câbles électriques, j'aimerai rajouté une colonne, longueur totale.

En rajoutant un if quelque part qui pourrait voir et lire la valeur de l'attribut longueur présent ou pas dans l'ensemble des blocs sélectionnés.

 

Je ne sais pas trop comment il faudrait faire pour modifier le code.

Pouvez-vous m'aider ?

Je vous remercie par avance.

 

Voici le code d'origine de Tramber :

 

;; Tabloblo (Tramber) 

;; Crée un tableau qui liste les blocs insérés (sélectionnés ou toute la collection) 
(defun c:tabloblo        
      (/ libloc liidbloc ss col liref ptins tableVL cont row 
       lassoc) 
  
 (vl-load-com)   
 (or *acdoc*       
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) 
           )   
 (prompt "\nSélectionnez les blocs à lister ou ")   
 (or (setq ss (ssget '((0 . "INSERT"))))       
     (setq ss (ssget "_X" '((0 . "INSERT")))        
           col T)) 
  
 (if ss     
   (progn       
     (vlax-for x                
               (setq      
                 ss (vla-get-ActiveSelectionSet *acdoc*)                  
                 )      
       (or (vlax-property-available-p x 'Path)      
           (setq liref             
                  (cons                      
                    (if (vlax-property-available-p x 'EffectiveName)                   
                      (vla-get-EffectiveName x)                        
                      (vla-get-Name x)                 
                      )                      
                    liref                    
                    )             
                 )          
           )    
       )       
     (vla-delete ss)       
     )     
   ) 
  
 (if col     
   (vlax-for i (vla-get-Blocks *acdoc*)       
     (if (and (not (wcmatch (setq name (vla-get-Name i)) "`**,*|*"))           
              (= :vlax-false (vla-get-IsXref i))               
              )         
       (setq libloc (append libloc (list (vla-get-name i)))           
             liidbloc (append liidbloc (list (vla-get-ObjectID i)))           
             )  
       )       
     )     
   (setq libloc (remove_doubles liref)    
         liidbloc (mapcar                    
                    '(lambda (x)                        
                       (vla-get-ObjectID                          
                         (vla-item                          
                           (vla-get-Blocks *acdoc*)                         
                           x                        
                           )                      
                         )                      
                       )                     
                    libloc                   
                    )     
         )     
   ) 
  
 (initget 1)   
 (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0))   
 (setq tableVL (vla-addtable              
                 (vla-get-modelspace                
                   (vla-get-activedocument (vlax-get-acad-object))                  
                   )              
                 (vlax-3d-point ptins)            
                 (+ 2 (length libloc))            
                 3                
                 20 ; Hauteur cellule             
                 80 ; Largeur cellule             
                 )      
       )   
 (vla-put-VertCellMargin tableVL 4.0) ; Marge verticale   
 (vla-put-TitleSuppressed tableVL :vlax-false)   
 (vla-put-HeaderSuppressed tableVL :vlax-false)   
 (vla-setText tableVL 0 0 "Blocs") ; Titre   
 (vla-setText tableVL 1 0 "Nom") ; Titre colonne 1   
 (vla-setText tableVL 1 1 "Nombre") ; Titre colonne 2   
 (vla-setText tableVL 1 2 "Symbole") ; Titre colonne 3   
 (setq cont -1  
       row 1    
       )   
  
 (setq lassoc 
        (cond((if(setq f(FINDFILE "Table blocs.txt"))(setq f(open f "r"))); ATTENTION, fichier texte à mettre dans le dossier du fichier ou dans un dossier de support 
              (while(setq lignt (read-line f)) 
                (setq lignt(vl-remove-if '(lambda(x)(= x ""))(gc:str2lst lignt"\t")) 
                      lis(cons lignt lis)) 
                ) 
              ) 
             ) 
       ) 
 (if f(close f)) 


 (repeat (- (vla-get-Rows tableVL) 2) 
   (setq nouvn(nth (setq cont (1+ cont)) libloc)) 
   (vla-settext 
      
     tableVL 
      
     (setq row (1+ row)) 
      
     0 
      
     (cond((trouvnom nouvn))(T nouvn)) 
      
     ) 
    
   (vla-settext 
      
     tableVL 
      
     row 
      
     1 
      
     (length (vl-remove-if-not 
                
               '(lambda (n) (= n (nth cont libloc))) 
                
               liref 
                
               ) 
              
             ) 
      
     ) 
    
   (vla-SetBlockTableRecordId 
      
     tableVL 
      
     row 
      
     2 
      
     (nth cont liidbloc) 
      
     :vlax-true 
      
     ) 
    
   (vla-setcellalignment tableVL row 0 5) 
    
   (vla-setcellalignment tableVL row 1 5) 
    
   ) 
  
 (princ) 
  
 ) 

;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste 


(defun REMOVE_DOUBLES (lst) 
  
 (if lst 
    
   (cons (car lst) (REMOVE_DOUBLES (vl-remove (car lst) lst))) 
    
   ) 
  
 ) 

(defun trouvnom(ancn  / result); attention lassoc est modifié en global dans c:tabloblo 
 (if(setq result(cadar(vl-remove-if-not '(lambda(x)(=(car x)ancn))lassoc))) 
   (setq lassoc(vl-remove-if '(lambda(x)(=(car x)ancn))lassoc)) 
   ) 
 result 
 ) 

;; gc:str2lst 
;; Transforme une chaine avec séparateur en liste de chaines 
;; 
;; Arguments 
;; str : la chaine à transformer en liste 
;; sep : le séparateur 

(defun gc:str2lst (str sep / len lst) 
 (setq len (strlen sep)) 
 (while (setq pos (vl-string-search sep str)) 
   (setq lst (cons (substr str 1 pos) lst) 
         str (substr str (+ len pos 1)) 
   ) 
 ) 
 (reverse (cons (substr str 1 pos) lst)) 
)

[Oli553]

Bonjour,

As tu eu une réponse car je suis dans le même cas que toi.

Cordialement

[Tramber]

Alors ça c'est super gentil.

Mais cette routine n'est plus de moi depuis le début.

J'ai donné la recette pour programmer des tableaux avec les vues des blocs. C'était tout ce qu'il y avait de nouveau en cette lointaine époque.

Or il y a eu de nombreuses versions, hein ?

Je viens de passer du temps sur un autre sujet et hélas le temps m'est compté. Alors libre à chacun de modifier... je le ferai si j'ai le temps ce soir ou cet après-m.