• ÉCOLE DE CAO
    par Cizim Okulu
    Forum Galeri İndir AutoCAD Turkish English Deutsch Français Japanese
    Forums Galerie AutoLISP AutoCAD

    S'inscrire ou Connexion

Index des Catégories
AutoLISP
LISP pour exporter ...
Fonction AutoLISP p...
Génération automati...
FreeMUST v3.1 Bibli...
Programme d'attribu...
Fonction AutoLISP p...
Fonction AutoLISP p...
Écrit automatiqueme...
Fonction AutoLISP p...
Extraction des coor...
Drawings
BIM
Visiteurs: 1, Utilisateurs: 0

Détails »
AutoLISP > Écrit automatiquement les mesures de l'aire et du périmètre des objets.

É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
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.
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))

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


Télécharger
Visites: 0, Taille: 0.03 Mo

Commentaires :
Aucun commentaire pour le moment
Copyright © 2004-2026 | Tous Droits Réservés | 14 | Plan du site | Statistiques | À propos de nous | Aide
SQL: 0.036 secondes - Requêtes SQL: 31 - Moyenne: 0.00118 secondes