Automatically writes the area and perimeter measurements of objects.
Automatic Area and Perimeter Calculation and Annotation
admin - 23.05.2026 08:12
admin - 23.05.2026 08:12
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))
;| 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
Comments :
No comment yet





Category Index

