Yıldız çizen lisp kodları | Forumlar

AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim

aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A

Forumlar > AutoLISP > Yıldız çizen lisp kodları

30.12.2011 20:31

akcan

Lisp kodlarını daha yeni öğrenirken aklıma gelen bir uygulama üzerinde çalıştım
Oluşan kodlar aşağıda. İnternette bu işi yapan bir kod bulamadım.

Aşağıdaki kodları inceleyip yorumlarsanız sevinirim

Kod:

; Yarıçapı verilen ve merkezi belirtilen noktaya Yıldız çizer
; Mesut Akcan
; akcansoft.blogspot.com
; 30/12/2011

(defun c:yildiz ()
(setq r (getreal "\nYarıçapı giriniz :"))
(setq k1 (* r 1.9021))
(setq k (rtos k1 2 2))
(setq c (getpoint "\nYıldız merkezini seçiniz : "))

(command "line" "_from" c)
(setq p (STRCAT "@" (rtos r 2 2) "<-126"))
(command p)
(setq p (STRCAT "@" k "<36"))
(command p)
(setq p (STRCAT "@" k "<180"))
(command p)
(setq p (STRCAT "@" k "<-36"))
(command p)
(setq p (STRCAT "@" k "<108"))
(command p)
(command "c")
(princ)
)

akcan (30.07.2020 10:59 GMT)

67233

31.12.2011 01:08

ProhibiT

Bu yazılan AutoLisp'ten çok Script olmuş...

Sizin mantığınızı koruyarak;

Kod:

(defun c:yildiz (/ c r k p)
(setvar "cmdecho" 0) (command "undo" "group")
(setq c (getpoint "\nYıldız merkezini seçiniz : ")
r (getreal "\nYarıçapı giriniz :")
k (* 1.9021 r))
(command "_.pLine"
(setq p (polar c 4.08407 r))
(setq p (polar p 0.628319 k))
(setq p (polar p pi k))
(setq p (polar p 5.65487 k))
(polar p 1.88496 k) "c")
(command "undo" "e") (prin1)
)

şeklinde yazmak daha doğru olurdu. Burada pLine yerine Line'da kullanılabilir. command gurubunun dışındaki ve içindeki setq direktifleri arasındaki farka dikkat çekmek isterim.

AutoLisp ruhuna daha da uygun olması için;

Kod:

(defun c:yildiz (/ c r k p)
(setvar "cmdecho" 0) (command "undo" "group")
(setq c (getpoint "\nYıldız merkezini seçiniz : ")
r (getreal "\nYarıçapı giriniz :")
k (* 1.9021 r))
(entmake
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0)
(cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.0)
(cons 38 0.0) (cons 39 0.0)
(cons 10 (list (car (setq p (polar c 4.08407 r))) (cadr p)))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)
(cons 10 (list (car (setq p (polar p 0.628319 k))) (cadr p)))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)
(cons 10 (list (car (setq p (polar p pi k))) (cadr p)))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)
(cons 10 (list (car (setq p (polar p 5.65487 k))) (cadr p)))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)
(cons 10 (list (car (setq p (polar p 1.88496 k))) (cadr p)))
(cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 91 0)))
(command "undo" "e") (prin1)
)

şeklinde yazılırsa daha dengeli bir fonksiyon olur.

Bunun biraz farklı bir şeklini daha önce yazmıştım.

Linkleri görebilmek için ÜYE olmalısınız.

linkine bir göz atmanızı tavsiye ederim.

67243

31.12.2011 12:09

akcan

kodlar için teşekkür ederim
bu kadar ileri seviye lisp bilmiyorum.
başlangıç olarak öğrendiğim temel bilgilerle oluşturduğum kodlardı onlar.

ayrıca kafa takılan bir nokta
command yanında bir değişkeni nasıl kullanacağım?
örneğin
(command "line @" r "<30")
yada
(command "line" "@" r "<30")
gibi satırlar hata veriyor.

67246

31.12.2011 13:04

ehya

şahin hocam yok. Ben cevaplayayım.

Comman içinde bir değer girilecek ise öncelikle sayısal değer string olmalı. Eğer değil ise string'e çevirilmeli.

string dediğim sayı tırnak içinde olmalıdır.

örneğin : (setq r "150")

eğer değil ise bunu string'e çevireceksiniz.. bunun için rtos komutu kullanılır. Bununla ilgili örneği yukarıda yazdığınız örnek kod ile cevaplayayım.
Ek olarak bir değer girilecek ise bu değerler birleştirilmeli. Sizin yazdığınız gibi tek tek verilemez.

