Cumul aire polylignes hachurées

[mimiingerop]

J'ai trouvé sur le forum pas mal de routines pour cumuler des aires ou des longueurs de polylignes, et les renvoyer vers excel.

 

J'ai un besoin d'appliquer cela à un problème un peu similaire, il s'agit de cumuler les surfaces des hachures par calque et d'extraire un tableau sur excel avec les nom des calques en colonne 1 et les cumuls surfaces en colonne 2.

 

Elémentaire me direz vous les gile patrick & co... mais pas évident pour moi. Avec la 2008 j'ai fait une macro qui fonctionne mais en 2007 c'est pas pareil!!!

 

Alors si vous pouvez m'aider dans ce sens je suis preneuse ...., je sais un peu bidouiller le lisp mais le vba pas du tout ... merci davance pour votre aide.

[(gile)]

Salut,

 

Voici un petit LISP (Hatch2Excel ) qui devrait répondre à ta demande.

 

NOTA : Les routines de GetExcel.lsp doivent être chargées (dernière version) ansi que la routine DoubleInputBox.

 

EDIT : réparé un bug (voir ce dessous) et ajout d'un bonus : [surligneur]la somme des surfaces[/surligneur]

 

(defun c:Hatch2Excel (/ acdoc tot lst file cell sheet n)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vlax-for l (vla-get-Layers acdoc)
   (setq name (vla-get-Name l)
	 tot  0.0
   )
   (if (ssget "_X" (list '(0 . "HATCH") (cons 8 name)))
     (progn
       (vlax-for h (vla-get-ActiveSelectionSet acdoc)
	 (setq tot (+ tot (vla-get-area h)))
       )
       (setq lst (cons (list name tot) lst))
     )
   )
 )
 (setq
   lst (vl-sort	lst
		(function (lambda (x1 x2) (< (car x1) (car x2))))
       )
 )
 (if (member (type getexcel) '(SUBR USUBR))
   (if (setq
	 file (getfiled "Choisir ou créer un fichier Excel" "" "xls" 33)
       )
     (if (member (type doubleinputbox) '(SUBR USUBR))
       (progn
	 (while	(not (and
		       (setq cell  (doubleinputbox
				     "Hachures vers Excel"
				     "Nom de la feuille Excel"
				     "Cellule de départ"
				     "Feuil1"
				     "A1"
				    )
			     sheet (car cell)
			     cell  (cadr cell)
		       )
		       (cell-p cell)
		     )
		)
	   (alert "Référence de cellule non valide.")
	 )
	 (and (= sheet "") (setq sheet nil))
	 (OpenExcel (cond ((findfile file))) sheet nil)
	 (repeat (setq n (length lst))
	   (putCell cell (car lst))
	   (setq lst  (cdr lst)
		 cell (Row+n cell 1)
	   )
	 )
	 [surligneur]
	 ;;---------------- Somme des surfaces ----------------;;
	 (putCell
	   cell
	   (list "Total"
		 (strcat "=somme("
			 (column+n (row+n cell (- n)) 1)
			 ":"
			 (column+n (row+n cell (- 1)) 1)
		 )
	   )
	 )
	 ;;----------------------------------------------------;;[/surligneur]
	 (CloseExcel file)
       )
       (alert "La routine LISP DoubleInputBox doit être chargée.")
     )
   )
   (alert "GetExcel.lsp doit être chargé")
 )
 (princ)
)

 

 

[Edité le 10/11/2007 par (gile)]

[mimiingerop]

Gile tu est trop top

J'aipas encore testé mais je suis sûre que ça va marcher !!!

A plus pour les résultats ...

Sinon j'ai fait un tour à Batimat ce matin, et j'ai vu qu'ils font une démo sur autocad architecture 2008 qui fait exactement ça ...

Mais reste à convaincre les entreprises de basculer en autocad architecture ... et en attendant, je pense que ton aide me sera bien utile. Je te tiens au courant.... Bon we...

Mi

[lili2006]

Bonjour à toutes et tous,

 

(Gile), j'ai testé sur un autre ordi (XP SP2, AutoCAD 2008). La routine fonctionne mais m'ouvre toujours en cache le fichier. Si je lui demande de créer un fichier, il me dis qu'il ne l'a pas trouvé et si je créé un fichier Excel, à la fin du traitement, j'ai le message : Pour continuer fermer tous les fichiers Excel. Pourtant, rien de visible !(même problème sur ce post Réponse N° 24 !). Quand j'ouvre le fichier EXCel en question, on me dis qu'il est déjà ouvert (celui auquel j'ai accés est donc en lecture seule !). Il est cependant bien renseigné.

 

Là aussi, est-il possible de filtrer les surfaces de hachures par calques ?

 

Merci d'avance

[(gile)]

Oupss ! C'est une étourderie je n'avais pas collé la dernière version.

 

C'est réparé.

[lili2006]

Re,

 

Si je ne créé pas de fichier .XLS =>

 

Voici ce que me renvoi AutoCAD :

 

Commande: Hatch2Excel ; erreur: no function definition: NUM2ALPHA

 

J'ai toujours le message "Fermer toutes les feuilles Excel pour continuer" !!! ??

 

Si je créé un fichier .XLS => même message AutoCAD.

 

Voici le contenu des cellules EXCel :

 

BAC HACHURES AC BAC HACHURES AC 651586

 

Pourtant j'ai une dizaine de hachures (et calques) différents.

[(gile)]

Il me semble qu'il faille que tu fasses un peu de ménage.

 

Le message :

Commande: Hatch2Excel ; erreur: no function definition: NUM2ALPHA

veut dire qu'AutoCAD ne trouve pas la routine NUM2ALPHA qui fait poutant parti de GetExcel.lsp

 

Je te conseillerais de supprimer GetExcel.lsp, getBlock, getLayer, getLayers, InputBox et DoubleInputBox de ton ordi.

Puis télécharger Dialog sur cette page (tout en bas) et de refaire un copier/coller de GetExcel.lsp (dernière version).

Voire redémarrer ton ordi avant de refaire des essais.

 

La version deHatch2Excel ci-dessus cherche les hachures dans tous les calques du dessin, mais n'inscrit dans Excel que les résultat des calques qui contiennet effectivement des hachures.

 

La version ci-dessous, demande à l'utilisateur de spécifier les calques à traiter (getLayers doit être chargé) et écrit dans Excel les résultat pour tous ces calques (même s'il n'y a pas de hachures).

 

EDIT : ajout du calcul (formule Excel) de la somme des surfaces

 

(defun c:Hatch2Excel (/ acdoc lst tot file cell sheet n)
 (vl-load-com)
 (setq	acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
lst   (vl-sort
	(mapcar
	  (function
	    (lambda (l)
	      (setq tot 0.0)
	      (if (ssget "_X" (list '(0 . "HATCH") (cons 8 l)))
		(vlax-for h (vla-get-ActiveSelectionSet acdoc)
		  (setq tot (+ tot (vla-get-area h)))
		)
	      )
	      (list l tot)
	    )
	  )
	  (getlayers nil nil nil)
	)
	(function (lambda (x1 x2) (	      )
 )
 (if lst
   (if	(member (type getexcel) '(SUBR USUBR))
     (if (setq file (getfiled "Choisir ou créer un fichier Excel" "" "xls" 33))
(if (member (type doubleinputbox) '(SUBR USUBR))
  (progn
    (while (not	(and
		  (setq	cell  (doubleinputbox
				"Hachures vers Excel"
				"Nom de la feuille Excel"
				"Cellule de départ"
				"Feuil1"
				"A1"
			       )
			sheet (car cell)
			cell  (cadr cell)
		  )
		  (cell-p cell)
		)
	   )
      (alert "Référence de cellule non valide.")
    )
    (and (= sheet "") (setq sheet nil))
    (OpenExcel (cond ((findfile file))) sheet nil)
    (repeat (setq n (length lst))
      (putCell cell (car lst))
      (setq lst	 (cdr lst)
	    cell (Row+n cell 1)
      )
    )
    ;;---------------- Somme des surfaces ----------------;;
    (putCell
      cell
      (list "Total"
	    (strcat "=somme("
		    (column+n (row+n cell (- n)) 1)
		    ":"
		    (column+n (row+n cell (- 1)) 1)
	    )
      )
    )
    ;;----------------------------------------------------;;
    (CloseExcel file)
  )
  (alert "La routine LISP DoubleInputBox doit être chargée.")
)
     )
     (alert "GetExcel.lsp doit être chargé")
   )
 )
 (princ)
) 

 

[Edité le 10/11/2007 par (gile)]

[lili2006]

Re,

 

Merci (Gile) , je vais suivre tes conseils et revient.

[(gile)]

Salut,

 

J'ai trouvé le bug :

dans son LISP, Terry Miller a renommé mes routines num2alpha et alpha2num en number2alpha et alpha2number. Quand j'ai ajouté les routines Row+n et Column+n, je n'y ai pas fait attention, elles appellent num2alpha qui est chargé chez moi (mais sûrement uniquement chez moi) au lieu de number2alpha qui est défini dans le code publié.

 

J'ai corrigé le code ici.

 

Toutes mes excuses pour les désagréments causés par mon inattention.

[lili2006]

Bonjour à toutes et tous,

 

Tout fonctionne à merveille, maintenant sur "Hatch2Excel".Merci encore.

 

Toutes mes excuses pour les désagréments causés par mon inattention.

,

 

Y manquerai plus qu'ça !!!! (En plus, au début j'étais presque sûr que c'était moi qui ne faisait pas les choses correctements, j'ai tellement l'habitude,....)

 

Maintenant, surement rien à voir (Getbloc ?), lorsque j'utilises d'autres Lisp récemments revus par (gile) , j'ai ce message AutoCAD :[J'ai bien décharger mon ancien Getbloc.Lisp & Getbloc.DCL)

 

Commande: SSB

Utilisation: (acad_strlsort )

Erreur : quitter / sortir abandon; erreur: une erreur est survenue dans la

fonction *erreur*type d'argument incorrect: fixnump: nil

Commande:

 

Idem pour les Lisps "ins-pts;PNT2BLK; ins-vtx; INS3D", , il y en à peut_être d'autres.....

 

Une idée ?

 

 

[Edité le 11/11/2007 par lili2006]

[(gile)]

Salut,

 

Si tu fais (getblock nil) à la ligne de commande, as tu la boite de dialogue ?

 

Es-tu sur d'avoir supprimé toutes les definitions de getBlock ancienne version (getblock2 compris) ?

[(gile)]

Es-tu sur d'avoir supprimé toutes les definitions de getBlock ancienne version (getblock2 compris) ?

 

Petite précision, je veux parler des définitions (defun getblock ...) qui pourraient être inclues dans les LISP ssb, ins-pts, ins-vtx, etc...

[mimiingerop]

Même pas besoin de dire que tu es génial Gile, tout le monde sur ce forum le sait. En tout cas pour moi ça marche à merveille, je n'ai fait que récolter le fruit des vos échanges ... Comment te remercier ? Avec des bisous virtuels .?... :cool:

[lili2006]

Re,

 

Commande: (getblock nil)

Utilisation: (acad_strlsort )

; erreur: quitter / sortir abandon

 

Réponse de AutoCAD.

 

Petite précision, je veux parler des définitions (defun getblock ...) qui pourraient être inclues dans les LISP ssb, ins-pts, ins-vtx, etc...

 

Je m'en occupe de suite,

[lili2006]

Re,

 

En déchargent mes Lisps, quand le rentre :

 

(getblock nil), j'ai bien la Boite de Dialogue, sinon, message AutCAD cité précédemment/

[(gile)]

On va essayer de faire un diagnostic à distance.

 

1) tu ouvres l'éditeur Visual LISP (VLIDE)

 

2) dans le menu "Débogage" tu coches "Arrêt sur erreur"

http://img145.imageshack.us/img145/3062/debug1rs3.png

 

3) depuis AutoCAD, tu lances ta commande et continues jusqu'à provoquer l'erreur, l'éediteur devrait s'ouvrir.

 

4) depuis l'éditeur, tu fais CTRL+F9, le LISP devrait s'ouvrir dans l'éditeur avec l'expression incriminée en surbrillance

 

5) tu fais une copie écran (ou copies l'expression sélectionnée)

 

6) tu cliques sur le bouton "Réinitialiser"

http://img442.imageshack.us/img442/6754/debug2pk4.png

 

7) tu décoches "Arrêt sur erreur" dans le menu "Débogage"

 

8) tu postes la copie écran

 

9) j'essaye de comprendre...

 

