13.10.2005 20:02    

hceven99
Merhaba, lisp kodunu aşağıya yazıyorum;
Umarım işine yarar. İyi günler.

Kod:

(defun c:kn (/ nokta x y nokta_y yazi aciklama)
(prompt "
10/2005 © Ver 1.0 Koordinat yazımı.")
(setvar "CMDECHO" 0)

(while (= nokta nil)
  (setq nokta (getpoint "
Koordinatı alınacak noktayı girin: "))
    (if (= nokta nil) (princ "Bir nokta girmelisiniz..."))
)
  (setq x (car nokta)
        y (cadr nokta))

(setq aciklama (strcat "x:" (rtos x) " _ y:" (rtos y)))
  (princ aciklama)


  (setq nokta_y (getpoint ( strcat "
Yazının başlangıç noktasını girin /<Koordinat noktası>: ")))
    (if (= nokta_y nil) (setq nokta_y nokta))

(command "text" nokta_y "" "" aciklama)

(princ)
)

ehya (18.04.2009 13:47 GMT)

14.10.2005 08:43    

fausto
lisp için teşekkür ederim ,ama maalesef çalışmıyor. komut satırını aşağıya kopyaladım. birde x ve y yi yanyana değilde altalta yazma gibi bir şansımız varmı
?

Command: kmn
10/2005 © Ver 1.0 Koordinat yazımı.
Koordinatı alınacak noktayı girin: x:10395.156 _ y:-1631.806
Yazının başlangıç noktasını girin /<Koordinat noktası>: Unknown command
"X:10395.156 _ Y:-1631.806". Press F1 for help.
Command: *Cancel*

14.10.2005 09:23    

Sibay
Yukarıdaki lisp düzenlenerek aşağıya yazılmıştır. Kendinize göre düzenleyebileceğiniz yerler kırmızı ile gösterilmiştir. Fareyi bu kırmızı alanların üstüne getirerek ilgili açıklamayı okuyabilirsiniz.

(defun c:kn (/ nokta x y nokta_y yazi aciklama)
(prompt "
10/2005 © Ver 1.0 Koordinat yazımı.")
(setvar "CMDECHO" 1)

(while (= nokta nil)
(setq nokta (getpoint "
Koordinatı alınacak noktayı girin: "))
(if (= nokta nil) (princ "Bir nokta girmelisiniz..."))
)
(setq x (car nokta)
y (cadr nokta))

(setq aciklama (strcat "x:" (rtos x) " _ y:" (rtos y)))
(princ aciklama)


(setq nokta_y (getpoint ( strcat "
Yazının başlangıç noktasını girin /<Koordinat noktası>: ")))
(if (= nokta_y nil) (setq nokta_y nokta))

(command "text" "S" "STANDARD" nokta_y "3" "0" aciklama)

(princ)
)

14.10.2005 20:28    

hceven99
Merhaba, kodun düzenlenmiş yeni hali aşağıdadır.
AutoCad 2004 ve üzeri versiyonlarda yazım hatası vermemesi gerekiyor.
Yinede Koordinatı yazım esnasında hata oluşursa
( ;************** değiştirilebilir bölüm ) alanı içerisinde bulunan satırların başlarında bulunan noktalı virgülleri (;) silip, üstlerinde bulunan satırların başına koymalısın. iyi günler.

Kod:

(defun c:kn (/ gec_stil gec_yuk nokta_yakala aralik bilgi nokta x y nokta_y nokta_2 nok_y x_koor y_koor x_1 y_1 yazi aciklama)
(prompt "
10/2005 © Ver 2.0 Koordinat yazımı.")

(setvar "CMDECHO" 0)
(setq gec_stil (getvar "TEXTSTYLE"))
(setq gec_yuk ( getvar "TEXTSIZE"))
(setq nokta_yakala (getvar "OSMODE"))


(setq aralik (* gec_yuk 1.618))

(setq bilgi (strcat "
Aktif yazı stili <" gec_stil "> / yüksekliği <" (rtos gec_yuk) "> dir."))
(princ bilgi)

(while (= nokta nil)
  (setq nokta (getpoint "
Koordinatı alınacak noktayı giriniz: "))
    (if (= nokta nil) (princ "Bir nokta girmelisiniz..."))
)
  (setq x (car nokta)
        y (cadr nokta))

(setq x_koor (strcat "x:" (rtos x) "_" ))
(setq y_koor (strcat "y:" (rtos y)))
(princ x_koor) (princ y_koor)

  (setq nokta_y (getpoint ( strcat "
Yazının başlangıç noktasını giriniz /<Koordinat noktası>: ")))
    (if (= nokta_y nil) (setq nokta_y nokta))

  (setq x_1 (car nokta_y)
        y_1 (cadr nokta_y))

(setq nok_y (- y_1 aralik))
(setq nokta_2 (list x_1 nok_y))

(setvar "OSMODE" 0)

;;;******************************** değiştirilebilir bölüm

(command "text" nokta_y "" "" x_koor)
;(command "text" "S" "STANDARD" nokta_y "" "0" x_koor)

(command "text" nokta_2 "" "" y_koor)
;(command "text" "S" "STANDARD" nokta_2 "" "0" y_koor)

;;;*********************************

(setvar "OSMODE" nokta_yakala)
(princ)
)

ehya (18.04.2009 13:48 GMT)

17.10.2005 07:12    

fausto
teşekkürler arkadaşlar,sayenizde sorun çözümlendi...
artık bende lisp yazmak için çalışmaya başlayacağım,umarım bi şeyler yapabilirim..

25.10.2005 05:56    

erolkahveci
ÖNCELİKLE SİTE İÇİN TEŞEKKÜRLER....Benim daha önce siteden bir arkaştan aldığım bir lispim var... bu lisp ayrı ayrı çizilmiş plyline ların alanlarını toplayıp daha önceden belirlediğim bir yere yine benim yanına eklediğim açıklamayla toplayıp yazıyor... bu lispte şu şekilde bir düzeltme yapabilir miyiz?.. bu lispin başına yine ayarlarını benim yapabileceğim bir "-hatch" komutu eklenebilir mi? Enson alanı hesaplanacak yeri seçtiğimde hem alanı toplayıp yazacak hemde bu çizgilerin içini dolduracak... Biraz acilde yardımcı olursanız sevirim... herşey için şimdiden teşekkürler....lisp şu şekilde ;

Kod:

defun c:alanc (/ yuksek a1b nokta deger yaz akyuk ciz_bir yaz_bir yazi_1 yazi_1_gir alan alan_t)
(prompt "
12/1998 © Ver 2.1 Alan hesabı ve yazımı.")
   (setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))


(setq yazi_1 (getstring T "
Alan bölümü için yazıyı girin <Alan: >: "))
(if (= yazi_1 "")(setq yazi_1 "Alan: "))

(while (and (/= ciz_bir "MM")(/= ciz_bir "CM")(/= ciz_bir "M"))
  (setq ciz_bir (strcase (getstring "
Çizilen birim <mm>/cm/m :")))
    (if (= ciz_bir "")(setq ciz_bir "MM"))
      (if  (and (/= ciz_bir "MM")(/= ciz_bir "CM")(/= ciz_bir "M"))
        (princ "
   *Geçersiz klavye girişi...")
      )
)
(setq y_d 0)
   (cond
        ((= ciz_bir "MM")(setq ciz_d 1000))
        ((= ciz_bir "CM")(setq ciz_d 10))
        ((= ciz_bir "M")(setq ciz_d 0.001))
   )
(yaz_bir_bol)
  (princ)
  )


(defun yaz_bir_bol ()
 


(while (and (/= yaz_bir "MM")(/= yaz_bir "CM")(/= yaz_bir "M"))
  (setq yaz_bir (strcase (getstring "
Yazılması istenen birim kare mm/cm/<m> :")))
    (if (= yaz_bir "")(setq yaz_bir "M"))
      (if  (and (/= yaz_bir "MM")(/= yaz_bir "CM")(/= yaz_bir "M"))
        (princ "
   *Geçersiz klavye girişi...")
      )
)

   (cond
        ((= yaz_bir "MM")(progn (setq yaz_d 1000)(setq br "mm")))
        ((= yaz_bir "CM")(progn (setq yaz_d 10)(setq br "cm")))
        ((= yaz_bir "M")(progn (setq yaz_d 0.001)(setq br "m")))
   )

  (yaz_bil_gir)
  )


(defun yaz_bil_gir ()
(setq crp_d (rtos (/ ciz_d yaz_d) 2 7))
(setq yuksek (getdist (strcat "
Aktif yazi stili<" akstl ">/Yazinin yuksekligini giriniz <" (rtos akyuk) ">: ")))
         (if (= yuksek nil)
        (setq yuksek akyuk)
       )
       (princ (strcat "Belirlenen yukseklik <" (rtos yuksek) "> dir."))


  (yaz_bol)
)


(defun yaz_bol ()
   (setq a1b 0)
   (setq alan 0)
   (setq alan_t 0)
    (while (/= a1b nil)
       (setq a1b (car (entsel "
Objeyi seçiniz: ")))
       (if (/= a1b nil)
         (progn
           (setq ayar (entget a1b))
           (setq oz (cdr (assoc 0 ayar)))
             (if (or (= oz "LWPOLYLINE") (= oz "CIRCLE") (= oz "ARC"))
               (progn
                 (redraw a1b 3)
                 (command "area" "o" a1b)
                 (setq alan_t (getvar "area"))
(setq alan (+ alan alan_t))
(princ "Toplam alan: ")(princ alan)
                   
       )
         ;(if (/= a1b nil) (redraw a1b 4))
       (princ (strcat "
Seçilen obje Lwpolyline değil, " oz " dir."))
    )
)
       )
    )
    (if (= y_d 0)
                      (setq crp_d (atof crp_d))
                    )
  (setq deger (/ alan crp_d))
                 (princ (strcat "
Alan: " (rtos deger)" " br "2 dir."))
     (while (= nokta nil)
             (setq nokta (getpoint "
Yazının başlangıç noktasını giriniz : "))
                   (if (= nokta nil)(princ "  Birnokta girmelisiniz..."))
                   )


(command "regen")
        (setq yazi (strcat yazi_1 (rtos deger) " " br "2"))
(princ "
Yazi: ")(princ yazi)
          (command "text" nokta yuksek "" yazi)
          (setq nokta nil)
        (setq y_d 1)

  (princ "
İşlem bitti.")
(princ)
)

ehya (12.09.2008 20:33 GMT)

25.10.2005 06:33    

ehya
Eklenmesine eklenir ama, bu tarama türü ve ölçeği konusunda bi bilgi verilmemiş. Bu konuda bilgi verirsen sevinirim.

25.10.2005 07:35    

hceven99
Merhaba Erol, umarım iyisindir.
Tarama işini yaptırabilirsin. Ama daha kolay olması için lisp i çalıştırmadan bir defa istedğin tarama şeklini ve ölçeğini ayarlayıp boş bir şekli tarat. Bunun sayesinde komutu girişinde tarama ayarları yapmana gerek kalmaz.

(command "area" "o" a1b)

(command "bhatch" "s" a1b "" "")

(setq alan_t (getvar "area"))

üst kısımda yazdığım üst ve altdaki iki satırın arasına ortada yazdığım bölümü ekle.
aksilik olursa arayabilirsin. msn adresimi biliyorsun. kolay gelsin

25.10.2005 15:14    

erolkahveci
teşekkürler şimdilik problemim çözüldü.. bizde öğrenebilsek.. ne güzel olur...

07.11.2005 13:39    

ecetinkol
arkadaşlar merhaba daha önceden "nodegis" diye bir lisp vardı. burada numaralar istediğimiz sayıdan başlayıp birer artarak devam ediyordu. kullanıyorum ve çok işime yarıyor. yapan arkadaşlara teşekkür ederim. Benim bir ricam olacak bu lisp'i yine birer artarak ve bizim belirleyeceğimiz bir harfle yani
örnek: A1 A2 A3 gibi yapabilir misiniz. Teşekkür ederim.

08.11.2005 09:35    

Sibay
1,2,3, ... diye rakamları sıraladıktan sonra başına veya sonuna istediğiniz yazıyı ekleyebilirsiniz...

Aşağıdaki lisp Derya KILIÇ tarafından kodlanmıştır.

Kod:

(defun c:tekle(/ ekyazi i obj elist ename)
  (princ "
İşlenecek yazıları seçiniz :")
  (if (setq obj (ssget '((0 . "TEXT"))))
    (if (/= "" (setq ekyazi (getstring "
Eklenecek Yazı :")))
    (progn
  (initget "Bas Son")
  (setq tercih (getkword "Başına mı Sonuna mı? [Bas/Son] <B> :"))
  (if (null tercih) (setq tercih "B"))
          (command "undo" "begin")
          (setq i 0)
          (while (setq ename (ssname obj i))
            (setq elist (entget ename)
                      i (1+ i)
            )
            (if (= tercih "B")
      (setq elist (subst (cons 1 (strcat ekyazi (cdr (assoc 1 elist)))) (assoc 1 elist) elist))
      (setq elist (subst (cons 1 (strcat (cdr (assoc 1 elist)) ekyazi)) (assoc 1 elist) elist))
    )
            (entmod elist)
          );_while
          (command "undo" "end")
       );_progn
     );_if
  );_if
);_tdeg

08.11.2005 15:55    

ecetinkol
Teşekkür ederim.Yalnız bir sorun var. Her iki şekilde de harfi sonuna ekliyor.
Bu sorunu da giderebilirseniz sevinirim.

10.11.2005 22:13    

istanbul61
Arkadaşlar kolay gelsin. Ekrandan seçilen birkaç tane yazıyı değiştirecek kodu nasıl yazarım. Mesela Seçtiklerim yazılardaki "Tane" yazılarını "Taze" yapmak. Find / Replace gibi. Şimdiden teşekkürler.

11.11.2005 07:44    

ehya
;;;Bu istediğini bir lisp üzerinde anlatmak sanırım daha iyi olur.




(defun c:yazideg (/ yazi_ne) ;;; komut ismi yazideg
(setq yazi_ne (getstring t "Aranacak yazı:")) ;;; ekranda aranacak yazı
(setq yazi_ss (getstring t "Yeni Yazı:")) ;;; yeni yazılacak yazı
(setq yazi_sec (ssget (list (cons 1 yazi_ne)))) ;;; seçim yaptığın takdirde sadece aradığın yazıların seçilmesini sağlar
(if (= yazi_sec nil)
(progn
(princ " Seçim yok!!!"))
(progn
(setq c 0) ;;; döngü oluşturacak. bunun için bir tanım yapıldı
(setq yazi_adet (sslength yazi_sec)) ;; değişecek yazıının adeti
(while (< c yazi_adet) ;; değişecek yazı adetine göre döngü oluşturuldu
(setq yazi_tek (ssname yazi_sec c)) ;; seçilen yazılardan bir tanesi seçildi
(setq yazi_1a (cdr (assoc 1 (entget yazi_tek)))) ;; seçilen yazının mevcut değeri bulundu
(setq yazi_deg (entget yazi_tek)) ;; seçilen yazının database'i açıldı
(setq yazi_deg (append yazi_deg (list (cons 1 yazi_ss)))) ;; verilen yeni yazıya göre mevcut yazı değiştirildi
(entmod yazi_deg);; işlem uygulandı
(redraw)
(setq c (+ c 1)) ;; döngü için c değeri +1 arttırıldı )))(princ))

ehya (06.10.2007 08:10 GMT)

11.11.2005 10:42    

istanbul61
ehya arkadaşım ilgine ve emeğine çok teşekkür ediyorum. Çok güzel olmuş. Ben ne istediğimi tam anlatamadım. Kelimeyi komle değişmek değil de içinden bir harfi bulup değiştirmek istiyorum. Yani farklı kelimeler seçecek ve bu kelimelerin içindeki bir harfi değiştirecek. Mesela "Teşekkür ederim" kelimesinde "e" harfini "İ" yap deyince "Tİşİkkür İdİrim" yapacak.

12.11.2005 07:58    

ehya
;; istediğine göre yeni bir lisp hazırladım. açıklaması yanında. oluşabilecek hatalara karşı kod yazmadım. yazdıkça lisp uzar, malum vakit... :)


(defun c:harfdeg ()
(setq harfdeg_sec (ssget (list (cons 0 "TEXT")))) ;;; sadece yazı seçimi yapıldı (if (= harfdeg_sec nil)
(progn
(princ "
Seçim Yok!!!"))
(progn
(setq harf_ara (getstring "
Aranacak harfi girin:")) ;;; aranacak harf isteniyor
(setq deg_harf (getstring "
Yeni harfi girin:")) ;;; yeni harf isteniyor

(setq harfdeg_say (sslength harfdeg_sec)) ;;; seçilen yazıların adeti
(setq c 0)
(while (< c harfdeg_say) ;;; seçilen yazı adedine göre döngü oluşturuluyor
(setq harfdeg_tek (ssname harfdeg_sec c)) ;; seçilen yazılardan bir tanesi alınıyor
(setq harfdeg_ne (cdr (assoc 1 (entget harfdeg_tek)))) ;;;; ilk alınan yazının ne olduğu öğreniliyor
(setq harfdeg_yeni "" hc 1)

(repeat (strlen harfdeg_ne) ;;; ilk alınan yazının karakter sayısı kadar ikinci bir döngü oluşturuluyor
(setq tek_tek (substr harfdeg_ne hc 1)) ;; ilk alınan yazının harfleri tek tek alınıyor
(if (= tek_tek harf_ara)
(progn ;; seçilen harf aranan harfle karşılaştırılıyor
(setq ss_harf deg_harf)) ;; aynı ise yeni harf uygulanıyor
(progn
(setq ss_harf tek_tek))) ;; değil ise mevcut harf aynı bırakılıyor
(setq harfdeg_yeni (strcat harfdeg_yeni ss_harf)) ;; bakılan harf bir dizgi olarak hazırlanıyor
(setq hc (+ hc 1))
)
(setq dd_yazi (entget harfdeg_tek)) ;; seçilen yazının database'i açılıyor
(setq dd_yazi (append dd_yazi (list (cons 1 harfdeg_yeni)))) ; yeni hazırlanan yazı ile değiştiriliyor
(entmod dd_yazi) ;; yeni yazı uygulanıyor
(setq c (+ c 1))
)
))(princ))

12.11.2005 10:17    

istanbul61
Walla kardeşim denedim süpeeeeerrrrrr. Lisp i ilk duyduğum andan itibaren böyle bişe yapmaya çalışıyordum. Sana nekadar teşekkür edeceğimi bilemiyorum. Ayrıca bu siteyi kuranlarıda tebrik ediyorum ve helal olsun diyorum. Bilgi paylaştıkca çoğalır. İnşallah ilerleyen zamanlarda benim yazdığım lispleride burada göreksiniz diyorum ve saygılar sunuyorummmm.:yes

10.12.2005 15:04    

soner001
ehya lisp yazi degişte lips si bende düzgün calışmıyor.. yazıyı buluyor yanına yeni istenen yazıyı ekliyor ..

örnegin aaa yı bbb ile degiş dedigim zaman aaabbb yapıyor nasıl düzelte biliriz bunu ?

22.12.2005 11:58    

istanbul61
soner001 arkadaşım bende düzgün çalışıyor. İstersen özelime mail adresini yaz sana lisp dosyasını mail atayım.

23.12.2005 06:44    

sis
arkadaşlar bana niye kimse cevap vermiyor. Benim kesitte kot verebilecek bir lispe ihtiyacım var Yani zeminden başlayarak 0.00 kotundan istediğim her noktaya kot yazabilecek bir lisp.Böyle bir lisp yokmudur ben boşunamı arıyorum acaba :satisfied

Önceki Sayfa [1] > 2 < [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.162 saniye - Sorgu: 99 - Ortalama: 0.01174 saniye