(command "_.line" (strcat "@" (rtos r 2 2) "<30"))

Bu satırdaki farklılıkları açıklacak olursak
Strcat komutu stringleri birleştirmek için kullanılır.
Rtos komutu sayıyı string'e çevirir. Sonundaki 2 2 değeri ise, birinci 2 değeri sonucun "Decimal" yani ondalıklı sonuç vermesini istediğimizi, ikincisi ise virgülden sonra 2 basamak küsürat kullanmasını istediğimizi belirtir.

67248

31.12.2011 16:00

ProhibiT

Teşekkür ederim Mehmet hocam :)

akcan arkadaşımızın çabalarında destek vermek, gelişimine katkıda bulunmak adına, "Command yanında değişken kullanmak" kavramına biraz daha açıklık getirmek gerekiyor sanıyorum.

Command ile beraber kullanılan AutoCAD komutunun bekledikleri (parametreleri) vardır.
(command "_.Line".... örneğini ele alırsak, parametreleri; from point, to point,...
Command'in parametreleri ille de komut satırından girdiğimiz formatta olmak zorunda değil, hatta o formatta olmamalıdır.
bu parametreleri Command dışında hazırlamak daha doğrudur.
(setq frpt (polar (getpoint) 30 r))
(command "_.Line" frpt (getpoint) "") şeklinde kullanılabilir.
derli toplu yazarsak; (command "_.Line" (polar (getpoint) 30 r)) (getpoint) "") şekline gelir.

Sonuç olarak, AutoLisp içinde kullandığınız command formatı, komut satırından girdiğinizle aynı değildir. Aksi halde yazdığımız fonksiyon olmaz, ilk mesajımda yazdığım gibi script olur.

AutoLisp sözdizimi (syntax) ve mantığı konusunu iyice hazmetmekte fayda var. Aksi halde, elle yapılan işlemleri, gurup komutları olarak AutoLisp (aslında DIESEL expression) ile yaptırmaktan ileri gidilemez, gelişme sağlanamaz.

Bu kapsamda, örnek olarak ele aldığımız yildiz çizdirme fonksiyonunda, sizin kurduğunuz algoritma üzerinden giderek açıklamaya çalıştığım. Böyle olunca da çizilen yıldız aslında kusursuz değil. Programa başlangıçta bazı katsayılar verdiğimizde, eninde sonunda reel sayıların ondalık hassasiyetinden kaynaklanan hatalar olur.

Öncelikle el ile çiziyormuş mantığını unutup, programatik mantıkla algoritma iyi kurulmalı.
Bu yazdıklarımı örneklemek gerekirse;

Kod:

