Kesit Alanı ve Çevre Hesaplama | Forumlar

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

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

Forumlar > AutoLISP > Kesit Alanı ve Çevre Hesaplama

25.10.2009 07:25

k005

Merhaba arkadaşlar;

Daire halkasının kesit alanı hesaplamak için bir Lisp yazdım.. oldu.. fakat buna şimdi bir de Polyline bir obje daha eklemek istiyorum.. onunda alanını ve çevrisini hesaplatmaya çalışıyorum.. seçim konusunda takıldım....

yardımcı olacak arkadaş(lar)a şimdiden teşekkürler. Herkese kolay gelsin.

Kod:

;KESİT ALANI HESAPLAMA E.KALAY 2009
(DEFUN C:ac()
(princ "\nObje Kesit Alanı Hesaplar..")
(setvar "cmdecho" 0)
(setq objt (getint "\nObJe TiPi (CiRcLe/PoLyLiNe) 1/2 ? : "))
(if (= objt 1)
(progn
(setq tc1 (entsel "\nBüyük daireyi seçiniz ?"))
(setq tc2 (entsel "\nKüçük daireyi seçiniz ?"))
(setq tc3 (entget (car tc1)))
(setq tc4 (entget (car tc2)))
(setq R (cdr (assoc 40 tc3)))
(setq ru (cdr (assoc 40 tc4)))
(setq aln (-(* pi (sqr R))(* pi(sqr ru))))
(setq 2cev (+(* pi (+ R R))(* pi(+ ru ru))))
(princ"\nKesit ALANI= ")
(princ (strcat (rtos aln 2 2 ) """ brm²"))
(princ"\nÇevre TOPLAM= ")
(princ (strcat (rtos 2cev 2 2 ) """ brm"))
(princ)
)
;******************************************
(if (= objt 2)
(progn
(setq tc1 (entsel "\nBüyük Polyline seçiniz ?"))
(setq tc2 (entsel "\nKüçük Polyline seçiniz ?"))
(setq ply2 (command "area" "o" tc1))
(setq cvr2 (getvar "perimeter"))
(setq ply1 (command "area" "o" tc2))
(setq cvr1 (getvar "perimeter"))
(setq plyalan (- ply2 ply1))
(setq plycevre (+ cvr2 cvr1))---> bu kısımdaki işaret değişecek + olacak arkadaşlar..
(princ"\nPolyLiNe Kesit Alanı= ")
(princ (strcat (rtos plyalan 2 2 ) """ brm²"))
(princ"\nPolyLiNe Çevre Toplam= ")
(princ (strcat (rtos plcevre 2 2 ) """ brm"))
(princ)))))
(setvar "cmdecho" 1)

k005 (25.10.2009 10:45 GMT)

52773

25.10.2009 09:14

ehya

pline ilgili bölümü aşağıdaki gibi değiştir.
Ayrıca daire bölümünü de kontrol ettim. Bi hata var. Kesit alanı doğru sonuç vermiyor. Örnek olarak, iki dairede verdiği sonuç ile, bu alanı hatch yaparak alanını hesapladığımda aynı sonucu vermedi. Kodlarını tek tek kontrol etmedim. Bu bölümü tekrar kontrol et derim..

Kod:

(if (= objt 2)
(progn
(setq tc1 (car (entsel "\nBüyük Polyline seçiniz ?")))
(setq tc2 (car (entsel "\nKüçük Polyline seçiniz ?")))
(command "area" "o" tc1)
(setq ply2 (getvar "area"))
(setq cvr2 (getvar "perimeter"))
(command "area" "o" tc2)
(setq ply1 (getvar "area"))
(setq cvr1 (getvar "perimeter"))
(setq plyalan (- ply2 ply1))
(setq plycevre (- cvr2 cvr1))
(princ"\nPolyLiNe Kesit Alanı= ")
(princ (strcat (rtos plyalan 2 2 ) """ brm²"))
(princ"\nPolyLiNe Çevre Toplam= ")
(princ (strcat (rtos plycevre 2 2 ) """ brm"))
(princ)))))
(setvar "cmdecho" 1)

52774

25.10.2009 09:27

k005

Alıntı
ehya :

tamamdır ehya. teşekkürler.. Daire kesiti ile ilgili kısma gelince,, bir Hata yok sonuç doğru çıkıyor..

(setq aln (-(* pi (sqr R))(* pi(sqr ru)))) burdaki sqr fonksiyonu sende yoktur büyük ihtimalle,, sanırım ondan kaynaklanıyor...

52775

25.10.2009 09:30

ehya

yani sqr fonksiyonunu sanırım dışarıdan ekleme yaptın... ben onu yanlış yazdın düşüncesiyle sqrt olarak değiştirmiştim.

52776

25.10.2009 09:31

k005

:) .. evet dışardan ekledim. kolaylık sağlıyor bazı işlemlerde..

52780

25.10.2009 10:23

yazgunesi

Kod:

KESİT ALANI HESAPLAMA E.KALAY 2009

; -- Function: sqr X
; Compute the square of X; short for `(* X X)'.

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

(defun sqr (x)
(* x x)
)
(princ)

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

(DEFUN C:ac()

(setq mycmd (getvar "cmdecho"))
(setvar "cmdecho" 0)

(setq myosm (getvar "OSMODE")) ; osnap modunu değişkene kaydet
(setvar "OSMODE" 0) ; osnap modunu devre dışı braktık.

; Program esas kodlar başlangıç :

(princ "\nObje Kesit Alanı Hesaplar..")

(setq objt (getint "\nObJe TiPi (CiRcLe/PoLyLiNe) 1/2 ? : "))
(if (= objt 1)
(progn
(setq tc1 (entsel "\nBüyük daireyi seçiniz ?"))
(setq tc2 (entsel "\nKüçük daireyi seçiniz ?"))
(setq tc3 (entget (car tc1)))
(setq tc4 (entget (car tc2)))
(setq R (cdr (assoc 40 tc3)))
(setq ru (cdr (assoc 40 tc4)))
(setq aln (-(* pi (sqr R))(* pi(sqr ru))))
(setq 2cev (+(* pi (+ R R))(* pi(+ ru ru))))
(princ"\nKesit ALANI= ")
(princ (strcat (rtos aln 2 2 ) """ brm²"))
(princ"\nÇevre TOPLAM= ")
(princ (strcat (rtos 2cev 2 2 ) """ brm"))
(princ)
)

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

(if (= objt 2)
(progn
(setq tc1 (car (entsel "\nBüyük Polyline seçiniz ?")))
(setq tc2 (car (entsel "\nKüçük Polyline seçiniz ?")))
(command "area" "o" tc1)
(setq ply2 (getvar "area"))
(setq cvr2 (getvar "perimeter"))
(command "area" "o" tc2)
(setq ply1 (getvar "area"))
(setq cvr1 (getvar "perimeter"))
(setq plyalan (- ply2 ply1))
(setq plycevre (- cvr2 cvr1))
(princ"\nPolyLiNe Kesit Alanı= ")
(princ (strcat (rtos plyalan 2 2 ) """ brm²"))
(princ"\nPolyLiNe Çevre Toplam= ")
(princ (strcat (rtos plycevre 2 2 ) """ brm"))
(princ))
)
)

; (setvar "cmdecho" 1) ; iptal edilen satır

(setvar "cmdecho" mycmd) ; sistem değişkenlerini geri çağralım.
(setvar "osmode" myosm) ; herşey ilk andaki gibi olması için..
(princ)
)
(Princ "Lisp'i çalıştırmak için > ac < yazınız! ")

Kodlama ile ilgili kaynak linkler vs. :

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

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

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

; SQRT KULLANIMI : sqrt (sqrt number)
; Returns square root of number as a real number.

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

Program çalışırken, işlem anında seçim yapılmazsa eğer ;

Küçük daireyi seçiniz ?
Error:bad argument type: lentityp nil hatasını veriyor..

Daire , pline , join yapılan line objelerinde de test edildi problem yok...

Kesit ALANI= 1001.38 brm²
Çevre TOPLAM= 267.04 brm

PolyLiNe Kesit Alanı= 456.23 brm²
PolyLiNe Çevre Toplam= 39.47 brm

Bundan sonrası için düşüncem cm2 , mt2 , cm3 , mt3 cinsinden seçenekleri ve hesapları uygulamaktır.. .tabi iş icabı gerekliyse eğer. :-)

yazgunesi (25.10.2009 10:35 GMT)

52888

29.10.2009 12:34

k005

Obje Kesit Alanı ve çevre hesaplama.. (obje = polyline, circle, ellipse, region)
komutu çalıştırmak için = ac

Kod:

;KESİT ALANI HESAPLAMA E.KALAY 2009
(Defun C:ac()
(princ "\nObje Kesit Alanı Hesaplar..")
(setvar "cmdecho" 0)
(setq tc1 (car (entsel "\nBÜYÜK ŞEKLİ SEÇİNİZ ?")))
(setq tc2 (car (entsel "\nKüçük Şekli seçiniz ?")))
(command "area" "o" tc1)
(setq ply2 (getvar "area"))
(setq cvr2 (getvar "perimeter"))
(command "area" "o" tc2)
(setq ply1 (getvar "area"))
(setq cvr1 (getvar "perimeter"))
(setq plyalan (- ply2 ply1))
(setq plycevre (+ cvr2 cvr1))
(princ "\n============================")
(princ"\nKESİT ALANI = ")
(princ (strcat (rtos plyalan 2 2 ) """ brm²"))
(princ"\nÇEVRE TOPLAM = ")
(princ (strcat (rtos plycevre 2 2 ) """ brm"))
(princ))
(setvar "cmdecho" 1)

k005 (29.10.2009 12:45 GMT)

> 1 <


	Forum	Download	Galeri	Üye Ol \| Giriş