[Edité le 25/11/2007 par (gile)]

[lili2006]

Re,

 

(gile), j'avais un chemin des fichiers supports D'AutoCAD qui menait effectivement à une BD du DCL de la version Getbloc, depuis, à priori, plus de soucis, c'est même du tonnère d'avoir toujours les mêmes BD pour les commandes qui les nécessitent. Merci beaucoup du soutien alors.

 

mimiingerop merci pour la suggestion, option intéressante en Avant_Métré sommaire, ou autres,...

 

(gile) , Désolé du dérangement, c'est (ou plutôt, je suis !)parfois trés bête !!

 

Bon dimanche à tous,

[lili2006]

Rere,

 

Remarque, ça nous aura permis de savoir comment on peut mettre en évidence une faute dans un Lisp !

 

9) j'essaye de comprendre...

 

10) Merci encore pour tout (et tous) (gile)

 

11) Y' a plus qu'à utilser ! (c'est pas beau, ça ??)

 

Au plaisir,

[mimiingerop]

Gile, sans vouloir abuser (mais tout en abusant)

Je préfèrerai que disparaisse la boite de dialogue qui demande le nom du fichier excel (je le fixe à Surface.xls) et celle qui demande la cellule de départ et la sheet (j'accepte Feul1 et A1)

Ceci pour automatiser ensuite mon calcul et supprimer tout intervention humaine... .

J'ai bien essayé de mettre les filedia et cmddia à 0 mais ça ne suffit pas...

Merci d'avance

 

[(gile)]

Salut,

 

Je peux supprimer les boites dialogue, le LISP ne fonctionnera que pour ce fichier, cette feuille et à partir de la cellule A1, ce qui veut dire qu'à chaque lancement, il écrasera les données précédentes par les nouvelles.

 

De toutes façons, il faudrait que tu précises le chemin complet du fichier même si le fichier n'existe pas encore pour pouvoir l'enregistrer et si tu pouvais aussi dire si tu veux ou pas le calcul de la somme de toutes les surfaces (bonus).

 

On pourrait aussi, en aveugle, créer un fichier de même nom que le dessin avec le suffixe "Surface" dans le même répertoire que le dessin.

[mimiingerop]

Gile,

Le fichier existe déjà, car en fait il contient un autre onglet qui récupère les données brutes d'autocad et les mets en forme avec divers calculs, et ensuite ce tableau qui a déjà été collé dans autocad avec liaison ole se met à jour dans le dessin.

 

Et ça marche bien, j'ai mis tu verras un setq file et un setq cell et j'ai supprimé les boites de dialogues

 

il n'y a plus qu'un seul hic pour mon automatisation, c'est qu'il me demande si je veux ecraser ou non le fichier excel je suppose que c'est dans la routine (CloseExcel file) que je devrais ajouter quelque chose ? quoi ?

 

sinon tout est parfait, voici mon code :

-------------------------------

 

(defun c:Hatch2Excel (/ acdoc tot lst file cell sheet n)

(vl-load-com)

(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

(vlax-for l (vla-get-Layers acdoc)

(setq name (vla-get-Name l)

tot 0.0

)

(if (ssget "_X" (list '(0 . "HATCH") (cons 8 name)))

(progn

(vlax-for h (vla-get-ActiveSelectionSet acdoc)

(setq tot (+ tot (vla-get-area h)))

)

(setq lst (cons (list name tot) lst))

)

)

)

(setq lst (vl-sort lst

(function (lambda (x1 x2) (< (car x1) (car x2))))

)

)

(setq file "c:/surface.xls")

(setq cell "A1")

(OpenExcel (cond ((findfile file))) sheet nil)

(repeat (setq n (length lst))

(putCell cell (car lst))

(setq lst (cdr lst)

cell (Row+n cell 1)

)

)

 

(CloseExcel file)

 

(princ)

)

-----------------------

P.S. j'espère que ça ne t'empêchera pas de suivre Lyon OM ce soir ... moi bien que parisienne, je suis supportrice de l'OM et en ce moment ils en ont bien besoin ...

:mad:

[(gile)]

Hé ! je vois que tu te débrouilles bien pour modifier un code ;)

 

Je ne saurais expliquer pourquoi, mais si tu remplace :

 

(setq file "c:/surface.xls")

 

par :

 

(setq file "c:\\surface.xls")

 

ça semble écraser le fichier sans alerte.

[mimiingerop]

en effet !!!

J'avais oublié qu'on pouvait utiliser l'antislash en le doublant...

Merci pour le gentil compliment mais c'est vraiment trop gentil, je suis nulle en lisp, je n'arrive qu'en bidouillant ce qui est horripilant.

SInon j'ai encore un petit souci, mon lien ole vers le tableau excel,bien qu'automatique, ne se fait pas en fin de commande hatch2excel. J'ai donc pensé lancer la commande "liensole" par une macro, mais elle n'a pas de version sans boite de dialogue (genre "-liensole"). Encore ces fichues boites de dialogue. Sais tu comment on peut forcer la mise à jour d'un objet ole ? j'ai rusé en utilisant la commande revert car si on ferme et on reouvre, ça fait la mise à jour, mais ce n'est pas élégant.

 

[(gile)]

Sais tu comment on peut forcer la mise à jour d'un objet ole ? 

 

J'ai un peu cherché, mais je n'ai rien trouvé, comme tu le dis, l'automatisation de la mise à jour n'est effective qu'à la réouverture du dessin.

[mimiingerop]

Eh bien ce n'est pas grave, avec la commande revert je peux faire un aller retour qui force cette remise à jour.

Encore merci pour ton aide, efficace et rapide. C'est vraiment agréable quand on a un problème de trouver si rapidement une solution !

Bonne fin de week-end ...Je vais voir le match.

:o