Métré des blocs

[khairi74]

Bonjour,

 

J'ai des blocs dans un fichier et je veux faire le métré dans un tableau ou légende qui contient tous différent nom du bloc dans ce même fichier et tant que je j'utilise un bloc le tableau fait automatiquement le total dans le tableau.

 

(la commande n'est pas count) j'utilise l'autocad 2009 version anglaise.

 

Merci d'avance..........

[lili2006]

Bonsoir à toutes et tous,

 

Bienvenue khairi74,

 

Essayes ça =>

 

;; 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)
(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
)
(repeat (- (vla-get-Rows tableVL) 2)
(vla-settext
tableVL
(setq row (1+ row))
0
(nth (setq cont (1+ cont)) libloc)
)
(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)))
)
)