Lisp isteği sayı toplama | Forumlar

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 704, Üye: 6
asamet, ehya, hasantursun, mttlp, silence33, styleoverride

Detaylar »

Forumlar > AutoCAD Acil Yardım > Lisp isteği sayı toplama

Bu başlığı inceleyenler : 1 ziyaretçi, 0 üye : ---

İleti	Yazar
04.02.2011 07:13 62408	lazymelisa Yeni üye 7 ileti ısıtma soğutma teknikeri istanbul
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 62410	miyatu Kıdemli Uzman 142 ileti Tekniker ISTANBUL
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) Kendini gelistirmeyen insanlar, bildiklerini paylasmaya korkarlar...

04.02.2011 08:47 62415	emasi Uzman 78 ileti injiner Baki
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 «ŜŦǾק-ҒǏŔỄ» BİR DƏFƏ YÜKSƏLƏN BAYRAQ, BİR DAHA ENMƏZ

04.02.2011 09:02 62417	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
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 () (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) ) şeklinde kullanırsanız bu hatayı ortadan kaldırmış olursunuz. her ne kadar çarpma işleminde hataya sebep olmuyorsa bile, çarpım yapan fonksiyon kodunu da; Kod: (defun c:crpm () (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) ) şeklinde değiştirirseniz daha doğru olacaktır. kolay gelsin. Beğenmek için anlamak lazım...

04.02.2011 09:45 62418	emasi Uzman 78 ileti injiner Baki
Teşekkürler hocam:) «ŜŦǾק-ҒǏŔỄ» BİR DƏFƏ YÜKSƏLƏN BAYRAQ, BİR DAHA ENMƏZ

04.02.2011 10:38 62420	lazymelisa Yeni üye 7 ileti ısıtma soğutma teknikeri istanbul
[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 62421	emasi Uzman 78 ileti injiner Baki
Link açılmır ki:( «ŜŦǾק-ҒǏŔỄ» BİR DƏFƏ YÜKSƏLƏN BAYRAQ, BİR DAHA ENMƏZ

04.02.2011 10:47 62422	lazymelisa Yeni üye 7 ileti ısıtma soğutma teknikeri istanbul
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 62467	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
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ı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) \|; (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\terror " 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) (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)))) (setq PvT (vl-string-right-trim " " (vl-string-left-trim " " PvT))) (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)) - 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. * 15 Nisan 2024 tarihinde tekrar güncellendi kolay gelsin. ProhibiT (15.04.2024 08:22 GMT) Beğenmek için anlamak lazım...
masaku
08.03.2011 08:17 63207	aytac_kavak Girişimci 16 ileti makına ist
Tesekkurler prohibit hocam cok işimize yaradı kolaygelsın

08.12.2011 15:38 66888	xguvenx Girişimci 1 ileti topoğraf aydın
Ç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 66906	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
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... Beğenmek için anlamak lazım...

01.06.2015 14:00 81550	xpitonx_54 Girişimci 18 ileti tekniker istanbul
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 81704	Travaci Editör 2393 ileti Teknik Ressam Konstantinopol
Alıntı xpitonx_54 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 81713	xpitonx_54 Girişimci 18 ileti tekniker istanbul
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 88423	elk21 Gold üye 27 ileti elektrik teknikeri diyarbakır
[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 88424	Travaci Editör 2393 ileti Teknik Ressam Konstantinopol
Alıntı elk21 : Sayı önündeki yazı yüzünden işlem yapmıyor.

01.10.2020 20:57 88425	elk21 Gold üye 27 ileti elektrik teknikeri diyarbakır
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 88435	alumina Editör 769 ileti Insaat Muhendisi Istanbul
Alıntı elk21 : 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) )

08.10.2020 14:42 88443	elk21 Gold üye 27 ileti elektrik teknikeri diyarbakır
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

> 1 < [2]

Sonraki Sayfa