;
| 2011 yılında yazılıp autocadokulu.com (cizimokulu.com) sitesinde           |
| paylaşılan, seçilen yazılar (text veya mtext) içindeki sayıları            |
| ayıklayarak toplamını gösterilen yerdeki yazının sayısal içeriğini         |
| güncelleyerekveya seçilen yer boş ise yeni bir text nesnesi oluşturarak    |
| yazan bu sayı toplama fonksiyonu, Ekim 2020'de güncellenerek,              |
| yazı içinde boşluk (ascii 32) karakteri bulunması durumunda da             |
| toplamı hesaplayacak şekildegüncellendi. 09.10.2020 -                      |
|                   son düzenleme: 10.06.2023 - M. Şahin Güvercin (ProhibiT) |;
;|LUPREC <4> ondalık hane sayısıdır.  0.0000 koordinata bakılabilir.          |;
;|Dimzin <0> sayı sonundaki 0 baskılamayı iptal eder.  başlangıç Dimzin <8>   |;
;|sayı harici tüm karakterler boşlukla değiştirildi m2 (2sayısı iptal edildi.)|;
;|AYIRAÇ ":" alınarak textin Sonunda kırpma yapıldı.                          |;
;|M. Şahin Güvercin (ProhibiT) Hocamızın  ellerine sağlık bu lisp kodlarınındaki eksiklikleri         |
|bizi gelİştirmek adına boş bıraktığını düşünüyorum. Yeniden editleyen Recep BİNBİR (recep_xyz)      |;
(defun c:tpLm (/ *error* tpLn L n txh PvT m o rsLt tpLm)
  (setq ocmd (getvar "cmdecho"))
  (defun *error* (er /)
    (if (member er '("Function cancelled" "quit/exit abort"))
      (princ (strcat "\n\t*error* " er)))
    (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e"))
    (if ocmd (setvar "cmdecho" ocmd)) (prin1))
   (command "undo" "group") (setvar "cmdecho" 0)
;|____________________________________________________________________________|;
  (princ "\n  toplanacak sayıları seçiniz")
  (setq tpLn (ssget (list (cons 0 "*text"))) n -1 rsLt nil
        txh  (cdr (assoc 40 (entget (ssname tpLn 0)))))
  (while (setq PvT (ssname tpLn (setq n (1+ n))))
    (setq PvT (cdr (assoc 1 (entget PvT))) m (strlen PvT) o 0)
    (while (<= (setq o (1+ o)) m)
      (if (= (substr PvT o 1) ":")
        (setq PvT (strcat  (substr PvT (1+ o) (- m o))))) ;bu koşul ":" baz alarak yazının  "sol:" kısmı yokeder.[ön bilgi iptali için gereklidir.]
      (if (= (substr PvT o 1) (chr 32)) (setq o (1+ o)))
      (if (= (substr PvT o 1) (chr 44))
        (setq PvT (strcat (substr PvT 1 (1- o)) (chr 46)
                          (substr PvT (1+ o) (- m o)))))
      (if (or (< (ascii (substr PvT o 1)) 44) (> (ascii (substr PvT o 1)) 57))
        (setq PvT (strcat (substr PvT 1 (1- o)) " " (substr PvT (1+ o) (- m o)));bu kosul ise 44 öncesi, 57 sonrası karakterleri boşlukla değiştirir.
              m (strlen PvT) o (1- o))));|(alert  PvT )|;
    (setq PvT (vl-string-right-trim " " (vl-string-left-trim " " PvT)));|(alert  (strcat (rtos(atof PvT) 2 8) "<---->" ))|;
    (if rsLt (setq rsLt (+ rsLt (atof PvT))) (setq rsLt (atof PvT))))
;|____________________________________________________________________________|;
  (princ "\n    Toplam Yazısı/Yeri seçiniz")
  (while (/= 3 (car (setq sp (grread t 4 2)))))
  (setq sp (cadr sp) np (list (car sp) (cadr sp)) tpLm (ssget np))
  (if tpLm
    (if (or (= (cdr (assoc 0 (setq tpLm (entget (ssname tpLm 0))))) "TEXT")
            (= (cdr (assoc 0 tpLm)) "MTEXT"))
      (entupd (cdr (assoc -1
                          (entmod (setq tpLm (subst (cons 1 (rtos rsLt))
                                                    (assoc 1 tpLm) tpLm)))))))
    (entmake (list (cons 0 "text") (cons 10 sp) (cons 50 0) (cons 40 txh)
                   (cons 1 (rtos rsLt)))))
  (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e"))
  (if ocmd (setvar "cmdecho" ocmd)) (prin1))