Povratak / Back

;PODRZKA ZA RACUNANJE POVRSINA MNOGOKUTA (izradjenih s polyline)

;KOJE OZNACIMO, TE IZPISUJE POVRSINE U PRIBLIZNO SREDINE MNOGOKUTA

;----IZRADIO DANE ZA GEODIST----

 

(defun c:pm (/ mojskupiso brojac br1 moj1 x y p)

  (setq mojskupiso (ssget))

  (setq brojac 0)

  (while (< brojac (sslength mojskupiso))

    (setq moj1 (entget (ssname mojskupiso brojac)))

    (setq br1 14)

    (setq brt 0)

    (setq p 0)

    (setq ym1 (nth 2 (nth (- (length moj1) 5) moj1)))

    (setq yp2 (nth 2 (nth 14 moj1)))

    (while (< br1 (- (length moj1) (+ 3 4)))

      (setq x (nth 1 (nth br1 moj1)))

      (setq yp1 (nth 2 (nth (+ br1 4) moj1)))

      (setq p (+ p (* x (- yp1 ym1))))

      (setq br1 (+ br1 4))

      (setq brt (+ brt 1))

      (setq ym1 (nth 2 (nth (- br1 4) moj1)))

    )

    (setq ypocetna (nth 2 (nth 14 moj1)))

    (setq xpocetna (nth 1 (nth 14 moj1)))

    (setq ysrednja (nth 2 (nth (+ 14 (* (fix (/ brt 2)) 4)) moj1)))

    (setq xsrednja (nth 1 (nth (+ 14 (* (fix (/ brt 2)) 4)) moj1)))

    (setq dxpovrsine (/ (+ xsrednja xpocetna) 2))

    (setq dypovrsine (/ (+ ysrednja ypocetna) 2)) 

    (setq x (nth 1 (nth br1 moj1)))

    (setq p (+ p (* x (- yp2 ym1))))

    (setq pt (list (- dxpovrsine 5) (- dypovrsine 1) 0))

    (princ (/ p 2))

    (setq p2 (abs(/ p 2)))

    (setq ps2 (strcat "P=" (rtos p2 2 2) " m2"))

    (command "_text" pt "1.2" "0" ps2)

    (setq brojac (+ brojac 1))

  )

  (princ)

)