14.06.2009 15:11    

sinanc
Girilen sabit rakamı seçilen text objesi ile hesaplama

Girdiğiniz sabit rakamı, seçeceğiniz Text takamları ile Toplama, Çıkarma, Çarpma, Bölme işlemine tabi tutar.

Kod:

(defun c:bhsp ()
; Basit hesaplama programları
; 2009 (c) Sinan COŞKUN
; Girdiğiniz sabit rakamı, seçeceğiniz (TEXT) Rakamlar ile hesaplar !
(setq 1r nil)
(setq pasGec 0)
(initget 1 "T Ç A B")
(setq islem (getkword "\nYapacağınız işlemi belirtiniz Toplama/Çıkarma/çArpma/Bölme <T/Ç/A/B> : "))
  (cond ((= islem "T")(setq fnk "Toplama")))
  (cond ((= islem "Ç")(setq fnk "Çıkarma")))
  (cond ((= islem "A")(setq fnk "Çarpma")))
  (cond ((= islem "B")(setq fnk "Bölme")))
(while (and(= 1r nil)(< pasGec 2))
  (setq 1r(getreal(strcat"\n"fnk" işlemi için Rakam giriniz :")))
   (if(= 1r nil)
     (progn
       (alert "\nRakam giriniz !")
       (setq pasGec (+ 1 pasGec))
     );progn sonu
     (setq pasGec 0)
   ); if sonu
); while sonu 
  (while (and(/= 1r nil)(< pasGec 2))
    (setq 2rob(entsel"\nİşlem görecek Texti seçiniz !"))
    (if (and(/= 2rob nil)(= (cdr(assoc 0(entget(car 2rob))))"TEXT"))
      (progn
       (setq 2rob(entget(car 2rob)))
       (setq 2r(atof(vl-string-subst "." ","(cdr(assoc 1 2rob)))))
       (cond ((= islem "T")(setq isle(rtos(+ 2r 1r)2 2)))); T ise topla
       (cond ((= islem "Ç")(setq isle(rtos(- 2r 1r)2 2)))); Ç ise çıkar
       (cond ((= islem "A")(setq isle(rtos(* 2r 1r)2 2)))); A ise çarp
       (cond ((= islem "B")(setq isle(rtos(/ 2r 1r)2 2)))); B ise böl
       (setq EskiTxt(cdr(assoc 1 2rob)))
       (setq deg(subst(cons 1 isle)(cons 1 EskiTxt)2rob))
       (entmod deg)
       (setq pasGec 0)
      );progn sonu
      (progn
      (alert "\nObje seçemediniz veya seçtiğiniz Obje 'TEXT' değil !")
      (setq pasGec (+ 1 pasGec))
      );
     );if sonu
   );while sonu
(princ"\n************************************
\nİşlem sonlandırıldı !
\nBasit hesaplama programları, 2009 (c) Sinan COŞKUN")
(princ)
)


Lisp dosyasını buradan indirebilirsiniz: 1-text-hesap-lisp.lsp

admin (12.12.2017 20:12 GMT)

03.08.2009 21:53    

burakpinar
Özellikle cephe rölövesi ölçümlerinden karşılaşılan bir sorun var. Arazide yapılan ölçümler autocad ortamında aktarıldığında 2 boyutlu olarak, noktaları ve nokta numaralarını görebiliyoruz. Ancak sorun 3 boyutlu görünüşe geçildiğinde ortaya çıkıyor. Noktaların kotları olmasına rağmen nokta numaralarının kotları bulunmadığı için, çizime 3 boyutlu bakmaya çalıştığımızda noktalara olması gereken yerlerinde, nokta numaraları ise kotları sıfır olduğu için noktalarda farklı yerde çıkıyor. Bu durumda özellikle cephe çizimlerinde çok büyük zorluk oluyor.

Autocad ve lisp konusunda tecrübeli değilim. Ancak autocad de textlere kot verme işlemi yapan herhangi bir lisp mevcutmudur? Ya da yapılabilir mi?

NO X Y Z
1 100 100 14
2 115 115 15

gibi nokta isimlerine yani 1 ve 2 textlerine 14 ve 15 kotlarını vermek mümkünmüdür? Tabi binlerce nokta ve nokta numaralarından oluşan bir dosyada bu işlem yapılabilir mi?

Sanırım oldukça karışık anlattım. Umarım sorun anlaşılabilmiştir.

İyi çalışmalar.

01.10.2009 12:49    

cefer
Alıntı
sinanc :
İşlerimin yoğunluğundan dolayı 1 yıldır siteye birşey yazmamışım, şantiyedeyim işleri hızlandırmak için yine autolisplere başvurduk, pasımızı sildik...

Lisp istekleri başlığında spy178 arkadaşımızın ihtiyacını karşılar inşallah.

Kod:

(defun c:bhsp ()
; Basit hesaplama programları
; 2009 (c) Sinan COŞKUN
; Girdiğiniz sabit rakamı, seçeceğiniz (TEXT) Rakamlar ile hesaplar !
(setq 1r nil)
(setq pasGec 0)
(initget 1 "T Ç A B")
(setq islem (getkword "\nYapacağınız işlemi belirtiniz Toplama/Çıkarma/çArpma/Bölme <T/Ç/A/B> : "))
  (cond ((= islem "T")(setq fnk "Toplama")))
  (cond ((= islem "Ç")(setq fnk "Çıkarma")))
  (cond ((= islem "A")(setq fnk "Çarpma")))
  (cond ((= islem "B")(setq fnk "Bölme")))
(while (and(= 1r nil)(< pasGec 2))
  (setq 1r(getreal(strcat"\n"fnk" işlemi için Rakam giriniz :")))
   (if(= 1r nil)
     (progn
       (alert "\nRakam giriniz !")
       (setq pasGec (+ 1 pasGec))
     );progn sonu
     (setq pasGec 0)
   ); if sonu
); while sonu 
  (while (and(/= 1r nil)(< pasGec 2))
    (setq 2rob(entsel"\nİşlem görecek Texti seçiniz !"))
    (if (and(/= 2rob nil)(= (cdr(assoc 0(entget(car 2rob))))"TEXT"))
      (progn
       (setq 2rob(entget(car 2rob)))
       (setq 2r(atof(vl-string-subst "." ","(cdr(assoc 1 2rob)))))
       (cond ((= islem "T")(setq isle(rtos(+ 2r 1r)2 2)))); T ise topla
       (cond ((= islem "Ç")(setq isle(rtos(- 2r 1r)2 2)))); Ç ise çıkar
       (cond ((= islem "A")(setq isle(rtos(* 2r 1r)2 2)))); A ise çarp
       (cond ((= islem "B")(setq isle(rtos(/ 2r 1r)2 2)))); B ise böl
       (setq EskiTxt(cdr(assoc 1 2rob)))
       (setq deg(subst(cons 1 isle)(cons 1 EskiTxt)2rob))
       (entmod deg)
       (setq pasGec 0)
      );progn sonu
      (progn
      (alert "\nObje seçemediniz veya seçtiğiniz Obje 'TEXT' değil !")
      (setq pasGec (+ 1 pasGec))
      );
     );if sonu
   );while sonu
(princ"\n************************************
\nİşlem sonlandırıldı !
\nBasit hesaplama programları, 2009 (c) Sinan COŞKUN")
(princ)
)





arkadaşlar... çizimimde yeralan binlerce rakam var, bunları 100e bölmek istiyorum ve buradaki lisp işimi görüyor fakat tektek seçmek zorunda kalıyorum ve buda uzun zaman alıyor. bu lispi tekrardan çoklu seçim yapılabilecek şekilde revize edebilirmisiniz. lütfen çok acil ihtiyacım var...teşekkürer...

admin (11.12.2017 19:52 GMT)

> 1 <
Copyright © 2004-2022 SQL: 1.229 saniye - Sorgu: 49 - Ortalama: 0.02508 saniye