24.12.2005 09:56    

Merhaba, Aşağıda Kot ve Polyline uzunluğu yazan lispin kodunu yazıyorum. Umarım yazacağım kodlar arkadaşların işine yarar.
Kot lispi komutu: kot
Polyline lispi komutu: plu
Komutlardan önce yazı stili ve yüksekliğini ayarlamalısınız. Çünkü aktif stil ve yükseklikde yazılar yazılacaktır. Kot lispinde komut bitiriminde hata verebilir. Önemli değil, şu an işinizi görsün diye yazıyorum. Düzelttiğimde yeni kodu yazarım.

Yorum yapabilirsiniz. Şöyle olsa... , şu da olsa .... gibi.

(not: Arkadaşlardan bir isteğim olacak, herhangi bir konuda yardım istendiği zaman mümkün olduğu kadar sade ve açıklayıcı yazmaya çalışsınlar. Ayrıca kullandıkları Autocad versiyonlarını yazsınlar.)
Herkese kolay gelsin.

Kot yazımı:

(defun c:kot (/ gec_stil gec_yuk bilgi nokta nokta_k baz_nok kot_nok kot)
(prompt "
12/2005 © Ver 1.0 Kot yazımı.")

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

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

(while (= nokta nil)
(setq nokta (getpoint "
0,00 noktasını seçiniz: "))
(if (= nokta nil) (princ "Bir nokta seçmelisiniz..."))
)

(command "text" nokta "" "" "±0,00")

(setq baz_nok (cadr nokta))
(setq nokta_k 0)

(while (/= nokta_k nil)
(setq nokta_k (getpoint "
Kotu yazılacak noktayı giriniz: "))
(setq kot_nok (cadr nokta_k))
(setq kot (- kot_nok baz_nok))
(setq yazi (rtos kot))
(command "text" nokta_k "" "" yazi)

)
(princ)
)

*****************************

Polyline yazımı:

(defun c:plu(/ akyuk akstla1b ayar oz p-uzunluk baz-nok y_d)
(prompt "
12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(setq akyuk (getvar "TEXTSIZE"))
(setq akstl (getvar "TEXTSTYLE"))
(setq a1b 1)


(while (/= a1b nil)
(setq a1b (car (entsel "
Polyline ı seçiniz: ")))
(if (/= a1b nil)
(progn
(setq ayar (entget a1b))
(setq oz (cdr (assoc 0 ayar)))
(if (= oz "LWPOLYLINE")
(progn
(redraw a1b 3)
(command "area" "o" a1b)
(setq p-uzunluk (getvar "perimeter"))
(setq baz-nok (cdr (assoc 10 ayar)))

(princ (strcat "
Uzunluk: " (rtos p-uzunluk)" dir."))

(setq yazi (strcat "L: " (rtos p-uzunluk)))

(command "text" baz-nok "" "" yazi)
(setq baz-nok nil)
(setq y_d 1)
(if (/= a1b nil)
(redraw a1b 4))
)
(princ (strcat "
Seçilen obje Polyline değil, " oz " dir."))
)
))
)
(princ "
İşlem bitti.")
(princ)
)


*********************
polyline bölümünün komutu c:plu olarak gözüküyor, "c : p l u" (aralarda boşluk olamadan) olacak

09.04.2008 12:46    

Polyline ile ilgili çizimini veya resmi görebilirmiyiz ?

09.04.2008 13:34    

Alıntı

---

serhatgokhan :
tabi... plu komutunu verip polyline'a tikladigimda yaziyi ortasina yazsin istiyorum...

---

soldaki girintili-çıkıntılı polyline işi bozuyor !
ama bir deneme yaparız..

09.04.2008 14:39    

Çalışma mantığı biraz değişti ama işini görür.
biraz incele bakalım..

(defun c:pluz()
(prompt"\n12/2005 © Ver 1.0 Polyline uzunluğu yazımı.")
(setvar "cmdecho" 0)
(while
(setq bpn(getpoint"\nPolyline çevrili alanın içine bir nokta işaretleyin !.."))
(command "BPOLY" bpn "")
(setq a1b(entlast))
(setq ayar(entget a1b))
(command "area" "o" a1b)
(entdel(entlast))
(setq p-uzunluk(getvar "perimeter"))
(setq yazi(strcat "L: "(rtos p-uzunluk)))
(command "text" bpn "" "" yazi)
)
)

09.04.2008 14:54    

Alıntı

---

serhatgokhan :
cok guzel olmus ellerine saglik :) ama ufak bi sorun var; dogru sonuc vermesi icin alanin icinin tamamen bos olmasi gerek gibi gorunuyor...

soyle yapabilirmiyiz: once, olcmek istedigimiz polyline'i secip ondan sonra yazi icin yer gostersek...

---

Verdiğin resime göre düşündüm, Bpoly komutu için alanın içi boş olması gerekiyor !
dediğin şekilde de yapılabilir ama ben tıklama (işlem) sayısını en aza indirmeye çalışıyorum !

10.04.2008 07:40    

(defun c:pluz()
(setvar "cmdecho" 0)
(setq a1b nil)
(while
(setq a1b(car(entsel"\nPolyline seçiniz: ")))
(setq ayar(entget a1b))
(setq oz (cdr(assoc 0 ayar)))

(if(/= oz "LWPOLYLINE")
(alert"\nSeçtiğiniz Obje Polyline değil !")
(progn
(redraw a1b 3)
(setq bpn(getpoint"\nYazı için nokta işaretleyin !.."))
(setq ayar(entget a1b))
(command "area" "o" a1b)
(setq p-uzunluk(getvar "perimeter"))
(setq yazi(strcat "L: "(rtos p-uzunluk)))
(command "text" bpn "" "" yazi)
(redraw a1b 4)
);progn sonu
);if
);while
(princ)
);defun

10.04.2008 08:06    

güle güle kullan...

30.07.2011 20:06    

mumtazak

lisp yazarken tıklandığınızı söylemişsiniz ancak lisp isteğinde bulunmuşsunuz.
madem lisp yazarken tıkandınız, kendinizi geliştirmek için yardım isteseniz daha iyi olmaz mı?

31.07.2011 15:10    

11.11.2015 17:30    

Merhaba arkadaşlar . Ben metraj hazırlıyorum da . polyline hattımın üstüne uzunluğunu yazdırmak istiyorum . netcad kullananlar bilir uzunluk yazdır komutu var . onun gibi birşey var mıdır acaba .