Écrit automatiquement les mesures de l'aire et du périmètre des objets.
Calcul et annotation automatiques de l'aire et du périmètre
admin - 23.05.2026 08:12
admin - 23.05.2026 08:12
Calcul automatique de l'aire et du périmètre et annotation

pLaC: PoLyLine Aire & Périmètre
Calcule l'aire et le périmètre des objets LwPolyline sélectionnés et insère les valeurs au centre géométrique de chaque objet sous forme de texte de champ (Field).
L'annotation utilise la variable courante TextSize pour la hauteur du texte et la variable Luprec pour le nombre de décimales affichées.

pLaC: PoLyLine Aire & Périmètre
Calcule l'aire et le périmètre des objets LwPolyline sélectionnés et insère les valeurs au centre géométrique de chaque objet sous forme de texte de champ (Field).
L'annotation utilise la variable courante TextSize pour la hauteur du texte et la variable Luprec pour le nombre de décimales affichées.
Code:
;|===========================================================================|;
;| pLaC: PoLyLine Aire Périmètre |;
;| L'aire et le périmètre des objets LwPolyline sélectionnés sont écrits |;
;| sous forme de champ (Field) au centre géométrique. La valeur de la |;
;| variable TextSize est prise pour la hauteur du texte, et la variable |;
;| Luprec pour le nombre de décimales. |;
;| Préparé par: M. Şahin Güvercin - www.autocadokulu.com |;
;|---------------------------------------------------------------------------|;
(defun c:pLaC (/ *error* pLns Fob n PvT vLo oID x y z PnT m TxH pR pA pC)
(setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
(defun *error* (/ er) (princ (strcat "n" er)) (command "_.undo" "e")(prin1))
(if (not oFc) (setq oFc 1))
(setq FaC (getreal (strcat "nUnité de dessin/Unité de calcul <"(rtos oFc)">: ")))
(if (not FaC) (setq Fac oFc) (setq oFc FaC))
(princ "nSélectionnez les objets LwPolyline pour l'aire et le périmètre: ")
(setq pLns (ssget (list (cons 0 "LwPoLyLine")))
Fob (ssadd) n (sslength pLns))
(while (not (minusp (setq n (1- n))))
(setq PvT (ssname pLns n) vLo (vlax-ename->vla-object PvT)
oID (itoa (vla-get-ObjectID vLo)) x 0 y 0 z (getvar "elevation")
PnT (vlax-safearray->list (vlax-variant-value
(vlax-get-property vLo 'Coordinates))) m (length PnT))
(while (not (minusp (setq m (- m 2))))
(setq x (+ x (nth m PnT)) y (+ y (nth (1+ m) PnT))))
(setq x (/ x (/ (length PnT) 2)) y (/ y (/ (length PnT) 2))
TxH (getvar "TextSize") pR (getvar "Luprec")
pA (polar (list x y z) (/ pi 2.0) (* 0.833333 TxH))
pC (polar (list x y z) (* pi 1.5) (* 0.833333 TxH)))
(entmake (list (cons 0 "Text") (cons 10 pA) (cons 40 TxH)
(cons 1 (strcat "%<AcObjProp Object(%<_ObjId " oID
">%).Area f "%lu2%pr" (itoa pR)
"%ps[A=,]%ct8["(rtos(* FaC FaC)2 8)"] The Area is: "> The Area is: ">%"))
(cons 50 0.0) (cons 72 1) (cons 11 pA))) (ssadd (entlast) Fob)
(entmake (list (cons 0 "Text") (cons 10 pC) (cons 40 TxH)
(cons 1 (strcat "%<AcObjProp.16.2 Object(%<_ObjId " oID
">%).Length f "%lu2%pr" (itoa pR)
"%ps[C=,]%ct8[" (rtos FaC 2 8) "] The Perimeter is: "> The Perimeter is: ">%"))
(cons 50 0.0) (cons 72 1) (cons 11 pC))) (ssadd (entlast) Fob))
(command "_.UpdateFieLd" Fob "") (command "_.undo" "e") (prin1))
;| pLaC: PoLyLine Aire Périmètre |;
;| L'aire et le périmètre des objets LwPolyline sélectionnés sont écrits |;
;| sous forme de champ (Field) au centre géométrique. La valeur de la |;
;| variable TextSize est prise pour la hauteur du texte, et la variable |;
;| Luprec pour le nombre de décimales. |;
;| Préparé par: M. Şahin Güvercin - www.autocadokulu.com |;
;|---------------------------------------------------------------------------|;
(defun c:pLaC (/ *error* pLns Fob n PvT vLo oID x y z PnT m TxH pR pA pC)
(setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
(defun *error* (/ er) (princ (strcat "n" er)) (command "_.undo" "e")(prin1))
(if (not oFc) (setq oFc 1))
(setq FaC (getreal (strcat "nUnité de dessin/Unité de calcul <"(rtos oFc)">: ")))
(if (not FaC) (setq Fac oFc) (setq oFc FaC))
(princ "nSélectionnez les objets LwPolyline pour l'aire et le périmètre: ")
(setq pLns (ssget (list (cons 0 "LwPoLyLine")))
Fob (ssadd) n (sslength pLns))
(while (not (minusp (setq n (1- n))))
(setq PvT (ssname pLns n) vLo (vlax-ename->vla-object PvT)
oID (itoa (vla-get-ObjectID vLo)) x 0 y 0 z (getvar "elevation")
PnT (vlax-safearray->list (vlax-variant-value
(vlax-get-property vLo 'Coordinates))) m (length PnT))
(while (not (minusp (setq m (- m 2))))
(setq x (+ x (nth m PnT)) y (+ y (nth (1+ m) PnT))))
(setq x (/ x (/ (length PnT) 2)) y (/ y (/ (length PnT) 2))
TxH (getvar "TextSize") pR (getvar "Luprec")
pA (polar (list x y z) (/ pi 2.0) (* 0.833333 TxH))
pC (polar (list x y z) (* pi 1.5) (* 0.833333 TxH)))
(entmake (list (cons 0 "Text") (cons 10 pA) (cons 40 TxH)
(cons 1 (strcat "%<AcObjProp Object(%<_ObjId " oID
">%).Area f "%lu2%pr" (itoa pR)
"%ps[A=,]%ct8["(rtos(* FaC FaC)2 8)"] The Area is: "> The Area is: ">%"))
(cons 50 0.0) (cons 72 1) (cons 11 pA))) (ssadd (entlast) Fob)
(entmake (list (cons 0 "Text") (cons 10 pC) (cons 40 TxH)
(cons 1 (strcat "%<AcObjProp.16.2 Object(%<_ObjId " oID
">%).Length f "%lu2%pr" (itoa pR)
"%ps[C=,]%ct8[" (rtos FaC 2 8) "] The Perimeter is: "> The Perimeter is: ">%"))
(cons 50 0.0) (cons 72 1) (cons 11 pC))) (ssadd (entlast) Fob))
(command "_.UpdateFieLd" Fob "") (command "_.undo" "e") (prin1))
Auteur: cizimokulu.com
Description: Fonction AutoLISP pour le calcul et l'annotation automatiques de l'aire et du périmètre
Tag: Calcul et annotation automatiques de l'aire et du périmètre
Commentaires :
Aucun commentaire pour le moment





Index des Catégories
