TotalArea & TotalPerim, nouvelles versions

(gile) · le 8 juillet 2009

Salut,

En téléchargement sur cette page, les versions 4.02 de TotalArea et TotalPerim.

TotalArea et TotalPerim ouvrent une boite de dialogue dans laquelle on peut spécifier : les valeurs des attibuts "LABEL" et "UNITS", le calque et l'échelle d'insertion du bloc.

On peut aussi accéder aux variables AREAPREC et ARERACONV ainsi qu'à l'aide.

http://img31.imageshack.us/img31/2479/totalarea.png

Plutôt que de singer le comportement des champs dynamiques (comme les versions précédentes), la mise à jour des attributs AREA et NOBJ est automatique et immédiate.

lili2006 · le 8 juillet 2009

Bonjour à toutes et tous,

Salut Gilles,

Je n'arrive pas à faire fonctionner cette dernière version,

Lorsque je lance "AREABOX", j'ai toujours l'ancienne BD =>

http://free0.hiboox.com/images/2809/444b845f7309c420a17bf2aa1e8bca74.jpg

Sur mon acadoc.lsp => Rien à changer de ce coté là je suppose ?

(load "TotalArea")
(load "TotalPerim")

Pour TotalPerim =>

http://free0.hiboox.com/images/2809/c1ede3cabbac38c8cc61c3f024b71875.jpg

Pas de modif non plus, pourtant j'ai supprimé l'ancienne version et rouvert une session AutoCAD,

Merci d'avance,

lili2006 · le 8 juillet 2009

Re,

C'est bon,!

Désolé pour le dérangement,..

Je lançais par =>

"AREABOX & PERIMBOX", forcément,...

super cette new version, je vais tester de suite !! :P

Merci encore Gilles,

(gile) · le 8 juillet 2009

Salut,

