Comment créer une légende ?

[Nikos0222]

Bonjour à tous,

 

J'ai terminer mon implantation électrique dans MEP ...

 

Je souhaiterais savoir comment on génère une légende des composant avec une image de chaque élément ?

 

Merci pour vos réponses.

 

Nikos.

[lesourd2]

Salut

 

Peut etre de cette façon

 

 ;; 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 < Tous >")
(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*)
)
(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 (/= (substr (vla-get-name i) 1 1) "*")
(= :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)))
)
) 

 

 

Merci à son auteur

 

@+