;|===========================================================================|;
;| pLaC: PoLyLine 面積・周囲長 |;
;| 選択した LwPolyline オブジェクトの面積と周囲長を幾何中心に |;
;| フィールドとして書き込みます。文字高さには TextSize、小数点以下の |;
;| 桁数には Luprec 変数の値が取得されます。 |;
;| 作成者: M. Şahin Güvercin - cizimokulu.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製図ユニット／計算ユニット <"(rtos oFc)">: ")))
 (if (not FaC) (setq Fac oFc) (setq oFc FaC))
 (princ "n面積と周囲長を書き込むLwPolylineオブジェクトを選択してください。: ")
 (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))