À voir les boites de dialogue, tu as bien la dernière version (il n'y a plus les commandes AREAUPD et PERIMUPD devenues inutiles).

C'est en lançant TOTALAREA et TOTLAPERIM que tu verras la différence, ainsi qu'en modifiant les objets liés (la mise à jour des attributs est immédiate).

EDIT : trop tard...

lili2006 · le 8 juillet 2009

Re,

(la mise à jour des attributs est immédiate).

Balaise ! :o

Marche super bien,

Encore un grand merci de ce partage.

Ces routines sont super utiles et vraiment très performante,.. :D

lili2006 · le 8 juillet 2009

Re,

Ah, je pense qu'il y a un petit bug sur l'appel de l'aide de TotalPerim =>

http://free0.hiboox.com/images/2809/190c1c7b93d5aee7966a89975df8aff7.jpg

Est-ce liée à la faute de frappe "TotalPeerim" ???

(gile) · le 8 juillet 2009

Exact, merci pour le retour.

Je vais corriger le fichier en téléchargement.

Sinon, tu peux ouvrir TotalParim.lsp dans l'éditeur Visual LISP (ou dans le bloc notes), et vers la fin de la routine "TotalPerimBox" (la deuxième dans le fichier) tu remplaces :

((= what_next 5) (help "TotalPeerim"))

par

((= what_next 5) (help "TotalPerim"))

lili2006 · le 8 juillet 2009

Re,

Modif du lisp,

Tout semble fonctionner à présent,... :P

Cyrchap · le 8 juillet 2009

Salut,

effectivement ça fonctionne, mais j'ai une remarque.

La surface totale est l'addition bete et mechante de toutes les surfaces des contours (avec toutes les décimalees, ce qui sert de controle ok) mais il serait sympa d'avoir la possibilité d'avoir le total des surfaces arrondi une à une.

Un exemple j'ai 2 contours

un de 244.235 m² et l'autre de 515.265 m² le total brut donne 759.50 si l'on met la variable aeraprec à 0 l'affichage du résultat donne 760 m² alors que l'addition des 2 contours arrondi donne 244 + 515 soit 759 m².

Pour ceux qui travaillent dans le foncier on est toujours au m².

Alors on a des programmes super, mais au final il faut toujours se taper une super addition à la main avec les valeurs arrondi pour avoir un résultat juste!

Rajouter une coche pour spécifier de quelle maniere on veut le resultat serait bien non ??

Merci d'avance

Bred · le 8 juillet 2009

Salut,

Peut-être je me trompe, mais

si tu travails dans le foncier tu ne dois pas avoir l'utilité d'un tel outils.

La commande _MEASUREGEOM avec option AIre, puis Objet et Addition devrais te suffire.

Non ?

(gile) · le 8 juillet 2009

Cyrchap,

au final il faut toujours se taper une super addition à la main avec les valeurs arrondi pour avoir un [surligneur]résultat juste![/surligneur]

Non, pour avoir un résultat correspondant à l'affichage !

Arrondir après avoir fait la somme donnera toujours un résultat plus précis (à défaut d'être juste).

Comme je ne suis pas convaincu que cette modification intéresse beaucoup de monde (dites moi si je trompe) et qu'ajouter une case à cocher pour laisser le choix entre un calcul "bête et méchant" et un calcul "plus intelligent" (parce que moins précis) demanderait un petit travail non négligeable (il faudrait aussi refaire les fichiers d'aide), je te propose de remplacer dans le code les routines "TOTALAREA" et "gc:TotalAreaUpd" par celles-ci :

;;; TOTALAREA (gile)
;;; Insère le bloc "TotalArea" dont la valeur de l'attribut "AREA" est égale à
;;; l'aire totale des objets sélectionnés

(defun c:TotalArea (/ *error* space dz bloc tot ss lst ins scl blk)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\Erreur: " msg))
   )
   (setvar "DIMZIN" dz)
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 (setq	Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
dz    (getvar "DIMZIN")
 )
 (if (or
(gc:GetItem
  (vla-get-Blocks *acdoc*)
  (setq bloc "TotalArea")
)
(findfile (setq bloc "TotalArea.dwg"))
     )
   (if	(setq data (TotalAreaBox))
     (if
(ssget
  '((-4 . "	    (0 . "ARC,CIRCLE,ELLIPSE,LWPOLYLINE,HATCH,MPOLYGON,REGION")
    (-4 . "	    (0 . "POLYLINE")
    (-4 . "	    (-4 . "&")
    (70 . 120)
    (-4 . "NOT>")
    (-4 . "AND>")
    (-4 . "	    (0 . "SPLINE")
    (-4 . "&")
    (70 . 8)
    (-4 . "AND>")
    (-4 . "OR>")
   )
)
 (progn
   (setq tot 0.0)
   (vla-StartUndoMark *acdoc*)
   (vlax-for obj (setq ss (vla-get-ActiveSelectionset *acdoc*))
     (setq tot (+ tot
		  (atof	(rtos (/ (vla-get-Area obj)
				 (distof (getenv "AreaConv"))
			      )
			      2
			      (atoi (getenv "AreaPrec"))
			)
		  )
	       )
	   lst (cons obj lst)
     )
   )
   (vla-delete ss)
   (initget 1)
   (setq ins (getpoint "\nSpécifiez le point d'insertion: ")
	 scl (caddr data)
	 blk
	     (vla-insertBlock
	       Space
	       (vlax-3d-point (trans ins 1 0))
	       bloc
	       scl
	       scl
	       scl
	       0.0
	     )
   )
   (vla-put-layer blk (cadddr data))
   (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8))
   (foreach att	(vlax-invoke blk 'GetAttributes)
     (cond
       ((= (vla-get-TagString att) "LABEL")
	(vla-put-TextString att (car data))
       )
       ((= (vla-get-TagString att) "UNIT")
	(vla-put-TextString att (cadr data))
       )
       ((= (vla-get-TagString att) "AREA")
	(vla-put-Textstring
	  att
	  (rtos	tot 2 (atoi (getenv "AreaPrec")))
	)
       )
       ((= (vla-get-TagString att) "NOBJ")
	(vla-put-TextString att (itoa (length lst)))
       )
     )
   )

   (vlax-ldata-put
     blk
     "TotalArea"
     (mapcar 'vla-get-Handle lst)
   )
   (setvar "DIMZIN" dz)

   ;;------------------------------------------------------------------;;
   ;; Création des réacteurs
   (foreach obj	lst
     (vlr-object-reactor
       (list obj)
       (vla-get-Handle blk)
       '((:vlr-erased . GC:AREAOBJECTERASED)
	 (:vlr-unerased . GC:AREAOBJECTUNERASED)
	 (:vlr-objectClosed . GC:AREAOBJECTCLOSED)
	)
     )
   )
   ;;------------------------------------------------------------------;;

   (vla-EndUndoMark *acdoc*)
 )
     )
   )
   (princ "\nLe bloc \"TotalArea\" est introuvable.")
 )
 (princ)
)

;;; gc:TotalAreaUpd (gile)
;;; Mise à jour les attribus d'un bloc "TotalArea"

(defun gc:TotalAreaUpd (blk lst / *error* dz tot new)
 (vl-load-com)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\Erreur: " msg))
   )
   (setvar "DIMZIN" dz)
   (princ)
 )

 (setq dz (getvar "DIMZIN"))
 (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8))
 (if lst
   (progn
     (setq tot 0.0)
     (foreach obj lst
(if obj
  (setq	tot (+ tot
		  (atof	(rtos (/ (vla-get-Area obj)
				 (distof (getenv "AreaConv"))
			      )
			      2
			      (atoi (getenv "AreaPrec"))
			)
		  )
	       )
	new (cons (vla-get-Handle obj) new)
  )
)
     )
     (foreach att (vlax-invoke blk 'GetAttributes)
(cond
  ((= (vla-get-TagString att) "AREA")
   (vla-put-Textstring
     att
     (rtos tot 2 (atoi (getenv "AreaPrec")))
   )
  )
  ((= (vla-get-TagString att) "NOBJ")
   (vla-put-TextString att (itoa (length new)))
  )
)
     )
   )
   (foreach att (vlax-invoke blk 'GetAttributes)
     (cond
((= (vla-get-TagString att) "AREA")
 (vla-put-Textstring
   att
   (rtos 0.0 2 (atoi (getenv "AreaPrec")))
 )
)
((= (vla-get-TagString att) "NOBJ")
 (vla-put-TextString att "0")
)
     )
   )
 )
 (vlax-ldata-put blk "TotalArea" new)
 (setvar "DIMZIN" dz)
)

bonuscad · le 8 juillet 2009

Salut (gile)

J'ai essayé de modifier "un poil" ton TotalArea pour satisfaire le besoin foncier en "h a ca"

Ça à l'air de fonctionner, je te donne les quelques points que j'ai modifié.

Si ça peut te convenir, je te laisse le soin d'updater ton fichier.

Voici principalement ce que j'ai fait (ceci aux 2 endroits dans le code):

	(vla-put-Textstring
	  att
	  (if (eq (getenv "areaConv") "10101")
			(surf_cadastrale tot)
			(rtos	(/ tot (distof (getenv "areaConv")))
			2
			(atoi (getenv "AreaPrec"))
			)
		)
	)

Pour passer en hectare, j'ai établi que "areaConv" était fixé à "10101".

Bien sur dans ce cas il faut laissé les "unités" à blanc et considérer que l'unité utilisée dans le dessin est bien le mètre par défaut.

Rappel de la sous-routine surf_cadastrale (que tu peux réécrire si elle te semble pas bien adaptée)

(defun surf_cadastrale (xs / h a ca)
(cond
	((and xs (numberp xs))
		(setq
			h (fix (cvunit xs "mètre_carré" "hectare"))
			a (fix (cvunit xs "mètre_carré" "are"))
			ca (fix (cvunit xs "mètre_carré" "centare"))
		)
		(strcat
			(if (not (zerop h)) (strcat (itoa h) "h ") "")
			(if (not (zerop a)) (strcat (itoa (if (not (zerop h)) (- a (* h 100)) a)) "a ") "")
			(if (not (zerop ca)) (strcat (itoa (if (not (zerop a)) (- ca (* a 100)) ca)) "ca") "")
		)
	)
)
)

Voilà, c'est juste une suggestion.

(gile) · le 8 juillet 2009

Merci bonuscad, pour ceux que ça peut intéresser.

Je ne pense pas apporter ce genre d'ajout à TotalArea (du moins pour l'instant, plus tard peut-être...).

