Calcul surface

[fauxsuisse]

Bonjour tout le monde.

 

Voilà je re-solicite les grands cerveaux :)

 

Patrick_35 avait fait un lisp "REA" qui permettait d'associer une polyligne à un texte qui affichera la surface de ce pourtour en polyligne ce qui fonctionne très bien et très utile car quand on modifie la polyligne les valeurs changent automatiquement, seulement le texte est toujours affiché en mm2, serait'il possible de pouvoir l'avoir en m2 ou même de pouvoir choisir l'unité d'affichage.

 

le lisp était le suivant :

 

;;;=================================================================
;;;
;;; REA.LSP V1.01
;;;
;;; Associer un texte à une poly fermée
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun modif_poly (obj rea arg-list)
 (if (and (vlax-read-enabled-p obj)
   (vlax-read-enabled-p (vlr-data rea))
     )
				;; (vla-put-textstring (vlr-data rea) (rtos (vla-get-area obj)))
   (vla-put-textstring
     (vlr-data rea)
     (strcat (rtos (vla-get-area obj) 2 2) " mm2")
   )
   (vlr-remove rea)
 )
)

(defun effacer_pt (obj rea arg-list)
 (vlax-ldata-delete obj "Patrick_35" (vlr-data rea))
 (vlax-ldata-delete (vlr-data rea) "Patrick_35" obj)
 (vlr-remove rea)
)

(defun c:rea (/ n sel_poly sel_text)
 (while (not sel_poly)
   (setq sel_poly (car (entsel "\nSélection de la polyligne : ")))
   (if	sel_poly
     (if (or (= (cdr (assoc 0 (entget sel_poly))) "POLYLINE")
      (= (cdr (assoc 0 (entget sel_poly))) "LWPOLYLINE")
      (= (cdr (assoc 0 (entget sel_poly))) "SPLINE")
  )
(progn
  (setq sel_poly (vlax-ename->vla-object sel_poly))
  (if (= :vlax-false (vla-get-closed sel_poly))
    (progn
      (alert "Cette Polyligne/Spline n'est pas fermée")
      (setq sel_poly nil)
    )
  )
  (if sel_poly
    (if	(vlax-ldata-get sel_poly "Patrick_35")
      (progn
	(alert "Polyligne/Spline déjà associé à un texte")
	(setq sel_poly nil)
      )
    )
  )
)
(progn
  (alert "Ce n'est pas une Polyligne/Spline")
  (setq sel_poly nil)
)
     )
   )
 )
 (if sel_poly
   (progn
     (vla-highlight sel_poly :vlax-true)
     (while (not sel_text)
(setq sel_text (car (entsel "\nSélection du texte : ")))
(if sel_text
  (if (or (= (cdr (assoc 0 (entget sel_text))) "TEXT")
	  (= (cdr (assoc 0 (entget sel_text))) "MTEXT")
      )
    (progn
      (setq sel_text (vlax-ename->vla-object sel_text))
      (if (vlax-ldata-get sel_text "Patrick_35")
	(progn
	  (alert "Texte déjà associé à une Polyligne/Spline")
	  (setq sel_text nil)
	)
      )
    )
    (progn
      (setq sel_text nil)
      (alert "Ce n'est pas un texte")
    )
  )
)
     )
     (if sel_text
(progn
  (vla-highlight sel_poly :vlax-false)
  (vla-put-textstring sel_text (rtos (vla-get-area sel_poly)))
  (vlr-pers
    (vlr-object-reactor
      (list sel_poly)
      sel_text
      '((:vlr-modified . modif_poly) (:vlr-erased . effacer_pt))
    )
  )
  (vlr-pers (vlr-object-reactor
	      (list sel_text)
	      sel_poly
	      '((:vlr-erased . effacer_pt))
	    )
  )
  (vlax-ldata-put sel_poly "Patrick_35" sel_text)
  (vlax-ldata-put sel_text "Patrick_35" sel_poly)
)
     )
   )
 )
 (princ)
)

(defun refaire_reacteurs (/ entp entt)
 (vl-load-com)
 (if (not appli_patrick_35)
   (progn
     (setq appli_patrick_35
     (ssget "x"
	    (list (cons 102 "{ACAD_XDICTIONARY"))
     )
     )
     (if appli_patrick_35
(progn
  (setq n 0)
  (while (setq entp (ssname appli_patrick_35 n))
    (setq entp (vlax-ename->vla-object entp))
    (if	(setq entt (vlax-ldata-get entp "Patrick_35"))
      (progn
	(vla-put-textstring
	  entt
	  (strcat (rtos (/ (vla-get-area entp) 10000) 2 2)
		  " mm2"
	  )
	)
	(vlr-object-reactor
	  (list entp)
	  entt
	  '((:vlr-modified . modif_poly)
	    (:vlr-erased . effacer_pt)
	   )
	)
	(vlr-object-reactor
	  (list entt)
	  entp
	  '((:vlr-erased . effacer_pt))
	)
      )
      (vlax-ldata-delete entp "Patrick_35")
    )
    (setq n (1+ n))
  )
)
     )
   )
 )
 (princ)
)

(refaire_reacteurs)
(princ "\nREA.LSP chargé. Tapez REA pour l'exécuter")
(princ)

Voilà en vous remercient de vos aides je vous souhaite une bonne journée.

 

[Édité par (gile) : formatage et balises bbcodes]

[(gile)]

Salut,

 

Loin de moi l'intention de vouloir dénigrer l'excellent travail de Patrick_35, mais depuis la version 2005 AutoCAD (le LISP date d'avant) les champs dynamique permettent de faire ce que tu demandes.

Commande CHAMP (_FIELD), "Nom de champ" = "Objet", (sélectionner la polyligne) "Propriétés" = "Aire" et "Format supplémentaires" pour le facteur de conversion.

 

Sinon, tu peux remplacer dans le code toutes les expressions :

(strcat (rtos (vla-get-area obj) 2 2) " mm2")

par

(strcat (rtos (/ (vla-get-area obj) 1000000) 2 2) " m2")

 

Ou encore faire une recherche dans les forums, d'autres LISP utilisant les champs ont été donnés (exemples : Pline_Bloc ou TotalArea sur cette page)

[fauxsuisse]

Salut Gile

 

Merci beaucoup de tes infos et la rapidité de tes réponses.

ça nous fait vraiment plaisir de travailler sous Autocad quand on a des personne capable de répondre, on aime bien nous le vendre mais après quand on a besoin d'aide difficile de trouver des infos mis à part qu'on veut juste te revendre encore un autre support dans lequel tu te rends compte que tu connais mieux le produit que le guigniol qui à l'autre bout :)

 

Merci encore c'est sympa