• CAD SCHOOL
    by Cizim Okulu
    Forum Galeri İndir AutoCAD Turkish English Deutsch Français Japanese
    Forums Gallery AutoLISP AutoCAD

    Register or Login

Category Index
AutoLISP
LISP to Export Tables...
AutoLISP Function to ...
Automatically generat...
FreeMUST v3.1 Archite...
Facade elevation assi...
AutoLISP Function for...
AutoLISP Function Tha...
Automatically writes ...
AutoLISP Function to ...
Point Coordinate Extr...
Drawings
BIM
Visitors: 4, Users: 0

Details »
AutoLISP > Automatically writes the area and perimeter measurements of objects.

Automatically writes the area and perimeter measurements of objects.

Automatic Area and Perimeter Calculation and Annotation
admin - 23.05.2026 08:12
Automatic Area and Perimeter Calculation and Annotation

pLaC: PoLyLine Area & Circumference
Calculates the Area and Perimeter of selected LwPolyline objects and inserts the values at the geometric center of each object as Field text.
The annotation uses the current TextSize variable for text height and the Luprec variable for the number of decimal places displayed.
Code:

;|===========================================================================|;
;| pLaC: PoLyLine ALan Çevre                                                 |;
;| Seçilen LwPolyline objelerinin Alanı ve Çevresi, geometrik merkezine,     |;
;| Field olarak yazılır. Yazı Yüksekliği olarak TextSize, ondalık basamak    |;
;| sayısı olarak Luprec değişkenlerinin değeri alınır.                       |;
;|          Hayırlayan: 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 "nÇizim Birimi/Hesap Birimi <"(rtos oFc)">: ")))
 (if (not FaC) (setq Fac oFc) (setq oFc FaC))
 (princ "nAlanı ve Çevresi yazılacak LwPolyline objelerini seçiniz: ")
 (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)"]">%"))
                (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) "]">%"))
               (cons 50 0.0) (cons 72 1) (cons 11 pC))) (ssadd (entlast) Fob))
 (command "_.UpdateFieLd" Fob "") (command "_.undo" "e") (prin1))

Author: cizimokulu.com
Description: AutoLISP Function to Automatic Area and Perimeter Calculation and Annotation
Tag: Automatic Area and Perimeter Calculation and Annotation


Download
Hits: 1, Size: 0.03 MB

Comments :
No comment yet
Copyright © 2004-2026 | All Rights Reserved | 61 | Sitemap | Statistics | About Us | Help
SQL: 0.006 seconds - SQLqueries: 31 - Avarage: 0.00019 seconds