J'ai essayé de faire un quelque chose qui soit assez polyvalent sans être une "usine à gaz", je n'ai pas envie de rajouter des options pour répondre à des besoins trop spécifiques.

Libre à chacun d'adapter le LISP à ces besoins, bien sûr, et j'aiderais tant que faire se peut ceux qui voudraient s'y lancer.

bonuscad · le 8 juillet 2009

je n'ai pas envie de rajouter des options pour répondre à des besoins trop spécifiques.

C'est tout à fait ton droit ;)

Libre à chacun d'adapter le LISP à ces besoins

Tout à fait, je pense avoir donné l'essentiel pour le faire.

Entre temps, j'ai pensé à une coche dans la boite de dialogue qui désactiverais/griserais les unités et permettais aussi de garder le mode "areaConv".

Si ça intéresse quelqu'un, je regarderais peut être cela...

lili2006 · le 8 juillet 2009

Re,

Si ça intéresse quelqu'un, je regarderais peut être cela...

Ben c'est clair que pour des contenances cadastrales, pour nous autres topo, cela peut être plus que intéressant,...

(Je ne suis pas en train de dire que je te sollicite bonuscad, mais presque,... ;) :P )

(gile) · le 8 juillet 2009

Bon,

Comme je sais qu'il est difficile de reprendre le code d'un autre, que celui là est assez long et que je n'écris pas de manière très explicite, je donne ici une nouvelle version avec une case à cocher "Hectares / ares / centiares".

Astuce : pour convertir tous les attributs "AREA" du dessin d'un mode à l'autre, dans la boite de dialogue, cocher ou décocher la case "Hectares / ares / centiares" et actionner un des boutons AREACONV ou AREAPREC, entrer une valeur (qui peut être la valeur courant)e et quitter la boite de dialogue par annuler.

Je n'ai pas refais le fichier d'aide...

;| TOTALAREA version 4.04 (gile)
Définit les commandes AREABOX, TOTALAREA, AREAEDIT, AREASHOW
et les variables AREACONV, AREAPREC

Bloc "TotalArea"

Une définition bloc nommé "TotalArea" doit être présente dans le dessin ou sous
forme de fichier "TotalArea.dwg" dans un répertoire du chemin de recherche.

Ce bloc doit contenir au moins trois attributs ayant pour étiquettes "LABEL", "UNIT" et "AREA".
Ce dernier sera automatiquement renseigné avec la somme des aires des objets qui lui sont liés.
(arc, cercle, ellipse, polyligne, spline, hachure, region, mpolygon)

S1 le bloc contient un autre attribut ayant pour étiquette "NOBJ", celui sera aussi
automatiquement renseigné avec le nombre d'objets liés au bloc.

Format de l'affichage de l'attribut "AREA"

Le nombre de décimales affichées dépend de la valeur de la variable AREAPREC

Facteur de conversion

Il est possible d'affecter un facteur de conversion à la valeur de l'attribut.
Cette valeur est gérée avec une variable (AREACONV) qui peut être modifiée avec la
commande du même nom.

Dernière révision
Possibilité d'afficher l'aire en hectares, ares et centiares
|;

;;;===============================================;;;

