;;;===========================================;;;
;;;     ;;;
;;;orjinal lisp M. Sahin guvercin`e ait
;;;https://cizimokulu.com/forums.php?m=posts&p=64900#64900
;;; manuel ozgul agirlik girisi  ve text yazimina agirlik ,kg yazisi eklendi 26.08.2023
;;;===========================================;;;
(defun c:Agr (/ thck objt0 objt1 L n darea barea weight sp agrL)
  (setvar "cmdecho" 0) (command "undo" "group")
  (if (= ethck nil) (setq ethck 10))
  (setq thck (getreal (strcat "\nmalzeme kalinligi <" (rtos ethck) ">: "))
        darea 0 barea 0)
  (if (= thck nil) (setq thck ethck) (setq ethck thck))
  (if (= ekg1 nil) (setq ekg1 7.85))
  (setq kg1 (getreal (strcat "\nmalzeme ozgul agirlik <" (rtos ekg1) ">: ")))
  (if (= kg1 nil) (setq kg1 ekg1) (setq ekg1 kg1))
  (princ "\nDolu objeleri seciniz:")
  (setq objt0 (ssget (list (cons 0 "*Polyline,Region,spLine,circLe,eLLipse"))))
  (if objt0 (setq L (sslength objt0) n -1) (setq L 0 n -1))
  (while (< (setq n (1+ n)) L) (command "_.Area" "e" (ssname objt0 n))
    (setq darea (+ darea (getvar "area"))))
  (if darea (progn (princ "\nBosluk objelerini seciniz:")
      (setq objt1 (ssget (list (cons 0 "*Polyline,Region,spLine,circLe,eLLipse"))))
      (if objt1 (setq L (sslength objt1) n -1) (setq L 0 n -1))
      (while (< (setq n (1+ n)) L) (command "_.Area" "e" (ssname objt1 n))
        (setq barea (+ barea (getvar "area"))))
      (if barea (setq weight (* (- darea barea) kg1 thck 0.000001))
        (setq weight (* darea kg1 thck 0.000001)))
      (princ (strcat "\n  agirlik = " (rtos weight 2 3) " kg."))
      (princ "\nAgirlik yazilacak yeri/objeyi seciniz: ")
      (while (/= 3 (car (setq sp (grread T 4 2)))))
      (if (setq agrL (ssget (cadr sp) (list (cons 0 "*text"))))
        (progn (setq agrL (entget (ssname agrL 0))
          agrL (subst (cons 1 (strcat "\n  agirlik = " (rtos weight 2 3) " kg.")) (assoc 1 agrL) agrL ))
          (entmod agrL) (entupd (cdr (assoc -1 agrL))))
        (entmake (list (cons 0 "TEXT") (cons 50 0) (cons 10 (cadr sp))
                       (cons 40 (* (getvar "dimscale") (getvar "dimtxt")))
                       (cons 1 (strcat "\n  agirlik = " (rtos weight 2 3) " kg.")))))))
  (command "undo" "e") (prin1)
)