Aire des Polylignes en texte Surfacage

[j.bouteiller]

Bonjour,

Tout d'abord pardonner moi je sais que le sujet doit revenir assez régulièrement sur les technique de surfaçage pour plan d'architecture.

En cherchant un peut je suis tomber sur ce script.

Il correspond à peut près a ce que je recherche il crée un champ texte associer a une polyligne

le seul problème serrai que si l'on met a jour le champ on perd le petit "m2" qu'il y a a la fin du texte:

je suppose qu'il faut modifier ces lignes qui affiche le résultat  pour afficher l'unité hors du champ (ou pas du tout ça ressemble a des pictogrammes pour moi)

 str (strcat
        "%<\\AcObjProp Object(%<\\_ObjId "
        id
         ;; ">%).Area \\f \"%lu2%pr1%ps[,m²]%\">%"
         ">%).Area \\f \"%lu2%pr2%ps[,m²]%ct8[1.0E-4]\">%"
      )

Donc ma première question:

Est ce que quelqu'un pourrais me modifier le code?

Et deuxièmement:

Est ce qu'il existe la même chose pour les hachures?

En vous remerciant d'avance XD

;; 
;; PolyArea par GC - 03/03/2018 
;; 
;; Micro-Modif par Patrice B. 
;; 
;; ------------------------------------------------------------------------------------- 
;; SVP changer la Variable System       TEXTSIZE  AVANT d'executer la Routine ! 
;; Car la routine utilise la valeur de  TEXTSIZE  comme Hauteur de MTEXT par defaut ... 
;; ------------------------------------------------------------------------------------- 
;; 
;; J'ai revu les codes, le probleme venait de la methode utilisee pour placer le texte/champ sur le barycentre de la polyligne. 
;; Cette methode ne fonctionnait qu'avec des polylignes.
;; 
;; J'ai change cela. Le texte est desormais place au centre de la boundingbox de l'entite. 
;; J'ai aussi revu les filtres de selection qui ne devraient pas etre tout à fait les memes pour l'aire et la longueur. 
;; 
;; Pour l'aire, je te laisse choisir entre uniquement les objets fermes, ou pas.
;; 
;; Pour les longueurs, les champs sont differents pour les cercles (Circumference), les regions et mpolygons (Perimeter) 
;; et n'existent pas pour les ELLIPSEs et SPLINEs, j'ai donc remplace le champ par un MTEXT simple qui affiche la longueur.
;; 
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Area \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Length \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Perimeter \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Circumference \f "%lu2">%
;; 
;; Liste sur ELLIPSE --> Aire & Circonference ?? 
;; Liste sur SPLINE  --> Aire & Circonference ??
;; 
;; --- Interrogation Entite/Objet en Lisp ---
;; (entget (car (entsel)) '("*"))
;; 

(defun c:PolyArea (/ *error* filter ss acSpace minPt maxPt pt id str txt)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (or *util* (setq *util* (vla-get-Utility *acdoc*)))
 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (/= msg "Function cancelled")
 (princ (strcat "Erreur: " msg))
   )
   (vla-EndUndomark *acdoc*)
   (princ)
 )

 ;; entités fermées
 ;|
 (setq	filter (list
	 '(-4 . "<OR")
	 '(0 . "CIRCLE,MPOLYGON,REGION")
	 '(-4 . "<AND")
	 '(0 . "ELLIPSE")
	 '(41 . 0.0)
	 (cons 42 (* 2 pi))
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "LWPOLYLINE")
	 '(-4 . "&")
	 '(70 . 1)
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "POLYLINE")
	 '(-4 . "&")
	 '(70 . 1)
	 '(-4 . "<NOT")
	 '(-4 . "&")
	 '(70 . 120)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "SPLINE")
	 '(-4 . "&")
	 '(70 . 9)
	 '(-4 . "AND>")
	 '(-4 . "OR>")
       )
 )
 |;

 ;; entités fermées ou ouvertes
 (setq	filter (list
	 '(-4 . "<OR")
	 '(0 . "ARC,CIRCLE,LWPOLYLINE,MPOLYGON,REGION,ELLIPSE")
	 '(-4 . "<AND")
	 '(0 . "POLYLINE")
	 '(-4 . "<NOT")
	 '(-4 . "&")
	 '(70 . 120)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "SPLINE")
	 '(-4 . "&")
	 '(70 . 8)
	 '(-4 . "AND>")
	 '(-4 . "OR>"))
 ) 


 (prompt "Hauteur courante de MTEXT - Voir la Variable System TEXTSIZE ... \n"  ) 

 (prompt "\nPOLYAREA traite: ARC,CIRCLE,ELLIPSE,POLYLINE 2D,ELLIPSE,SPLINE,MPOLYGON,REGION \nSelectionnez les objets ou Entree pour tous ") 

 (if (or (ssget filter)
  (ssget "_X" (cons (cons 410 (getvar 'ctab)) filter))
     )
   (progn
     (vla-StartUndomark *acdoc*)
     (setq acSpace (vla-get-Block (vla-get-ActiveLayout *acdoc*)))
     (vlax-for	obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(vla-GetBoundingBox obj 'minPt 'maxPt)
(setq pt  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.))
		  (vlax-safearray->list minPt)
		  (vlax-safearray->list maxPt)
	  )
      id  (vla-GetObjectIdString *util* obj :vlax-false)
      str (strcat
	    "%<\\AcObjProp Object(%<\\_ObjId "
	    id
	     ;; ">%).Area \\f \"%lu2%pr1%ps[,m²]%\">%"
		 ">%).Area \\f \"%lu2%pr2%ps[,m²]%ct8[1.0E-4]\">%"
	  )
      txt (vla-addMText acSpace (vlax-3d-point pt) 0. str)
)
(vla-put-AttachmentPoint txt acAttachmentPointMiddleCenter)
(vla-put-insertionPoint txt (vlax-3d-point pt))
     )
     (vla-Delete ss)
   )
 )
 (*error* nil)
) 

 

 

 

[j.bouteiller]

Finalement c’était plus simple que je pensais même si j'ai pas encore compris se qui fessai du texte un champ. Je comprend pas encore tout le code. 

Donc au final j'ai juste virer [,m2]  du  strcat

et ajouter un autre str (strcat str "m2") juste après

et du coup je retrouve le m2 en texte derrière le champ  et je peut mettre a jour le champ  sans perdre l'unité. et tout ça sans comprendre pourquoi ça fonctionne c'est magique 🤪

[Invité Fabyan]

Bonjour,

Je te suggère d'aller faire un tour sur le site de Lee-Mac.

Programmes LISP gratuits | Programmation Lee Mac (lee-mac.com)

Amicalement

[j.bouteiller]

Merci pour le tuyaux je vais voir tout ca