(defun c:yildiz (/ a1 a2 m1 m2 m3 m4 p0 n r p dx dy)
(setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
(setq a1 (* (/ 18.0 180) pi) a2 (* 4 a1) a1 (- a1 a2) n nil m nil
m1 '(40 . 0.0) m2 '(41 . 0.0) m3 '(42 . 0.0) m4 '(91 . 0) p0 '(0 0)
r (getreal "\n Yarıçap: "))
(repeat 5 (setq n (append n (list (polar '(0 0) (setq a1 (+ a1 a2)) r)))))
(entmake
(list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 67 0)(cons 39 0.0)
(cons 100 "AcDbPolyline") (cons 90 10) (cons 70 1)(cons 43 0.0)(cons 38 0.0)
(cons 10 (nth 0 n)) m1 m2 m3 m4
(cons 10 (nth 2 n)) m1 m2 m3 m4
(cons 10 (nth 4 n)) m1 m2 m3 m4
(cons 10 (nth 1 n)) m1 m2 m3 m4
(cons 10 (nth 3 n)) m1 m2 m3 m4))
(while (/= (car (setq p (grread T 1))) 3)
(setq p (cadr p) dx (- (car p) (car p0)) dy (- (cadr p) (cadr p0)))
(vla-transformby
(vlax-ename->vla-object (entlast))
(vlax-tmatrix
(list (list 1 0 0 dx) (list 0 1 0 dy) '(0 0 1 0) '(0 0 0 1))))
(setq p0 p) (redraw (entlast) 3))
(redraw (entlast) 4) (command "undo" "e") (prin1)
)

şeklinde yazılırsa yıldızımız hatasız çizilmiş olur.

Bir adım daha ilerlersek;

Kod:

(defun c:yildiz (/ a1 a2 m1 m2 m3 m4 p0 n m r p dx dy)
(setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
(setq a1 (* (/ 18.0 180) pi) a2 (* 4 a1) a1 (- a1 a2) n nil m nil
m1 '(40 . 0.0) m2 '(41 . 0.0) m3 '(42 . 0.0) m4 '(91 . 0) p0 '(0 0)
r (getreal "\n Yarıçap: "))
(repeat 5 (setq n (append n (list (polar '(0 0) (setq a1 (+ a1 a2)) r)))))
(setq m (append m (list (inters (nth 0 n) (nth 2 n) (nth 1 n) (nth 4 n))))
m (append m (list (inters (nth 1 n) (nth 3 n) (nth 2 n) (nth 0 n))))
m (append m (list (inters (nth 2 n) (nth 4 n) (nth 3 n) (nth 1 n))))
m (append m (list (inters (nth 3 n) (nth 0 n) (nth 4 n) (nth 2 n))))
m (append m (list (inters (nth 4 n) (nth 1 n) (nth 0 n) (nth 3 n)))))
(entmake
(list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 67 0)(cons 39 0.0)
(cons 100 "AcDbPolyline") (cons 90 10) (cons 70 1)(cons 43 0.0)(cons 38 0.0)
(cons 10 (nth 0 n)) m1 m2 m3 m4 (cons 10 (nth 0 m)) m1 m2 m3 m4
(cons 10 (nth 1 n)) m1 m2 m3 m4 (cons 10 (nth 1 m)) m1 m2 m3 m4
(cons 10 (nth 2 n)) m1 m2 m3 m4 (cons 10 (nth 2 m)) m1 m2 m3 m4
(cons 10 (nth 3 n)) m1 m2 m3 m4 (cons 10 (nth 3 m)) m1 m2 m3 m4
(cons 10 (nth 4 n)) m1 m2 m3 m4 (cons 10 (nth 4 m)) m1 m2 m3 m4))
(while (/= (car (setq p (grread T 1))) 3)
(setq p (cadr p) dx (- (car p) (car p0)) dy (- (cadr p) (cadr p0)))
(vla-transformby
(vlax-ename->vla-object (entlast))
(vlax-tmatrix
(list (list 1 0 0 dx) (list 0 1 0 dy) '(0 0 1 0) '(0 0 0 1))))
(setq p0 p) (redraw (entlast) 3))
(redraw (entlast) 4) (command "undo" "e") (prin1)
)

şeklinde yazarak yıldızımız kusursuz şekilde çizilmiş olur.

Kolay gelsin.

67254

01.01.2012 09:44

akcan

detaylı açıklamalarda bulunan arkadaşlara çok çok teşekkür ederim.
son verilen kodlar çok iyi. daha hoş olmuş.
tabi benim bu kodları anlamam için biraz daha ekmek yemem gerekiyor :)

67255

01.01.2012 14:20

ProhibiT

O kadar karmaşık değiller, ekmek yemeyle de ilgileri yok. Kodlama ve sözdizim detaylarını geçer, işin özüne gelirsek;
- İlk örnekte, yıldızımız 5 bacaklı olduğuna göre, yıldızın uç noktaları arasında, 360/5=72 derecelik açılar olacaktır.
- Yıldızımızın bir köşesinin tam üstte (90 derecede) olmasını öngördüğümüze göre, ilk köşe, 90-72=18 dereceden başlamalıdır.
- 72'şer derecelik artışlarla, 18, 90, 162, 234 ve 306 dereceleri kullanarak, merkezden bu doğrultularda yarıçap uzunluğunda mesafelerde olan 5 nokta belirlendikten sonra, 0-2-4-1-3-0 sırasıyla noktalarımızı birleştirdiğimizde yıldız ortaya çıkıyor.

- ikinci örnekte de, yıldızın dış köşelerini ilk örnekteki gibi oluşturduktan sonra, 0-2 ile 4-1 noktalarıyla tanımlı doğruların kesişim (intersection) noktaları iç köşeleri verecektir. Sıralı olarak, dış-iç-dış-,ic-... şeklinde başladığımız noktaya kadar birleştirdiğimizde yıldızımız ortaya çıkacaktır.

- Burada örnek olması bakımından, 0,0,0 noktasını merkez alıp, girilen çapta yıldızı oluşturduktan sonra, cursor koordinatlarını okutup, transformation matrix kullanarak, sürükle-bırak türü bir işlem ile yıldızı son yerine yerleştiriyoruz.

Görüldüğü gibi doğru bir algoritma kurulunca kodlaması angarya artık...

86391

10.06.2018 12:22

akcan

transformation matrix 'in autocad VBA da karşılığı var mıdır

86392

11.06.2018 06:53

ehya

akcan

Linkleri görebilmek için ÜYE olmalısınız.

87437

15.06.2019 13:10

akcan

bu soruyu sormak için epey zaman oldu ama
bana vba'da gerekli olan şey "transformation matrix" değil galiba
gerekli olan şey: çizimin ekrana basılmadan önce fare imlecinde belirmesi ve tıklanınca çizim alanına aktarılması
bu özellik VBA'da var mı? nasıl yapılır?

2. bir soru:
Aşağıdaki kodları VBA da yazdım
1. noktayı tıklayıp 2. noktayı tıklamaya geçince fare konumuna göre oluşacak dikdörtgenin geçici görüntüsü oluşabilir mi?
Aynı CIRCLE komutunu kullanırken olduğu gibi. Komutu verip Daire Merkezini tıkladıktan sonra oluşacak daire beliriyor.

Kod:

Sub Dikdortgen()
With ThisDrawing.Utility
n1 = .GetPoint(, "Birinci köşe:")
n3 = .GetPoint(n1, "Çapraz karşı köşe:")

n2 = n1
n2(0) = n3(0) '2. noktanın x'i = 3. noktanın X

n4 = n1
n4(1) = n3(1) '4. noktanın Y'si = 3. noktanın Y'si
End With
With ThisDrawing.ModelSpace
Set lineObj = .AddLine(n1, n2)
Set lineObj = .AddLine(n2, n3)
Set lineObj = .AddLine(n3, n4)
Set lineObj = .AddLine(n4, n1)
End With
End Sub

88785

18.02.2021 09:43

akcan

Alıntı
ProhibiT :
- Burada örnek olması bakımından, 0,0,0 noktasını merkez alıp, girilen çapta yıldızı oluşturduktan sonra, cursor koordinatlarını okutup, transformation matrix kullanarak, sürükle-bırak türü bir işlem ile yıldızı son yerine yerleştiriyoruz.

Görüldüğü gibi doğru bir algoritma kurulunca kodlaması angarya artık...

@ProhibiT
çizilecek şekli ekrana basmadan önce fare üzerinde tutma konusunda açıklamalı basit bir örnek verebilir misiniz.

88794

19.02.2021 10:17

ProhibiT

Merhaba,

"... açıklamalı basit bir örnek verebilir misiniz." demişsiniz ama, pek öyle basitçe örneklenecek anlatılacak bir konu değil. Konunun derinlik boyutunun yanında, yanlış anlamalara ve yanlış denemeler sonucunda oluşabilecek kaza durumlarını göz önünde bulundurmak, konumumuz ve sorumluluğumuzun bir gereğidir.

Önce bazı tespitleri yapmakta fayda var:
Yukarıdaki paylaşımlarımızdan birinde (tarihine baktığımızda 2012 görünüyor, yani yaklaşık 9 yıl önce) "Örnek olması bakımından..." açıklamasıyla verdiğimiz yöntem, son haliyle oluşturulmuş "AutoCAD Çizim Nesnelerinin" İmleç konumuna sürüklenerek bırakılması işlemi, yani Sürükle ve Bırak (Drag and Drop) işlemidir.

Son sorunuzda sözünü ettiğiniz, "Circle çizerken olduğu gibi..." diye örneklediğiniz işlemde son haline gelmiş bir "AutoCAD Çizim Nesnesi" söz konusu değil. Çizim nesnesinin, İmleç konumuyla uyumlu ve etkileşimli olarak oluşturulurken görüntüyle ifade edilmesi... yani, bir "Rubber Band", bir sündürme (strecth te olduğu gibi değil!) işlemidir. Ve haliyle birbirinden farklı işlemlerdir.

Bu fonksiyonumuzda da İmleç konumunu belirlemek için gene grread kullanacağız. Eski örneğimizde (grread T 1) şeklinde kullanmıştık, şimdi (grread T 4 1) biçiminde kullanıyoruz. Bunun nedenleri Kitabımızdan ilgili bölümün alıntılarında detaylı olarak görülebilir. Aygıt Girişi İşlevleri başlıklı bu bölüm başka konularda da işe yarayabileceği düşüncesiyle detaylı olarak paylaşılmıştır.

Mouse'un hareketine göre algılanan İmleç konumuna uygun olarak "AutoCAD Çizim Nesnesi olmayan!" vektörlerimizi (grafik Kartı Hafızasında) çizmek için, grdraw (bu işlev kullanılırsa, Transformation Matrix de kullanılabilir) veya grvecs kullanılabilir. Biz ihtiyacımıza daha uygun olduğu için grvecs kullanacağız. Aşağıda verilen kitap alıntısında görülen:
"grvecs işlevi kullanılarak çizilen vektör bir çizim nesnesi değildir, AutoCAD çizim veri tabanına eklenmez. Yalnızca grafik kartı belleğinde yer alır ve ilk yenilenme (redraw veya regen) işleminde temizlenir."
açıklamasını doğru anlamak gerek.

Bu açıklamalar ve bilgiler ışığında Lisp kodlarımız aşağıdaki gibi olabilir. Burada, Yerel Değişkenler (Local Variables) amacımıza hizmet ettikleri için tanımlanmış, hata yakalama, fonksiyonun giriş ve çıkışındaki olması gereken alışılmış bölümler yazılmamıştır.

Kod:

;| Dynamic Rubber Band Sample Code |
| Prepared by: M. Şahin Güvercin (ProhibiT) |
| 19.02.2021 - www.cizimokulu.com |;
(defun c:srkd (/ p0 p1 p2 x0 x1 x2 y0 y1 y2)
(setq p1 (getpoint) x1 (car p1) y1 (cadr p1)) ; Başlangıç köşe noktası
(while (/= (car (setq p (grread T 4 1))) 3) ; İmleç konumu ve rumunun alınması
(setq p2 (cadr p) x2 (car p2) y2 (cadr p2)) ; İmleç konumunun koordinatları
; Döngüye yeni girilmişse p0 (imlecin bir önceki konumu) tanımsız (nil) dir
; p0 T ise daha önce çizilen vektörler (0 rengi kullanılarak) silinip,
; p2 ve p2 köşelerine göre yeni vektörler çizilir.
(if p0 (grvecs (list 0 (list x1 y1) (list x0 y1) (list x0 y1) (list x0 y0)
(list x0 y0) (list x1 y0) (list x1 y0) (list x1 y1)
8 (list x1 y1) (list x2 y1) (list x2 y1) (list x2 y2)
(list x2 y2) (list x1 y2) (list x1 y2) (list x1 y1)))
; p0 nil ise (döngüye ilk girişte) p1 ve p2 köşelerine göre vektörler cizilir.
; p0, x0 ve y0 değişkenleri yukarıda "Local Variable Listesine" yazılmazsa,
; fonksiyonun daha sonra çalıştırıldığında, bir önceki kullanımdan kalan p0
; nil olmadığı için döngüye ilk girişi olduğunu bilemeyecektir...
; Herhangi bir hataya neden olmayacağı, olmayan vektörleri silse ne olur...
; diye düşünmemek, fonksiyonun işleyişini sağlam tutmak gerek.
(grvecs (list 8 (list x1 y1) (list x2 y1) (list x2 y1) (list x2 y2)
(list x2 y2) (list x1 y2) (list x1 y2) (list x1 y1))))
; Burada =, eq veya equal (Lisp'te bu üçü de birbirinden farklıdır) gibi
; hiç bir karşılaştırma kullanılmadan, doğrudan doğruya "(if p0" kullanıldığına,
; "(progn" gibi gruplama olmadığına dikkat etmekte fayda var.
; döngünün sonunda İmleç konumu p0 a aktarılarak, döngünün bir sonraki adımında
; imlecin eski yeri olarak kullanılması sağlanır.
(setq p0 p2 x0 (car p0) y0 (cadr p0))) (redraw)
; Mouse'un sol düğmesine basılarak p2 noktası nihai olarak seçilerek,
; Ekrandaki sürükleme işlemi sonlanınca, geçici (AutoCAD Çizim Nesnesi olmayan)
; vektörleri (redraw) ile siliniyor. Bunu da; Nasılsa üzerlerine kalıcı
; (AutoCAD çizim nesneleri) gelecek görünmezler... diye de düşünmemek gerek.
(entmake (list (cons 0 "Line") (cons 10 (list x1 y1)) (cons 11 (list x2 y1))))
(entmake (list (cons 0 "Line") (cons 10 (list x2 y1)) (cons 11 (list x2 y2))))
(entmake (list (cons 0 "Line") (cons 10 (list x2 y2)) (cons 11 (list x1 y2))))
(entmake (list (cons 0 "Line") (cons 10 (list x1 y2)) (cons 11 (list x1 y1))))
(princ))

Selam ve saygılarımla herkese kolaylıklar dilerim.

88797

19.02.2021 17:50

akcan

ayrıntılı açıklamalarınız için teşekkür ederim üzerinde çalışacağım.

> 1 <


	Forum	Download	Galeri	Üye Ol \| Giriş