Liste de tous les attributs de tous les blocs identiques

[treza88]

Bonjours à tous,

je cherche le moyen, si il y en a un, de lister toutes les instances (insertions) du même bloc pour y lister tous les attributs.

Je suis sous Drafsight 2023.

existerait il une commande Lisp qui ferait le taf car je n'ai pas les compétences pour en créer une ?

Merci d'avance

[didier]

Bonjour @treza88

Je crois bien que le LSP est supporté par ce logiciel.
Faîtes une recherche sur ce site, les exemples sont nombreux.
Si la recherche n'aboutit pas. Je vous viendrai en aide.

Avez-vous déjà lancé la recherche ?

Amicalement

[lecrabe]

Hello

Pas sur de bien comprendre ton besoin !?

Le Lisp/VLisp "LSTATT" ci-apres est de notre REGRETTE Grand Maitre Patrick_35 !

Peut etre te conviendra t-il ?

Cette routine "defile" sur l ecran texte les Blocs selectionnes (Comptage) ou bien dans un fichier,

et CE en fonction du nombre d attributs choisi (1-N) ...

Mais je ne sais pas si elle va fonctionner sur ton Draftsight !? ... Tu nous diras ?

Bye, lecrabe

 

 
;;;=================================================================
;;;
;;; LSTATT.LSP V4.40
;;;
;;; Décompte des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

