Copyright © 2004-2022 SQL: 2.723 saniye - Sorgu: 101 - Ortalama: 0.02697 saniye
04.02.2011 07:13
lazymelisa |
Merhaba arkadaşlar ben ataşman hazırlarken sayıları tek tek toplayarak çk zaman kaybediyorum ¢ 0. 75 + ¢ 0. 23 gibi işlemleri yapabilecek bi lisp arıyorum yeniyim sitede tam olarak bunu bulamadım yardımcı olursanız sevinirim. . .
|
04.02.2011 07:26
miyatu |
Daha detaylı bilgi verirseniz yardımcı olmaya calısırım.
mesajınızdan anladıgım bu inş. işinize yarar. . . Kod: ;calıstırma kodunu tpl olarak belirledik (defun c:tpl () ;td değişkeninin değerinin sıfır yapılması (setq td 0) ;entsel fonksiyonu ile toplanacak sayının sectirilmesi ve ts degişkenine atanması (setq ts (entsel "\ntoplanacak sayıyı seçiniz:")) ;while dongusu baslangıcı sart ts degişkeni nil oluncaya kadar (while (/= ts nil) ;secilen text in okunması (setq tsd (cdr (assoc 1 (entget (car ts))))) ;sayı kısmının ayrıştırılması (setq ty (atof (substr tsd 2))) ;toplama işleminin yapılması (setq td (+ td ty)) ;diğer text in sectirilmesi (setq ts (entsel "\ntoplanacak diger sayıyı seçiniz:")) ;while dongusunden cıkıs ) ;sonucun kullanıcıya gösterilmesi (alert (strcat "toplam =" (rtos td 2 2))) ) kolay gelsin. . . miyatu (04.02.2011 08:26 GMT) |
04.02.2011 08:47
emasi |
Bu prohibit hocanin lispi. çarpılacak sayılar için yazılmışdı bir az düzen yaptım.
umarım prohibit hocamız izin verir:blush Kod: (defun c:topla () (princ "\n toplanacak sayilari seciniz. . . ") (setq crpn (ssget (list (cons 0 "*text"))) l (sslength crpn) n -1 rslt 1) (while (< (setq n (1+ n)) l) (setq rslt (+ rslt (atof (cdr (assoc 1 (entget (ssname crpn n)))))))) (setq crpm (entget (car (entsel "\n netice seciniz. . . "))) crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm)) (entmod crpm) (entupd (cdr (assoc -1 crpm))) (prin1) ) ama rakamların önünde işaretler olursa alqılamaz. rakamlardan sonra işaret olarsa alqılar uğurlar
|
04.02.2011 09:02
ProhibiT |
Izin almanıza falan gerek yok emasi :) sizlerin bu tür fonksiyonları değiştirip geliştirmenizden ancak keyif duyarım. burada bir şeyi düzeltmek lazım, işlem çarpma olduğu için, rslt değişkenine başlangıç geğeri olarak 1 vermiştim. toplama olunca, sonucu 1 fazla hesaplayacak ve yanlışa sebep olacaktır. bunun için
Kod: (defun c:tplm () şeklinde kullanırsanız bu hatayı ortadan kaldırmış olursunuz. (princ "\n toplanacak sayıları seciniz ") (setq tpln (ssget (list (cons 0 "*text"))) l (sslength crpn) n -1 rslt nil) (while (< (setq n (1+ n)) l) (if rslt (setq rslt (+ rslt (atof (cdr (assoc 1 (entget (ssname tpln n))))))) (setq rslt (atof (cdr (assoc 1 (entget (ssname tpln n)))))))) (setq tplm (entget (car (entsel "\n netice seciniz"))) tplm (subst (cons 1 (rtos rslt)) (assoc 1 tplm) tplm)) (entmod tplm) (entupd (cdr (assoc -1 tplm))) (prin1) ) her ne kadar çarpma işleminde hataya sebep olmuyorsa bile, çarpım yapan fonksiyon kodunu da; Kod: (defun c:crpm () şeklinde değiştirirseniz daha doğru olacaktır. (princ "\n çarpılacak sayıları seçiniz ") (setq crpn (ssget (list (cons 0 "*text"))) l (sslength crpn) n -1 rslt nil) (while (< (setq n (1+ n)) l) (if rslt (setq rslt (* rslt (atof (cdr (assoc 1 (entget (ssname crpn n))))))) (setq rslt (atof (cdr (assoc 1 (entget (ssname crpn n)))))))) (setq crpm (entget (car (entsel "\n çarpımı seçiniz "))) crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm)) (entmod crpm) (entupd (cdr (assoc -1 crpm))) (prin1) ) kolay gelsin.
|
04.02.2011 09:45
emasi |
Teşekkürler hocam:)
|
04.02.2011 10:38
lazymelisa |
[url=http://img808. Imageshack. Us/i/cadg. png/][img]http://img808. Imageshack. Us/img808/2881/cadg. Png[/img][/url]
uploaded with ımageshack. Us burdaki sayıları toplamak istiyorum ProhibiT (05.12.2011 17:52 GMT) |
04.02.2011 10:46
emasi |
Link açılmır ki:(
|
04.02.2011 10:47
lazymelisa |
beceremedm ki bi resim eklemeyi ! ! ! ¢0. 50 m ! ! ! ! ¢ 0. 45 m !______________________________ böle bişi bunu toplicam bazen nokta yerine virgün de oluyo bazen sonunma m de yazmıo böle bişi iste ProhibiT (05.12.2011 17:54 GMT) |
06.02.2011 21:55
ProhibiT |
Yukarıda paylaştığım fonksiyonu değiştirip geliştirerek yeniden paylaşıyorum. Bu haliyle sizin ihtiyacınızı da göreceğini sanıyorum. 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.
Kod: ;;| 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ıklayaraktoplamı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) |; (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"))) 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 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))) m (strlen pvt) o (1- o)))) (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 (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))))) (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e")) (if ocmd (setvar "cmdecho" ocmd)) (prin1)) - 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. * 9 Ekim 2020 tarihinde seçilen yazılar içinde boşluk karakteri olması durumu da göz önüne alınarak güncellendi. * 10 Haziran 2023 tarihinde yeniden düzenlendi. kolay gelsin. ProhibiT (10.06.2023 15:59 GMT) |
08.03.2011 08:17
aytac_kavak |
Tesekkurler prohibit hocam cok işimize yaradı kolaygelsın
|
08.12.2011 15:38
xguvenx |
Çok sağolasın hocam çok makbule geçti bu lips bunu yana yana arıyordum allah razı olsun keşke birde sonuçları noktadan sonra 2 hane yazsaydı ama olsun bunada şükür
|
09.12.2011 12:53
ProhibiT |
Dimzin ve luprec sistem değişkenlerini uygun şekilde ayarlayarak istediğiniz gibi yazdırabilirsiniz. buna rağmen, fonksiyon kodunu, ondalık basamak sayısını kullanıcı belirleyecek şekilde değiştirerek güncelledim. tekrar indirip kullanabilirsiniz...
|
01.06.2015 14:00
xpitonx_54 |
Arkadaşlar merhaba ,
Toplama lisp inde seçilen yazıların aritmetik ortalamasını yazdırmak ve aynı zamanda bu değer "Z" değeri olacak bir point oluşturmak istiyorum ama nasıl yapacağımı bilmiyorum.Yardımcı olursanız sevinirim.Şimdiden teşerkkürler..
|
07.07.2015 12:23
Travaci |
Alıntı Kod: (defun c:typ (/ e r k a n) (vl-load-com)
(defun *error* (msg) (if (not (wcmatch (strcase msg t) "*cancel*,*exit*")) (princ (strcat "\nError: " msg))) (setq *error* nil) (princ)) (if (setq e (ssget (list (cons 0 "*text")))) (progn (setq r 0 k 0) (repeat (setq r (sslength e)) (setq k (+ k (atof (cdr (assoc 1 (entget (ssname e (setq r (1- r)))))))))) (if (setq a (getpoint "\nSpecify point:")) (progn (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (entmake (list (cons 0 "text") (cons 10 (trans a 1 0)) (cons 72 1) (cons 11 (trans a 1 0)) (cons 40 (getvar "textsize")) (cons 73 1) (cons 1 (rtos (setq n (/ k (sslength e))) 2 (getvar "dimdec"))))) (entmake (list (cons 0 "point") (cons 10 (trans (list (nth 0 a) (nth 1 a) n) 1 0)))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) ) ) ) ) (setq *error* nil) (princ) )
|
10.07.2015 07:05
xpitonx_54 |
Saygıdeğer editörümüz "Travaci" , alakanızdan ve yardımınızdan ötürü sonsuz teşekkürlerimi sunarım.
Saygılarımla...
|
01.10.2020 16:33
elk21 |
[img][/img]
HOCAM ÖNCELİKLE TEŞEKKÜRLER BÖYLE BİR LİSP OLUŞTURDUĞUNUZ İÇİN UZUN ZAMANDIR BÖYLE BİRŞEY ARIYORDUM FAKAT TOPLUYORUM YALNIŞ ÖLÇÜYOR SİZE ZAHMET BANA YARDIMCI OLURMUSUNUZ SAYGILARIMLA HÜRMET EDERİM
|
01.10.2020 18:06
Travaci |
Alıntı Sayı önündeki yazı yüzünden işlem yapmıyor.
|
01.10.2020 20:57
elk21 |
Teşekkür ederim verdiğiniz bilgi için peki hocam böyle yazılı bir yerde masıl toplama yapabiliriz buna uygun bir lisp varmıdır.saygılarımla
|
03.10.2020 00:23
alumina |
Alıntı Kod: (defun c:qw (/ tx)
(if (ssget '((0 . "*text") (1 . "*[Mm]2*"))) (alert (strcat "Total: " (rtos (apply '+ (mapcar '(lambda(a) (atof (substr (setq tx (cdr (assoc 1 (entget a)))) (1+ (vl-string-position (ascii " ") tx 1))))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))) 2 2) " M2") ) ) (princ) )
|
elk21 |
AlıntıALUMİNA SAYGIDEĞER HOCAM ÖNCELİKLE TEŞEKKÜR EDERİM FAKAT VERMİŞ OLDUĞUNUZ LİSP YÜKLEDİM AMA ÇALIŞMIYOR SAYGILARIMLA
|