LSTATT.lsp petite demande

[funkkybebel]

Bonjour, j'ai récuperé sur le forum (mais je ne sais plus où) le lisp lstatt.lsp qui permet de faire des comptage de bloc avec les attributs (ce qui manquait à lstbl.lsp)

 

Je colle le code ci-dessous.

 

J'aurais juste 2 améliorations à faire si quelqu'un sait comment s'y prendre :

 

1/ Que le lisp ne me demande plus (ou la limite sous forme d'option) quels sont les éléments à prendre mais qu'il prenne automatiquement tous les bloc d'un coup.

 

2/ Que le lisp me demande directement ou je veux enregistrer le résultat, sous forme de fichier xls par exemple.

 

Merci à tous pour votre aide.

 

 
;;;=================================================================
;;;
;;; LSTATT.LSP V2.01
;;;
;;; Décompte des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:lstatt(/ js bllst ent lst nb nm InputBox rechercher_nom tbl)

 (defun InputBox (Titre Message Defaut / users1 valeur)
   (setq users1 (getvar "users1"))
   (acad-push-dbmod)
   (vla-eval (vlax-get-acad-object) (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
   (setq valeur (getvar "users1"))
   (setvar "users1" users1)
   (acad-pop-dbmod)
   valeur
 )

 (defun rechercher_nom(val / att nom)
   (if (vlax-property-available-p val 'effectivename)
     (setq nom (vla-get-effectivename val))
     (setq nom (vla-get-name val))
   )
   (if (eq (vla-get-hasattributes val) :vlax-true)
     (progn
(setq att (vla-get-textstring (car (vlax-invoke val 'getattributes))))
(if (member att '(nil))
  (list nom)
  (list nom att)
)
     )
     (list nom)
   )
 )

 (vl-load-com)
 (if (not (eq (setq nm (InputBox "Décompte de blocs" "Veuillez donnez un nom de bloc ou * pour tous" "*")) ""))
   (progn
     (setq js (strcat "`**," nm))
     (if (setq js (ssget (list (cons 0 "INSERT") (cons 2 js))))
(progn
  (vlax-map-collection	(setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
			'(lambda (x)
			  (if (wcmatch (strcase (car (setq js (rechercher_nom x)))) (strcase nm))
			    (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
    (foreach n (vl-sort lst '(lambda (a b) (if (= (cadr a) (cadr b))
					       (< (strcase (caddr a)) (strcase (caddr b)))
					       (< (strcase (cadr a)) (strcase (cadr b)))
					   )
			     )
	     )
      (princ (strcat "\n"
		     (substr "     " 1 (- 5 (strlen (car n))))
		     (car n)
		     " "
		     (cadr n)
	     )
      )
      (if (caddr n)
	(princ (strcat (substr ".............................." 1 (- 30 (strlen (cadr n))))
			   "avec attribut " (caddr n)
	       )
	)
      )
    )
    (princ "\nPas de bloc à dénombrer.")
  )
)
     )
   )
 )
 (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 " chargé."))
   (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

[Patrick_35]

Salut

 

Pour tous sélectionner, remplace

(not (eq (setq nm (InputBox "Décompte de blocs" "Veuillez donnez un nom de bloc ou * pour tous" "*")) ""))

Par

(setq nm "*")

 

Pour l'écriture du fichier, le plus simple est de passer par du texte. Je te laisse chercher ;)

 

@+

[funkkybebel]

Bonjour,

Merci de ton aide patrick.

 

J'ai donc remplacé pour avoir cela :

 

 
(vl-load-com)
 (if [b](setq nm "*") [/b] 
   (progn

 

Par contre le curseur change en outil de sélection, je me dis ok ben je vais quand même selectionner, et en validant j'obtiens:

 

erreur: type d'argument incorrect: VLA-OBJECT nil

 

Je vais essayer de fouiller dans des lisp qui selectionnent automatiquement tous les blocs en objet, et dans d'autres où j'ai la possibilité de sauvegarder sous un fichier txt ou xls.

 

Merci,

Salutations.

[Patrick_35]

Re

 

Oups, j'ai oublié de préciser le "x" dans le ssget

 

Pour me faire "pardonner" ;)

 

;;;=================================================================
;;;
;;; LSTATTF.LSP V1.00
;;;
;;; Ecrire dans un fichier texte le décompte des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:lstattf(/ js bllst ent fichier file lst nb nm rechercher_nom tbl)

 (defun rechercher_nom(val / att nom)
   (if (vlax-property-available-p val 'effectivename)
     (setq nom (vla-get-effectivename val))
     (setq nom (vla-get-name val))
   )
   (if (eq (vla-get-hasattributes val) :vlax-true)
     (progn
(setq att (vla-get-textstring (car (vlax-invoke val 'getattributes))))
(if (member att '(nil))
  (list nom)
  (list nom att)
)
     )
     (list nom)
   )
 )

 (vl-load-com)
 (if (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 "`**,*"))))
   (progn
     (vlax-map-collection
(setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
'(lambda (x)
  (setq tbl (cons (rechercher_nom x) 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 (and lst
       (setq fichier (getfiled "Fichier de Décompte" "" "txt" 1))
  )
(progn
  (setq file (open fichier "w"))
  (foreach n (vl-sort lst '(lambda (a b) (if (and (= (cadr a) (cadr b) (caddr a) (caddr b)))
					       (< (strcase (caddr a)) (strcase (caddr b)))
					       (< (strcase (cadr a))  (strcase (cadr b)))
					     )
			   )
	     )
    (princ (strcat (substr "     " 1 (- 5 (strlen (car n))))
		   (car n)
		   " "
		   (cadr n)
	   )
	   file
    )
    (if (caddr n)
      (princ (strcat (substr ".............................." 1 (- 30 (strlen (cadr n))))
		     "avec attribut " (caddr n)
	     )
	     file
      )
    )
    (write-line "" file)
  )
  (close file)
  (princ (strcat "\nFichier " fichier " créé."))
)
(princ "\nPas de bloc à dénombrer.")
     )
   )
 )
 (princ)
)

(setq nom_lisp "LSTATTF")
(if (/= app nil)
 (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
   (princ (strcat "..." nom_lisp " chargé."))
   (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

@+

[lili2006]

Bonsoir à toutes et tous,

 

Marche Nickel-chrome Patrick_35 ! :P

 

M'étonnerai que tu n'sois pas "pardonné", :D

[funkkybebel]

C'est un truc de fou ce programme !

 

Merci énormément........je pense que tu es largement pardonné !

 

Merci beaucoup !

[funkkybebel]

Bien évidemment il fallait bien que je la ramène.

 

J'ai modifié le lisp pour que ça enregistre en excel, par contre toute la ligne correspond à une seule cellule.

Est-il possible de mettre chaque item (quantité / nom du bloc / attribut ...) dans une cellule différente à chaque fois, afin de pouvoir travailler plus facilement sous excel ?

 

Merci.

[lili2006]

Bonjour à toutes et tous,

 

Et pourquoi ne fais-tu pas cette transfo depuis ton tableur ?

 

[Patrick_35]

Salut

 

Tu remplaces

    (princ (strcat (substr "     " 1 (- 5 (strlen (car n))))
		   (car n)
		   " "
		   (cadr n)
	   )
	   file
    )
    (if (caddr n)
      (princ (strcat (substr ".............................." 1 (- 30 (strlen (cadr n))))
		     "avec attribut " (caddr n)
	     )
	     file
      )
    )

par

    (princ (strcat (car n) [surligneur]","[/surligneur] (cadr n)) file)
    (if (caddr n)
      (princ (strcat [surligneur]","[/surligneur] (caddr n)) file)
    )

en partant sur la base que c'est la virgule qui sert de séparateur. Sinon, la remplacer par le ; ou encore tab (chr 9) ou "\t" par exemple.

 

@+

[funkkybebel]

Génial !

Je l'ai remplacé par (chr 9)

 

Excellent.

 

Merci, A bientôt.

[funkkybebel]

Aie aie aie, j'ai parlé trop vite.

Merci beaucoup c'est sûr mais il semble y avoir un autre problème.

 

En effet pas tous les attributs sont comptabilisés. :exclam:

Je pense que cela provient de la manière dont a été fait le bloc....

Est-il possible de comptabiliser tous les attributs d'un bloc ?

 

Voici un fichier exemple avec lequel le quantitatif ne colle pas :

http://www.rhodes-tunes.com/misc/exemple.dwg

(si firefox ouvre une page avec pleins de caractères, faire fichier enregistrer sous...)

 

Ci-dessous le lisp avec tabulation (merci patrick).

D'autre part, est-il possible de mettre un titre sur la première ligne avec la légende des colonnes (quantité / désignation / attribut1 / attribut2 ....)

 

 
;;;====================================================== ===========
;;;
;;; LSTATTF.LSP V1.00
;;;
;;; Ecrire dans un fichier texte le décompte des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:lstattf(/ js bllst ent fichier file lst nb nm rechercher_nom tbl)

(defun rechercher_nom(val / att nom)
(if (vlax-property-available-p val 'effectivename)
(setq nom (vla-get-effectivename val))
(setq nom (vla-get-name val))
)
(if (eq (vla-get-hasattributes val) :vlax-true)
(progn
(setq att (vla-get-textstring (car (vlax-invoke val 'getattributes))))
(if (member att '(nil))
(list nom)
(list nom att)
)
)
(list nom)
)
)

(vl-load-com)
(if (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 "`**,*"))))
(progn
(vlax-map-collection
(setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
'(lambda (x)
(setq tbl (cons (rechercher_nom x) 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 (and lst
(setq fichier (getfiled "Fichier de Décompte" "" "xls" 1))
)
(progn
(setq file (open fichier "w"))
(foreach n (vl-sort lst '(lambda (a b) (if (and (= (cadr a) (cadr b) (caddr a) (caddr b)))
(< (strcase (caddr a)) (strcase (caddr b)))
(< (strcase (cadr a)) (strcase (cadr b)))
)
)
)
(princ (strcat (car n) (chr 9) (cadr n)) file)
(if (caddr n)
(princ (strcat (chr 9) (caddr n)) file)
)
(write-line "" file)
)
(close file)
(princ (strcat "\nFichier " fichier " créé."))
)
(princ "\nPas de bloc à dénombrer.")
)
)
)
(princ)
)

(setq nom_lisp "LSTATTF")
(if (/= app nil)
(if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
(princ (strcat "..." nom_lisp " chargé."))
(princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
(princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

[Edité le 18/9/2008 par funkkybebel]

[Patrick_35]

Re

 

Le lisp prends en compte que le premier attribut et dans ton exemple, ce serait pour le troisième.

Le résultat est donc normal.

Reste à changer l'ordre des attributs avec battman, puis synchroniser.

 

@+

[funkkybebel]

Ok.

Merci.