;; 
;; --- Interrogation Entite/Objet en Lisp ---
;; (entget (car (entsel)) '("*"))
;; 

(defun c:lstatt(/ choix doc i js ent fic fil lab lst mrc trc n nb nm nombl InputBox liste_att mrech rechercher_nom s sel tbl trier txt visibilite *errlst*)

  (defun *errlst* (msg)
    (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
      (princ (strcat "\nErreur : " msg))
    )
    (setq *error* s)
    (princ)
  )

  (defun visibilite(nom / bl ok vi)
    (and (setq bl (vla-item (vla-get-blocks doc) nom))
	 (setq vi (vl-some '(lambda (pair)
			     (if
				(and
				  (= 360 (car pair))
				  (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
				)
				(cdr pair)
			      )
			    )
			    (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary bl)) "ACAD_ENHANCEDBLOCK")
		  )
	 )
	 (setq vi (entget vi))
	 (setq ok (cdr (assoc 301 vi)))
    )
    ok
  )

  (defun nombl(bl / nom vi)
    (if (vlax-property-available-p bl 'effectivename)
      (progn
	(setq nom (vla-get-effectivename bl))
	(and (setq vi (visibilite nom))
	     (= (vla-get-propertyname (car (vlax-invoke bl 'getdynamicblockproperties))) vi)
	     (setq nom (strcat nom ":" (vlax-get (car (vlax-invoke bl 'getdynamicblockproperties)) 'value)))
	)
	nom
      )
      (vla-get-name bl)
    )
  )

  (defun choix(/ bl js lst nom sel)
    (princ "\nSelectionnez le(s) Bloc(s) a Denombrer : ")
    (and (ssget (list (cons 0 "insert")))
      (progn
	(vlax-for bl (setq sel (vla-get-activeselectionset doc))
	  (or (member (setq nom (nombl bl)) lst)
	    (setq lst (cons nom lst))
	  )
	  (redraw (vlax-vla-object->ename bl) 4)
	)
	(foreach nom lst
	  (if js
	    (setq js (strcat js "," nom))
	    (setq js nom)
	  )
	)
	(vla-delete sel)
      )
    )
    js
  )

  (defun InputBox (Titre js / ch dcl fil res tmp txt)
    (setq tmp (vl-filename-mktemp "lstatt" nil ".dcl")
	  fil (open tmp "w")
    )
    (foreach txt '(	"lstatt : dialog {"
			"  key = \"titre\";"
			"  alignment = centered;"
			"  is_cancel = true;"
			"  allow_accept = true;"
			"  width = 30;"
			"  : boxed_column {"
			"    label = \"Veuillez donner un Nom de Bloc ou * pour tous\";"
			"    : row {"
			"      : edit_box {key = \"filtre\";width = 45;}"
			"      : button {key = \"choix\"; label = \">>\";}"
			"    }"
			"    spacer;"
			"  }"
			"  : boxed_column {"
			"    label = \"Nombre d'Attributs a prendre en compte\"; "
			"    : edit_box {key= \"att\";}"
			"    spacer;"
			"  }"
			"  spacer;"
			"  : toggle {key = \"fic\"; label = \"Ecrire les Resultats dans un fichier\";}"
			"  : toggle {key = \"lab\"; label = \"Ajouter le Nom des Etiquettes dans les Resultats\";}"
			"  spacer;"
			"  ok_cancel;"
			"}"
		 )
      (write-line txt fil)
    )
    (close fil)
    (setq dcl (load_dialog tmp))
    (while (not (member res '(0 1)))
      (new_dialog "lstatt" dcl "")
      (set_tile "titre" titre)
      (set_tile "filtre" js)
      (set_tile "att" nb)
      (set_tile "fic" fic)
      (set_tile "lab" lab)
      (action_tile "filtre" "(setq js $value)")
      (action_tile "choix"  "(done_dialog 2)")
      (action_tile "att"    "(setq nb $value)")
      (action_tile "fic"    "(setq fic $value)")
      (action_tile "lab"    "(setq lab $value)")
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq res (start_dialog))
      (and (eq res 2)
	   (setq ch (choix))
	   (setq js ch)
      )
    )
    (unload_dialog dcl)
    (vl-file-delete tmp)
    (if (member res '(1 2))
      js
      ""
    )
  )

  (defun liste_att(att / n lst val)
    (if (< (atoi nb) (length att))
      (progn
	(setq n 0)
	(while (and (< n (atoi nb)) (setq val (nth n att)))
	  (setq lst (cons (if (eq lab "0")
			    (vla-get-textstring (nth n att))
			    (strcat (vla-get-tagstring (nth n att)) ":" (vla-get-textstring (nth n att)))
			  )
			  lst
		    )
		n (1+ n)
	  )
	)
	(reverse lst)
      )
      (if (eq lab "0")
        (mapcar 'vla-get-textstring att)
	(mapcar '(lambda(x)(strcat (vla-get-tagstring x) ":" (vla-get-textstring x))) att)
      )
    )
  )

  (defun rechercher_nom(val / att nom tbl)
    (setq nom (nombl val))
    (if (eq (vla-get-hasattributes val) :vlax-true)
      (if (member (setq att (vlax-invoke val 'getattributes)) '(nil))
	(list nom)
	(cons nom (liste_att att))
      )
      (list nom)
    )
  )

  (defun trier(a b / c n s)
    (setq c 0)
    (while (and (not s) (nth c a))
      (if (eq (nth c a) (nth c b))
	(setq c (1+ c))
	(setq s T)
      )
    )
    (or (nth c a) (setq c 0))
    (< (strcase (nth c a)) (strcase (nth c b)))
  )

  (defun mrech(bl / ent lst recu)
    (defun recu(bl)
      (vlax-for ent (vla-item (vla-get-blocks doc) (nombl bl))
	(and (eq (vla-get-objectname ent) "AcDbBlockReference")
	  (if (eq (substr (nombl ent) 1 1) "*")
	    (recu ent)
	    (setq lst (cons ent lst))
	  )
	)
      )
    )
    (and (eq (substr (nombl bl) 1 1) "*")
      (recu bl)
    )
    lst
  )

  (vl-load-com)
  (setq s *error*
	*error* *errlst*
	doc (vla-get-activedocument (vlax-get-acad-object))
  )
  (or (setq nb (getenv "Patrick_35_nb_att"))
    (setq nb "1")
  )
  (or (setq lab (getenv "Patrick_35_nb_lab"))
    (setq lab "0")
  )
  (setq fic "0")
  (if (not (eq (setq nm (InputBox "Decompte de Blocs v4.40" "*")) ""))
    (progn
      (setq js (strcat "`**," nm))
      (if (ssget (list (cons 0 "INSERT") (cons 2 js)))
	(progn
	  (setenv "Patrick_35_nb_att" nb)
	  (setenv "Patrick_35_nb_lab" lab)
	  (vlax-map-collection	(setq sel (vla-get-activeselectionset doc))
				'(lambda (x)
				  (if (setq trc (mrech x))
				    (foreach mrc trc
				      (if (wcmatch (strcase (car (setq js (rechercher_nom mrc)))) (strcase nm))
					(setq tbl (cons js tbl))
				      )
				    )
				    (if (wcmatch (strcase (car (setq js (rechercher_nom x)))) (strcase nm))
				      (if (eq (vla-get-objectname x) "AcDbMInsertBlock")
					(repeat (* (vla-get-columns x) (vla-get-rows x))
					  (setq tbl (cons js tbl))
					)
					(setq tbl (cons js tbl))
				      )
				    )
				  )
				)
	  )
	  (vla-delete sel)
	  (while tbl	
	    (setq n   (length tbl)
		  js  (car tbl)
		  tbl (vl-remove js tbl)
		  lst (cons (cons (itoa (- n (length tbl))) js) lst)
	    )
	  )
	  (if lst
	    (progn
	      (and (eq fic "1")
		(setq fil (open (setq txt (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".txt")) "w"))
	      )
	      (foreach n (vl-sort lst '(lambda (a b) (trier (cdr a) (cdr b))))
		(if (eq fic "1")
		  (princ (strcat (car n) (chr 9) (cadr n)) fil)
		  (princ (strcat "\n"
				 (substr "     " 1 (- 5 (strlen (car n))))
				 (car n)
				 " "
				 (cadr n)
			 )
		  )
		)
		(setq i 2)
		(while (setq val (nth i n))
		  (if (eq fic "1")
		    (princ (strcat (chr 9) val) fil)
		    (princ (strcat "..." val))
		  )
		  (setq i (1+ i))
		)
		(and (eq fic "1")
		  (write-line "" fil)
		)
	      )
	      (and (eq fic "1")
		(princ (strcat "\nFichier \"" txt "\" cree. "))
		(close fil)
	      )
	    )
	    (princ "\nPas de bloc a Denombrer ! ")
	  )
	)
      )
    )
  )
  (setq *error* s)
  (princ)
)

(setq nom_lisp "LSTATT")
(if (/= app nil)
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " charge. "))
    (princ (strcat "\n" nom_lisp ".LSP Charge ... Tapez " nom_lisp " pour l'executer.")))
  (princ (strcat "\n" nom_lisp ".LSP Charge ... Tapez " nom_lisp " pour l'executer.")))
(setq nom_lisp nil) 
(princ) 

 

[Eric]

Bonjour, 

Pour lister des attributs, il y a le choix dans DraftSight.

- Le plus simple et rapide, c'est la commande SORTIEATTRBLOC. On sélectionne les blocs et il crée un fichier txt avec le listing.

- Il y a aussi la commande EXTRATTBLOC qui fonctionne comme l'extraction d'attributs dans AutoCAD LT. C'est un peu comme la commande précédente, mais il faut créer un fichier modèle pour indiquer ce que l'on veut extraire comme données.

- Il y a pour terminer la commande EXTRAIREDONNEES qui fonctionne comme l'extraction de données d'AutoCAD où on choisit dans des boites de dialogues et étape par étape ce que l'on veut extraire comme listing.

 

[lecrabe]

Hello @Eric

Une reponse MAGISTRALE de Eric !

Bye, lecrabe

 

[treza88]

Merci à vous trois et en particulier à Eric pour la connaissance de cette commande et sa simplicité d'utilisation.

C'est exactement ce qu'il me fallait.

[lecrabe]

Hello @treza88

SVP au fait as tu pu charger et executer le Lisp LSTATT sur ton Draftsight ??

Merci, Bye, lecrabe

 

[treza88]

A priori non, j'ai cette erreur quand je la lance :

: LSTATT

Erreur : Erreur: paramètre non valide.

 

[lecrabe]

Hello

OK Merci donc Draftsight n est pas "tres compatible" Lisp / VLisp AutoCAD !

Bye, lecrabe