TotalArea & TotalPerim, nouvelles versions

[pierrevigneux]

Bonsoir Gile

 

Total Area est super, ta nouvelle version.

 

Question comme je travaille souvent en système anglais, serait-il possible de changer\ou ajouter les surfaces en acre et pieds carrés ?

 

Amicalement !

[(gile)]

Salut,

 

Dans la version ci-dessous, j'ai remplacé 'hectares / ares / centiares' par 'acres / square feet'.

Si tu travailles en pieds, il faut mettre AREACONV à 1, si tu travailles en mètres, il faut mettre AREACONV à 0.092903.

 

;| TOTALAREA version 4.05 (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)

Si 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 acres et square feet
|;

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

(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     acre     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 acre (vlax-ldata-get "TotalArea" "acre"))
     (setq acre (vlax-ldata-put "TotalArea" "acre" "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= 24;}
   :button{label=\"AreaConv\";key=\"areaconv\";width=16;}}
   :row{:text{key=\"PrecValue\";width= 24;}
   :button{label=\"AreaPrec\";key=\"areaprec\";width=16;}}}
   spacer;:toggle{label=\"Acres / Square Feet\";key=\"acre\";}
   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 "acre" acre)
   (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 acre))
   (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
     "acre"
     "(setq acre $value)
     (mode_tile \"unt\" (atoi acre))
     (vlax-ldata-put \"TotalArea\" \"acre\" acre)"
   )
   (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 acre))
     (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 acre 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
	 acre (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 (= acre "1")
	    ""
	    (cadr data))
	  )
       )
       ((= (vla-get-TagString att) "AREA")
	(vla-put-Textstring
	  att
	  (if (= acre "1")
	    (gc:AcresSquareFeet (/ 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
    acre	(vlax-ldata-get "TotalArea" "acre")
     )
     (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 (= acre "1")
       ""
       (vlax-ldata-get "TotalArea" "unt")
     )
   )
  )
  ((= (vla-get-TagString att) "AREA")
   (vla-put-Textstring
     att
     (if (= acre "1")
       (gc:AcresSquareFeet (/ 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
)

;;;===============================================;;;
[surligneur]
;; gc:AcresSquareFeet (gile)
;; Convertit une aire en sq ft en acre.
;; Affiche : valeur_en_acres / valeur_en_square_feet

(defun gc:AcresSquareFeet (s)
 (strcat
   (rtos (/ s 43560.1734) 2 2)
   " acres "
   (rtos s 2 0)
   " sq ft"
 )
)
[/surligneur]
;;;================== 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)

[pierrevigneux]

Merci Beaucoup gile

 

Juste un petit problème.

 

error: malformed list on input

 

Peut-être le smiles :o lorsque l'on copie le lisp.

 

En effet le smile cachait la fermeture de la parenthèse.

 

Encore un gros merci de ton attention !

 

[Edité le 11/3/2011 par pierrevigneux]

[pierrevigneux]

Bonsoir gile

 

J,ai testé Totalarea en acre, la réponse en acre est correct, j'aurais aimé avoir les centièmes, cad 2 chiffres après le point.

 

L'équivalence en sqft ne fonctionne pas bien n'est pa exact.

J'ai essayé ede3 corriger et je n'y arrive pas.

 

Merci encore!

[(gile)]

Re,

 

Je crains d'avoir du mal à te comprendre.

 

Avec routine ci-dessus, quand la case "Acres" est cochée, le résultat est donné en acres et square feet.

 

Exemple avec carré de 100 de côté, l'unité de travail étant le mètre :

AREACONV = 1, AREAPREC = 2, "Unités" = m², "Acres" = pas coché => 10000.00m²

 

Conversion en square feet :

AREACONV = 0.092903, AREAPREC = 0, "Unités" = sqft, "Acres" = pas coché => 107639sqft

 

Pour avoir le résultat en acres décimaux, il suffit de changer AREACONV (1acre = 4046.85468m²) sans cocher la case 'Acre' :

AREACONV = 4046.85468, AREAPREC = 2, "Unités" = acres, "Acres" = pas coché => 2.47acres

 

En cochant la case "Acres" :

AREACONV = 0.092903 AREAPREC = 0 "Unités" = 'grisé', "Acres" = coché => 2acres 20519sqft

Soit le résultat entier de 107639 / 43560 et le reste de cette division.

[pierrevigneux]

Bonjour gile

 

J'ai dessiné un carré de 4047.5 en mètre et j'ai coché la case acre, la réponse fut 1 acre 7 sqft la réponse est censé donner 1 acre 0 sqft.

 

Peut-être là cause de la précision de la division devra être 43560.1734 sqft.

 

Mais de toute façon pour ma part j'aurais aimé avoir comme réponse 1,0 acre /43560.17 sqft

 

Amicalement !

[(gile)]

Re,

 

Je n'avais jamais encore vu 1 acre = 43560.1734 sqft, dans tout ce que j'ai lu, une acre vaut 66 ft X 660 ft = 43560 sqft. Mais si tu veux ce rapport, pas de problème.

 

Quant au format de la chaîne retourné, si j'ai (finalement) bien compris, tu veux :

" acres / sqft"

 

Merci de me répondre précisément, pour éviter d'autres tâtonnements.

[pierrevigneux]

Merci de ton attention gile

 

Mais si tu veux ce rapport, pas de problème.

 

 

Oui merci !

 

Quant au format de la chaîne retourné, si j'ai (finalement) bien compris, tu veux :

" acres / sqft"

 

C'est bien ça la réponse en acre avec décimale et l'équivalent en pieds carrés.

Soit avec le facteur de 0.09290304

 

@+

[(gile)]

J'ai modifié la routine (réponse 26 page 1).

 

J'ai surligné la routine où est faite la conversion si tu voulais la modifier.

 

L'argument 's' contient la valeur de l'aire (en square feet).

 

L'expression : (rtos (/ s 43560.1734) 2 2) divise la valeur par 43560.1734 et convertit le résultat en chaîne de caractère. Le dernier 2 correspond au nombre de décimales affichées.

 

L'expression : (rtos s 2 0) convertit la valeur en chaîne, ici 0 décimales affichées.

 

Le facteur de 0.09290304 correspond à la conversion m² -> sq ft, c'est la valeur à mettre dans AREACONV si tu travailles en mètres.

 

Si tu veux que conversion m² -> sq ft soit faite automatiquement (en laissant AREACONV à 1),

il faut remplacer le code surligné par :

;; gc:AcresSquareFeet (gile)
;; Convertit une aire en m² en acre et sq ft.
;; Affiche : valeur_en_acres / valeur_en_square_feet

(defun gc:AcresSquareFeet (s)
 (setq s (/ s 0.09290304))
 (strcat
   (rtos (/ s 43560.1734) 2 2)
   " acres "
   (rtos s 2 0)
   " sq ft"
 )
)

[pierrevigneux]

Un grand merci gile

 

La modification me conveint parfaitement, une autre commande qui sera très utile pour moi.

 

Amicalement !

[Invité davidly]

Bonjour gile,

Dans ton lisp, on peut soit ajouter des surfaces ou soit les enlever. Est-il possible de rajouter dans ton lisp totalarea la fonction de soustraire, tu sais comme la commande aire. Dans ton lisp, on peut soit ajouter des surfaces ou soit les enlever mais pas les déduire. Merci pour ta réponse, j'ai essayé de me pancher sur la façon de faire des lisp mais ça m'a l'air un peu chaud pour le moment même si je connais bien autocad.

[pierrevigneux]

Bonsoir !

 

Autre petit problème,

 

Dans la commande Total Area, je me sert de l'attribut nobj pour faire la numérotation de mes lots.

 

Je veux les mettres à jour c.a.d. soit changer les paramètres de TotalArea et surprise, ma numérotation tombe automatiquement à (1) et je dois toujour la refaire.

 

Un truc quelconque pour y remédier!

 

Merci !

[(gile)]

davidly,

 

La commande AREAEDIT permet d'ajouter ou de supprimer des entités liées au bloc : tu lances la commande, tu sélectionnes le bloc, les entités liées au blocs se mettent en surbrillance.

Cliquer sur une entité en surbrillance la supprime du jeu d'entités liées, cliquer sur une entité qui n'est pas en surbrillance l'ajoute au jeu, le résultat est immédiatement mis à jour.

 

 

pierrevigneux,

 

L'attribut NOBJ est aussi un attribut dynamique qui se met automatiquement à jour avec le nombre d'entités liées au bloc.

 

Tu peux modifier le bloc "TotalArea" à ta guise (en conservant les attributs AREA, UNITS et LABEL qui sont renseignés dans la boite de dialogue) et lui rajouter un attribut pour tes numéros de lots.

 

Tu peux supprimer l'attribut NOBJ la routine est prévue pour fonctionner avec ou sans ou le mettre "Invisible" pour ne l'afficher ne l'afficher qu'en mettant la variable ATTMODE à 2

[pierrevigneux]

Merci gile

 

Je crois que je vais incrémenter une valeur sans attribut, c'est plus simple je crois.

 

Merci pour ta précision!

 

[Edité le 15/3/2011 par pierrevigneux]

[(gile)]

Je crois que je vais incrémenter une valeur sans attribut, c'est plus simple je crois.

 

Je ne vois pas ce qu'il a de compliqué, tu peux même tout simplement changer l'étiquette de l'attribut NOBJ en NUM.

[flobonhomme]

Bonjour,

 

J'utilise TotalArea pour des surfaces de pièce et d'appartement jusqu'ici pas de problème ....

 

Je viens de découvrir l'utilisation de table de bloc et m'en sert pour la désignation de chaque pièce,

en gros c'est un menu déroulant sur l'attribut d'un bloc qui me permet d'en changer la valeur.

 

Du coup je me dis nickel, j'instaure une table de bloc au TotalArea et me voila avec le maxi bloc archi.

 

Mais le soucis c'est que dans cette config, autocad après la fermeture du fichier, perd tout les liens entre les polylignes et les attributs area, alors qu'auparavant ce ne n'était pas le cas.

 

Ai'je fait une mauvaise manip ou est ce normale ?

 

Merci @+

[(gile)]

Salut,

 

C'est normal, TotalArea (commeTotalPerim) n'était pas prévu pour fonctionner avec des blocs dynamiques.

 

La nouvelle version (4.03) en téléchargement sur cette page fonctionne désormais avec les blocs dynamiques, dont ceux utilisant une table de bloc.

[flobonhomme]

Bonjour,

 

Dans le Zip de téléchargement le fichier Txt indique la version 4.02.

J'ai quand même remplacer, et recharger le nouveau lisp, modifié le bloc en y ajoutant juste un attribut "Designation" lié a la table de bloc.

Et je suis toujours dans la même situation, à savoir, lors de la réouverture du fichier les blocs ne sont plus liés aux polylignes.

 

Je dois faire une boulette quelque pars ....

 

merci @+

[lecrabe]

 

Hello

 

Je ne suis pas sur que la version en telechargement possible soit bien la v4.03 !?

ou autre Version qui supporte bien les blocs dynamiques ...

 

Seul Gilles peut nous le confirmer !

 

GeoBye, Pat

 

[(gile)]

Salut,

 

J'ai oublié de mettre à jour le fichier .txt, mais pour t'assurer d'avoir la bonne version, tu peux ouvrir le LISP avec le bloc notes, le numéro de version apparaît dans l'en-tête. Si ce n'est pas 4.03, nettoie le cache de ton navigateur avant de refaire le téléchargement.

[(gile)]

J'ai corrigé le fichier .txt dans les nouvelles versions en téléchargment sur cette page.

[flobonhomme]

Re

 

Désolé j'étais en train de faire des tests.

 

Bon effectivement j'étais en 4.02

Je viens de refaire la manip.

Sur la précédente version 4.02 après avoir modifie le bloc: ajout de la table de bloc:

 

1- je l’insère tel quel (en laissant le paramètre de la table par défaut).

2- je l’insère en changeant dans la liste déroulante.

 

à la réouverture:

- 1 pas de soucis le lien est en place

- 2 le lien se brisait.

 

Je réalise la même manip avec la version 4.03, et là, aucun des liens ne se conservent....

 

Je ne comprends pas .... :D

 

merci

 

[(gile)]

Re,

 

Ce que tu décris est cohérent avec la version 4.02.

 

Petite explication technique :

Quand on modifie les propriétés dynamiques d'un bloc, AutoCAD crée automatiquement une nouvelle définition de bloc anonyme (*U5 par exemple).

À l'ouverture, le programme recrée les "liens" (réacteurs) entre les blocs TotalArea et les entités. Avec la versions 4.02, le programme ne recherchait que les blocs nommés "TotalArea", ce qui explique que ça fonctionne avec un bloc dynamique dont les propriétés n'ont pas été modifiées. Pour recréer les" liens", la version 4.03 recherche tous les blocs nommés "TotalArea" ainsi que les blocs anonymes issus de "TotalArea", ce qui fait que, du moins chez moi, ça fonctionne avec un bloc "TotalArea" dynamique.

 

J'ai fait des tests en redéfinissant dans un dessin le bloc "TotalArea" fourni dans le ZIP pour lui ajouter une table de propriété de bloc sur l'attribut LABEL, enregistré et fermé le dessin, à la réouverture les "liens" fonctionnent.

J'ai aussi enregistré le bloc ainsi modifié (WBLOC) dans un répertoire des chemins de recherche et utilisé ce bloc dans un nouveau dessin, la encore, tout fonctionne.

[(gile)]

Oupss !!!...

 

Au temps pour moi, je me suis trompé dans les versions mises en téléchargement. Nouvelles version : 4.04.

[flobonhomme]

Youhoooooooooooooooo !!!!!

 

Je viens juste de voir ton message, et je commençais a penser que j'étais vraiment mauvais ....(même si il y'a un peu de ça) ;)

 

ça y est ça fonction nickel.

 

Un grand merci Gile pour ton aide active et tes contributions.

 

@+