(vl-load-com)
(or *acdoc*
   (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)

;;; AREABOX (gile)
;;; Boite de dialogue d'appel des commandes

(defun c:Areabox (/ tmp file what_next dcl_id result)
 (or (getenv "AreaConv") (setenv "AreaConv" "1"))
 (or (getenv "AreaPrec")
     (setenv "AreaPrec" (itoa (getvar "LUPREC")))
 )
 (setq	tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "AreaBox:dialog{label=\"Surfaces cumulées\";
   :boxed_column{label=\"Commandes\";:row{
   :button{label=\"TotalArea\";key=\"(c:totalarea)\";width=16;}
   spacer;:text{label=\"Insérer et lier\";width= 20;}}
   :row{
   :button{label=\"AreaEdit\";key=\"(c:areaedit)\";width=16;}
   spacer;:text{label=\"Modifier\";width= 20;}}
   :row{
   :button{label=\"AreaShow\";key=\"(c:areashow)\";width=16;}
   spacer;:text{label=\"Visualiser\";width= 20;}}}
   :boxed_column{label=\"Variables\";:row{
   :text{key=\"ConvValue\";width= 20;}
   :button{label=\"AreaConv\";key=\"areaconv\";width=16;}}
   :row{:text{key=\"PrecValue\";width= 20;}
   :button{label=\"AreaPrec\";key=\"areaprec\";width=16;}}}
   spacer;cancel_button;}"
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (setq what_next 2)
 (while (>= what_next 2)
   (if	(not (new_dialog "AreaBox" dcl_id))
     (exit)
   )
   (set_tile "ConvValue"
      (strcat "AREACONV = " (getenv "AreaConv"))
   )
   (set_tile "PrecValue"
      (strcat "AREAPREC = " (getenv "AreaPrec"))
   )
   (foreach k '("(c:totalarea)"
	 "(c:areaedit)"
	 "(c:areashow)"
	)
     (action_tile k "(setq result $key) (done_dialog)")
   )
   (action_tile "areaconv" "(done_dialog 3)")
   (action_tile "areaprec" "(done_dialog 4)")
   (action_tile "cancel" "(done_dialog 0)")
   (setq what_next (start_dialog))
   (cond
     ((= what_next 3) (c:areaconv))
     ((= what_next 4) (c:areaprec))
   )
 )
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (and result (eval (read result)))
 (princ)
)

;;;===============================================;;;

;; TotalAreaBox
;; Boite de dialgue de la commande TotalArea

(defun TotalAreaBox (/ lbl     unt     scl     are     lay     lst
	       tmp     file    what_next       dcl_id  data
	       result
	      )
 (or (getenv "AreaConv") (setenv "AreaConv" "1"))
 (or (getenv "AreaPrec")
     (setenv "AreaPrec" (itoa (getvar "LUPREC")))
 )
 (or (setq lbl (vlax-ldata-get "TotalArea" "lbl"))
     (setq lbl (vlax-ldata-put "TotalArea" "lbl" "Aire totale"))
 )
 (or (setq unt (vlax-ldata-get "TotalArea" "unt"))
     (setq unt (vlax-ldata-put "TotalArea" "unt" "m²"))
 )
 (or (setq scl (vlax-ldata-get "TotalArea" "scl"))
     (setq scl (vlax-ldata-put "TotalArea" "scl" 1))
 )
 (or (setq are (vlax-ldata-get "TotalArea" "are"))
     (setq are (vlax-ldata-put "TotalArea" "are" "0"))
 )
 (while (setq lay (tblnext "LAYER" (not lay)))
   (setq lst (cons (cdr (assoc 2 lay)) lst))
 )
 (setq lst (vl-sort lst '  (setq lay (getvar "CLAYER"))
 (setq	tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "AreaBox:dialog{label=\"TotalArea\";
   :boxed_column{label=\"Attributs\";
   :row{:text{label=\"Libellé\";}
   :edit_box{key=\"lbl\";width=24;}}
   :row{:text{label=\"Unités\";}
   :edit_box{key=\"unt\";fixed_width=true;}}}
   :boxed_column{label=\"Propriétés\";
   :row{:text{label=\"Echelle\";}
   :edit_box{key=\"scl\";fixed_width=true;}}
   :popup_list{label=\"Calque\";key=\"lay\";}}
   :boxed_column{label=\"Variables\";:row{
   :text{key=\"ConvValue\";width= 20;}
   :button{label=\"AreaConv\";key=\"areaconv\";width=16;}}
   :row{:text{key=\"PrecValue\";width= 20;}
   :button{label=\"AreaPrec\";key=\"areaprec\";width=16;}}}
   spacer;:toggle{label=\"Hectares / ares / centiares\";key=\"are\";}
   spacer;ok_cancel_help;}"
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (setq what_next 2)
 (while (>= what_next 2)
   (if	(not (new_dialog "AreaBox" dcl_id))
     (exit)
   )
   (start_list "lay")
   (mapcar 'add_list lst)
   (end_list)
   (set_tile "lbl" lbl)
   (set_tile "unt" unt)
   (set_tile "scl" (rtos scl))
   (set_tile "are" are)
   (set_tile "lay" (itoa (vl-position lay lst)))
   (set_tile "ConvValue"
      (strcat "AREACONV = " (getenv "AreaConv"))
   )
   (set_tile "PrecValue"
      (strcat "AREAPREC = " (getenv "AreaPrec"))
   )
   (mode_tile "unt" (atoi are))
   (action_tile "lbl" "(setq lbl $value)")
   (action_tile "unt" "(setq unt $value)")
   (action_tile
     "scl"
     "(if (	(setq scl (distof $value))
(progn (alert \"Nécessite une échelle valide.\")
  (setq scl (vlax-ldata-get \"TotalArea\" \"scl\"))
  (set_tile \"scl\" (rtos scl))
  (mode_tile \"scl\" 2)))"
   )
   (action_tile
     "are"
     "(setq are $value)
     (mode_tile \"unt\" (atoi are))
     (vlax-ldata-put \"TotalArea\" \"are\" are)"
   )
   (action_tile "lay" "(setq lay (nth (atoi $value) lst))")
   (action_tile "areaconv" "(done_dialog 3)")
   (action_tile "areaprec" "(done_dialog 4)")
   (action_tile "help" "(done_dialog 5)")
   (action_tile "cancel" "(done_dialog 0)")
   (action_tile
     "accept"
     "(setq result (list lbl unt scl lay are))
     (vlax-ldata-put \"TotalArea\" \"lbl\" lbl)
     (vlax-ldata-put \"TotalArea\" \"unt\" unt)
     (vlax-ldata-put \"TotalArea\" \"scl\" scl)
     (done_dialog 1)"
   )
   (setq what_next (start_dialog))
   (cond
     ((= what_next 3) (c:areaconv))
     ((= what_next 4) (c:areaprec))
     ((= what_next 5) (help "TotalArea"))
   )
 )
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 result
)

;;;===============================================;;;

;;; TOTALAREA (gile)
;;; Insère le bloc "TotalArea" dont la valeur de l'attribut "AREA" est égale à
;;; l'aire totale des objets sélectionnés

(defun c:TotalArea
      (/ *error* space dz bloc data tot are ss lst ins scl blk)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\Erreur: " msg))
   )
   (setvar "DIMZIN" dz)
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 (setq	Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
dz    (getvar "DIMZIN")
 )
 (if (or
(gc:GetItem
  (vla-get-Blocks *acdoc*)
  (setq bloc "TotalArea")
)
(findfile (setq bloc "TotalArea.dwg"))
     )
   (if	(setq data (TotalAreaBox))
     (if
(ssget
  '((-4 . "	    (0 . "ARC,CIRCLE,ELLIPSE,LWPOLYLINE,HATCH,MPOLYGON,REGION")
    (-4 . "	    (0 . "POLYLINE")
    (-4 . "	    (-4 . "&")
    (70 . 120)
    (-4 . "NOT>")
    (-4 . "AND>")
    (-4 . "	    (0 . "SPLINE")
    (-4 . "&")
    (70 . 8)
    (-4 . "AND>")
    (-4 . "OR>")
   )
)
 (progn
   (setq tot 0.0
	 are (last data)
   )
   (vla-StartUndoMark *acdoc*)
   (vlax-for obj (setq ss (vla-get-ActiveSelectionset *acdoc*))
     (setq tot (+ tot (vla-get-Area obj))
	   lst (cons obj lst)
     )
   )
   (vla-delete ss)
   (initget 1)
   (setq ins (getpoint "\nSpécifiez le point d'insertion: ")
	 scl (caddr data)
	 blk
	     (vla-insertBlock
	       Space
	       (vlax-3d-point (trans ins 1 0))
	       bloc
	       scl
	       scl
	       scl
	       0.0
	     )
   )
   (vla-put-layer blk (cadddr data))
   (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8))
   (foreach att	(vlax-invoke blk 'GetAttributes)
     (cond
       ((= (vla-get-TagString att) "LABEL")
	(vla-put-TextString att (car data))
       )
       ((= (vla-get-TagString att) "UNIT")
	(vla-put-TextString att
	  (if (= are "1")
	    ""
	    (cadr data))
	  )
       )
       ((= (vla-get-TagString att) "AREA")
	(vla-put-Textstring
	  att
	  (if (= are "1")
	    (gc:HectaresAresCentiares (/ tot (distof (getenv "areaConv"))))
	    (rtos (/ tot (distof (getenv "areaConv")))
		  2
		  (atoi (getenv "AreaPrec"))
	    )
	  )
	)
       )
       ((= (vla-get-TagString att) "NOBJ")
	(vla-put-TextString att (itoa (length lst)))
       )
     )
   )

   (vlax-ldata-put
     blk
     "TotalArea"
     (mapcar 'vla-get-Handle lst)
   )
   (setvar "DIMZIN" dz)

   ;;------------------------------------------------------------------;;
   ;; Création des réacteurs
   (foreach obj	lst
     (vlr-object-reactor
       (list obj)
       (vla-get-Handle blk)
       '((:vlr-erased . GC:AREAOBJECTERASED)
	 (:vlr-unerased . GC:AREAOBJECTUNERASED)
	 (:vlr-objectClosed . GC:AREAOBJECTCLOSED)
	)
     )
   )
   ;;------------------------------------------------------------------;;

   (vla-EndUndoMark *acdoc*)
 )
     )
   )
   (princ "\nLe bloc \"TotalArea\" est introuvable.")
 )
 (princ)
)

;;;===============================================;;;

;;; AREAEDIT (gile)
;;; Lie ou délie les objets sélectionnés au bloc "TotalArea"

(defun c:AreaEdit (/ *error* lst blk obj elst rea)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\Erreur: " msg))
   )
   (mapcar (function (lambda (x) (vla-highlight x :vlax-false)))
    lst
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 (sssetfirst nil nil)
 (if (setq lst (gc:AreaGet "\nSélectionnez le bloc à modifier: "))
   (progn
     (setq blk	(car lst)
    lst	(cadr lst)
     )
     (vla-StartUndoMark *acdoc*)
     (while (setq obj
	    (car
	      (entsel
		"\nSélectionnez un objet à ajouter ou supprimer: "
	      )
	    )
     )
(setq elst (entget obj))
(if (or
      (member (cdr (assoc 0 elst))
	      '("ARC"	      "CIRCLE"	    "ELLIPSE"
		"LWPOLYLINE"  "HATCH"	    "MPOLYGON"
		"REGION"
	       )
      )
      (and (= (cdr (assoc 0 elst)) "POLYLINE")
	   (zerop (logand 120 (cdr (assoc 70 elst))))
      )
      (and (= (cdr (assoc 0 elst)) "SPLINE")
	   (= 8 (logand 8 (cdr (assoc 70 elst))))
      )
    )
  (if (member (setq obj (vlax-ename->vla-object obj)) lst)
    (progn
      (setq lst (vl-remove obj lst))
      (vla-highlight obj :vlax-false)
      (if (setq rea (gc:GetAreaObjectReactor obj blk))
	(vlr-remove rea)
      )
    )
    (progn
      (setq lst (cons obj lst))
      (vla-highlight obj :vlax-true)
      (vlr-object-reactor
	(list obj)
	(vla-get-Handle blk)
	'((:vlr-erased . GC:AREAOBJECTERASED)
	  (:vlr-unerased . GC:AREAOBJECTUNERASED)
	  (:vlr-objectClosed . GC:AREAOBJECTCLOSED)
	 )
      )
    )
  )
)
(gc:TotalAreaUpd blk lst)
     )
     (mapcar (function (lambda (x) (vla-highlight x :vlax-false)))
      lst
     )
   )
   (vla-EndUndoMark *acdoc*)
 )
 (princ)
)

;;;===============================================;;;

;;; AREASHOW (gile)
;;; Met en surbrillance les objets liés au bloc sur lequel passe le curseur

(defun c:AreaShow (/ lst)
 (and (setq lst (gc:AreaGet ""))
      (mapcar (function (lambda (x) (vla-highlight x :vlax-false)))
       (cadr lst)
      )
 )
 (princ)
)

;;;===============================================;;;

;;; AREACONV (gile)
;;; Modifier la valeur de la variable AREACONV
;;; Cette variable, enregistrée dans la base de registre gère le facteur
;;; de conversion pour les unités de surface.
;;; exemple : 10000 pour cm² -> m², 1000000 (ou 1e6) pour m² -> km²

(defun c:AreaConv ()
 (or (getenv "AreaConv") (setenv "AreaConv" "1"))
 (while
   (not
     ((lambda (r)
 (or (= r "")
     (	 )
      )
(setq
  r (getstring
      (strcat "\nEntrez une nouvelle valeur pour AREACONV 		      (getenv "AreaConv")
	      ">: "
      )
    )
)
     )
   )
    (princ "\nNécessite un nombre strictement positif")
 )
 (or (= r "")
     (and (setenv "AreaConv" r) (gc:AreaUpdAll))
 )
 (princ)
)

;;;===============================================;;;

;;; AREAPREC (gile)
;;; Modifier la valeur de la variable AREAPREC
;;; Cette variable, enregistrée dans la base de registre, gère le nombre de
;;; décimales affichées.

(defun c:AreaPrec ()
 (or (getenv "AreaPrec")
     (setenv "AreaPrec" (itoa (getvar "LUPREC")))
 )
 (while
   (not
     ((lambda (r)
 (or (= r "")
     (and
       (= 'INT (type (read r)))
       (	     )
 )
      )
(setq
  r (getstring
      (strcat "\nEntrez une nouvelle valeur pour AREAPREC 		      (getenv "AreaPrec")
	      ">: "
      )
    )
)
     )
   )
    (princ "\nNécessite un nombre entier positif")
 )
 (or (= r "")
     (and (setenv "AreaPrec" r) (gc:AreaUpdAll))
 )
 (princ)
)

;;;===============================================;;;

;;; AreaHelp (gile)
;;; Ouvre l'aide

(defun c:areahelp ()
 (help "TotalArea")
 (princ)
)

(foreach cmd '("c:TotalArea" "c:AreaEdit" "c:AreaShow" "c:AreaConv"
       "c:AreaPrec")
 (setfunhelp cmd "TotalArea.chm")
)

;;;================== SOUS ROUTINES ==================;;;

;;; gc:TotalAreaUpd (gile)
;;; Mise à jour les attribus d'un bloc "TotalArea"

(defun gc:TotalAreaUpd (blk lst / *error* dz tot new)
 (vl-load-com)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\Erreur: " msg))
   )
   (setvar "DIMZIN" dz)
   (princ)
 )

 (setq dz (getvar "DIMZIN"))
 (setvar "DIMZIN" (Boole 2 (getvar "DIMZIN") 8))
 (if lst
   (progn
     (setq tot	0.0
    are	(vlax-ldata-get "TotalArea" "are")
     )
     (foreach obj lst
(if obj
  (setq	tot (+ tot (vla-get-Area obj))
	new (cons (vla-get-Handle obj) new)
  )
)
     )
     (foreach att (vlax-invoke blk 'GetAttributes)
(cond
  ((= (vla-get-TagString att) "UNIT")
   (vla-put-TextString
     att
     (if (= are "1")
       ""
       (vlax-ldata-get "TotalArea" "unt")
     )
   )
  )
  ((= (vla-get-TagString att) "AREA")
   (vla-put-Textstring
     att
     (if (= are "1")
       (gc:HectaresAresCentiares (/ tot (distof (getenv "areaConv"))))
       (rtos (/ tot (distof (getenv "areaConv")))
	     2
	     (atoi (getenv "AreaPrec"))
       )
     )
   )
  )
  ((= (vla-get-TagString att) "NOBJ")
   (vla-put-TextString att (itoa (length new)))
  )
)
     )
   )
   (foreach att (vlax-invoke blk 'GetAttributes)
     (cond
((= (vla-get-TagString att) "AREA")
 (vla-put-Textstring
   att
   (rtos 0.0 2 (atoi (getenv "AreaPrec")))
 )
)
((= (vla-get-TagString att) "NOBJ")
 (vla-put-TextString att "0")
)
     )
   )
 )
 (vlax-ldata-put blk "TotalArea" new)
 (setvar "DIMZIN" dz)
)

;;;===============================================;;;

;;; gc:AreaGet (gile)
;;; Retourne un liste contenant un bloc "TotalArea" et la liste des objets liés
;;; Les objets liés à un bloc sont mises en surbrillance quand le curseur est sur ce bloc

(defun gc:AreaGet (msg / *error* gr ent l1 blk obj l2)

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
   )
   (mapcar (function (lambda (x) (vla-highlight x :vlax-false)))
    l2
   )
   (princ)
 )

 (princ msg)
 (while (and (setq gr (grread T 4 2)) (= (car gr) 5))
   (if	(and (setq ent (nentselp (cadr gr)))
     (or
       (and
	 (caddr ent)
	 (setq ent (last (last ent)))
       )
       (setq ent (cdr (assoc 330 (entget (car ent)))))
     )
)
     (if (= (cdr (assoc 2 (entget ent))) "TotalArea")
(progn
  (setq	blk T
	l1  (vlax-ldata-get ent "TotalArea")
  )
  (foreach h l1
    (if	(setq obj (gc:HandleToObject h))
      (progn
	(vla-highlight obj :vlax-true)
	(or (member obj l2) (setq l2 (cons obj l2)))
      )
    )
  )
)
     )
     (progn
(mapcar	(function (lambda (x) (vla-highlight x :vlax-false)))
	l2
)
(setq l2  nil
      blk nil
)
     )
   )
 )
 (if (and (= (car gr) 3) blk)
   (list (vlax-ename->vla-object ent) l2)
   (mapcar (function (lambda (x) (vla-highlight x :vlax-false)))
    l2
   )
 )
)

;;;===============================================;;;

;;; gc:AreaUpdAll
;;; Met à jour tous les blocs "ToTalArea"

(defun gc:AreaUpdAll (/ ss)
 (if (ssget "_X" '((0 . "INSERT") (2 . "TotalArea")))
   (progn
     (vlax-for	blk (setq ss (vla-get-activeSelectionSet *acdoc*))
(gc:TotalAreaUpd
  blk
  (mapcar 'gc:HandleToObject
	  (vlax-ldata-get blk "TotalArea")
  )
)
     )
     (vla-delete ss)
   )
 )
)

;;;===============================================;;;

;;; gc:GetAreaObjectReactor
;;; Retourne le réacteur de l'objet lié au bloc
;;; Arguments
;;; obj : l'objet propriétaire (vla-object)
;;; blk : le bloc lié à l'objet (vla-object)
;;;
;;; Retour : le reacteur ou nil

(defun gc:GetAreaObjectReactor (obj blk / lst rea loop)
 (setq	lst  (cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
loop T
 )
 (while (and lst loop)
   (setq rea (car lst)
  lst (cdr lst)
   )
   (if	(and
  (equal (vlr-owners rea) (list obj))
  (= (vlr-data rea) (vla-get-Handle blk))
)
     (setq loop nil)
     (setq rea nil)
   )
 )
 rea
)

;;;===============================================;;;

;;; gc:GetItem (gile)
;;; Retourne le vla-object de l'item s'il est présent dans la collection
;;;
;;; Arguments
;;; col : la collection (vla-object)
;;; name : le nom de l'objet (string) ou son indice (entier)
;;;
;;; Retour : le vla-object ou nil

(defun gc:GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-item col name))))
 )
 obj
)

;;;===============================================;;;

;;; gc:HandleToObject (gile)
;;; Retourne le VLA-OBJECT d'après son handle
;;; Argument
;;; handle : le handle de l'objet
;;;
;;; Retour : le vla-object ou nil

(defun gc:HandleToObject (handle / obj)
 (vl-catch-all-apply
   (function
     (lambda ()
(setq obj (vla-HandleToObject
	    (vla-get-ActiveDocument (vlax-get-acad-object))
	    handle
	  )
)
     )
   )
 )
 obj
)

;;;===============================================;;;

;; gc:HectaresAresCentiares (gile)
;; Convertit une aire en m² en hectares / ares / centiares

(defun gc:HectaresAresCentiares (s / h a c)
 (setq	s (atoi (rtos s 2 0))
h (/ s 10000)
a (/ (rem s 10000) 100)
c (rem s 100)
 )
 (if (zerop h)
   (if	(zerop a)
     (strcat (itoa c) "ca")
     (strcat (itoa a) "a " (itoa c) "ca")
   )
   (strcat (itoa h) "ha " (itoa a) "a " (itoa c) "ca")
 )
)

;;;================== RETRO APPELS ==================;;;

(defun GC:AREAOBJECTERASED (own rea lst)
 (vlr-remove rea)
)

;;;===============================================;;;

(defun GC:AREAOBJECTUNERASED (own rea lst / blk)
 (if (setq blk (gc:HandleToObject (vlr-data rea)))
   (vlr-add rea)
   (vlr-remove rea)
 )
)

;;;===============================================;;;

(defun GC:AREAOBJECTCLOSED (own rea lst / blk data)
 (if (setq blk (gc:HandleToObject (vlr-data rea)))
   (if	(setq data (vlax-ldata-get blk "TotalArea"))
     (gc:TotalAreaUpd blk (mapcar 'gc:HandleToObject data))
   )
   (vlr-remove rea)
 )
)

;;;==================== CREATION DES REACTEURS AU CHARGEMENT ====================;;;

((lambda (/ ss obj)
  (foreach r (cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
    (if (member '(:VLR-erased . GC:AREAOBJECTERASED)
	 (vlr-reactions r)
 )
      (vlr-remove r)
    )
  )
  (if (ssget "_X" '((0 . "INSERT") (2 . "TotalArea")))
    (progn
      (vlax-for blk (setq ss (vla-get-ActiveSelectionSet *acdoc*))
 (foreach hand (vlax-ldata-get blk "TotalArea")
   (if (setq obj (gc:HandleToObject hand))
     (vlr-object-reactor
       (list obj)
       (vla-get-Handle blk)
       '((:vlr-erased . GC:AREAOBJECTERASED)
	 (:vlr-unerased . GC:AREAOBJECTUNERASED)
	 (:vlr-objectClosed . GC:AREAOBJECTCLOSED)
	)
     )
   )
 )
      )
      (vla-delete ss)
    )
  )
)
)

(princ)

lili2006 · le 8 juillet 2009

Re,

Que dire,...

Encore un grand merci,.. :D

Mais je crois que je m'y prend mal pour la conversion,...

(gile) · le 9 juillet 2009

Salut,

Il faut entrer une valeur, pas seulement valider celle par défaut.

lili2006 · le 9 juillet 2009

Bonjour à toutes et tous,

Oui, ça ça marche mais j'avais, il me semble, mal interprété cette remarque =>

entrer une valeur (qui peut être la valeur courant)

En effet, si je retape "areaprec" = 2 dans mon cas (valeur courante), ça marche super !! :D

Merci encore, cette routine reste polyvalente (ou plutôt l'est de plus en plus,...)

Et merci à bonuscad

jfds · le 6 août 2009

Je débute avec les routines et je trouve total area et total perim tres bien faites.

J'aimerai simplement réunir les deux en unes. Pour avoir sur une pièces son nom le nombre la surface et le périmètre. Mais j'ai besoin d'un peu d'aide merci.

(gile) · le 6 août 2009

Salut,

Ces LISP sont assez longs et pas vraiment d'un niveau débutant (vlisp, grread, dxf "à la volée", réacteurs...).

S'ils se ressemblent beaucoup par certains côtés, réunir les 2 en un seul n'est pas si simple.

De plus je ne peux pas me permettre aujourd'hui de les retoucher gracieusement, ils sont donnés "en l'état", libre à chacun de les modifier.

Si tu n'ajoutes pas les aires et périmètres de plusieurs pièces, tu peux voir Pline_Block sur cette page.

le 10 mars 2011

J'ai chargé le lisp, il est terrible sauf que quand j'utilise areashow et areaedit ça ne fonctionne pas? Que dois-je faire? Quelqu'un à t-il eu le même problème que moi?

(gile) · le 10 mars 2011

Salut et bienvenue,

Qu'est-ce qui "ne fonctionne pas" ?

Ce que c'est censé faire :

AREASHOW met en surbrillance les objets liés à un bloc "TotalArea" quand le curseur est positionné sur ce bloc.

AREAEDIT fait la même chose que AREASHOW, mais si on clique sur le bloc on peut ensuite ajouter ou supprimer des liaisons d'objets avec ce bloc.

le 10 mars 2011

salut gile,

J'ai réessayé avec la commande areashow:

je tape la commande et je valide. Je mets comme tu m'as dit le curseur dessus et rien ne se passe, je n'ai pas de surbrillance. Pour la commande areaedit quand je la valide il me demande bien de choisir le bloc à modifier et quand je clic sur le bloc je bascule directement sur la saisie de la commande.

J'ai associé à la création du bloc totalarea une définition de bloc dynamique, est-ce-que c'est ça qui pertube le programme?

le 10 mars 2011

C'est bon j'ai trouvé c'est le bloc dynamique qui fait que les deux commande ne fonctionne pas. Mon bloc dynamique est composé de tes attributs, d'un rectangle englobant label et area, de 4 gros triangle servant à matérialiser la porte d'accès d'un appartement et avec la fonction visibilité dynamique ça me permettais de choisir la quelle des 4 flèches je voulais. Donc si vous avez une solution je suis preneur. Merci d'avance.

TotalArea & TotalPerim, nouvelles versions

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Invité davidly

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Invité davidly

Lien vers le commentaire

Partager sur d’autres sites

Invité davidly

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante