Yazı içindeki sayıları toplayan lisp
Yazı içindeki sayı değerlerini toplar
ProhibiT - 08.04.2020 14:03
Toplamak üzere seçeceğiniz text veya mtext türü objelerin içinde nümerik olmayan karakterler olabilir, hatta tamamı alfanümerik bile olabilir. Toplam yazdırılırken, toplanan objelerde kullanılan para birimi ve diğer birimler gözardı edilir yazılmazlar.



- Toplanmak üzere seçilen text objelerinin içinde virgül varsa nokta olarak alınır.
- Söz konusu text objelerinin içinde nümerik olmayan karakterler varsa, gözardı edilir.
- Sonuçlar yazdırılmak üzere seçim yapmanız istendiğinde tıkladığınız noktada bir text ya da mtext varsa onun içeriği değiştirilerek toplam değer yazılır. eğer tıklanan noktada text veya mtext türü bir obje yoksa, yeni bir text objesi oluşturularak toplam yazılır.



Çalıştırmak için komut: tpLm

Lisple ilgili forum linki İleti #62467

Bu lispi kodlayan ProhibiT 'e teşekkürler.

Kod:

(defun c:tpLm (/ dpp odz tpLn L n txh pvt m o rsLt tpLm)
  (command "undo" "group") (setvar "cmdecho" 0)
  (defun *error* (er)
    (setvar "dimzin" odz) (setvar "Luprec" oLp) (command "_.undo" "e"))
  (if (not oLp) (setq oLp (getvar "luprec")))
(if (setq dpp (getint (strcat "nOndalık Basamak Sayısı <" (itoa oLp) ">: ")))
    (setq oLp dpp) (setq dpp oLp)) (setq odz (getvar "dimzin"))
  (setvar "luprec" dpp) (setvar "dimzin" 0)
  (princ "n  toplanacak sayıları seçiniz")
  (setq tpLn (ssget (list (cons 0 "*text")))
        L (sslength tpLn) n -1 rsLt nil
        txh (cdr (assoc 40 (entget (ssname tpLn 0)))))
  (while (< (setq n (1+ n)) L)
    (setq pvt (cdr (assoc 1 (entget (ssname tpLn n)))) m (strlen pvt) o 0)
    (while (<= (setq o (1+ o)) m)
      (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)))
              m (strlen pvt) o (1- o))))
    (if rsLt (setq rsLt (+ rsLt (atof pvt))) (setq rsLt (atof pvt))))
  (princ "n    toplamı 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 (progn (setq tpLm (entget (ssname tpLm 0)))
             (if (or (= (cdr (assoc 0 tpLm)) "TEXT")
                     (= (cdr (assoc 0 tpLm)) "MTEXT"))
            (progn (setq tpLm (subst (cons 1 (rtos rsLt)) (assoc 1 tpLm) tpLm))
                 (entmod tpLm) (entupd (cdr (assoc -1 tpLm))))))
    (entmake (list (cons 0 "text") (cons 10 sp) (cons 50 0) (cons 40 txh)
                   (cons 1 (rtos rsLt)))))
   (command "undo" "e") (setvar "dimzin" odz) (setvar "Luprec" oLp) (prin1)
)


Bu kodları nasıl kullanacağınızı bilmiyorsanız aşağıdaki linkten;
AutoLISP > Konu Anlatımları > Lisp Dosyalarının oluşturulması ve Yüklenmesi
konusunu inceleyiniz.

Yazar: ProhibiT
İçerik: LSP (Lisp) formatında AutoLISP dosyası
Tag: lisp, lsp, yazı, toplama, toplam, değer, sayı topla, text, sum, addition

Yorumlar :
landscaper   02.04.2021 09:50 #16072  

merhaba öncelikelr çok teşekkür ederim bu lisp için.... yaklaşık 1 yıldır autocad 2019 ve 2020 de kullandığım lisp şuan autocad 2020 de çalışmamaya başladı. Şöyle bir hata veriyor...

; warning: unwind skipped on exception
; error: Exception occurred: 0xC0000005 (Access Violation)

Sorun ne olabilir acaba? Prohibit hocam yardımcı olurmusunuz?

Copyright © 2004-2022 SQL: 0.024 saniye - Sorgu: 34 - Ortalama: 0.00069 saniye