Copyright © 2004-2022 SQL: 0.683 saniye - Sorgu: 56 - Ortalama: 0.01219 saniye
 |
 |
 |
 |
|
|
|
|
09.12.2010 17:18
 SENDUR
|
|
arkadaşlar kullandığım bir lisp var toplama, bölme ve çarpma yapıyor ama çıkarma yapıyor bu lispe çıkarma ekleye bilir miyiz. bir de text le birlikte başka nesne seçince bad argument veriyor.
; Designed by CANAVAR R 1998 Copyright. (DEFUN C:TP ();(/ ent AU SS A T TP H R D) (Setq AU (Getvar "Aunits")) (Setvar "Aunits" 3) (Prompt "\nToplanacak Sayilari Seçiniz....") (Setq SS (Ssget)) (Setq A 0) (Setq T 0) (Setq TP (Ssname SS A)) (Setq H (Cdr (Assoc 40 (Entget TP)))) (Setq R (Cdr (Assoc 50 (Entget TP)))) (While TP (Setq D (Atof (Cdr (Assoc 1 (Entget TP))))) (Setq T (+ T D)) (Setq A (1+ A)) (Setq TP (Ssname SS A)) ) (Setq T (Rtos T 2 2)) (setq ent (car (entsel " Degisecek olani seciniz:"))) (if (/= ent nil) (command "change" ent "" "" "" "" "" "" T )) (Setvar "Aunits" AU) (princ) ) (DEFUN C:CA (/ ENT AU SS A C TT H R D) (Setq AU (Getvar "Aunits")) (Setvar "Aunits" 3) (Prompt "\nÇarpilacak Sayilari Seçiniz....") (Setq SS (Ssget)) (Setq A 0) (Setq C 1) (Setq TT (Ssname SS A)) (Setq H (Cdr (Assoc 40 (Entget TT)))) (Setq R (Cdr (Assoc 50 (Entget TT)))) (While TT (Setq D (Atof (Cdr (Assoc 1 (Entget TT))))) (Setq C (* C D)) (Setq A (1+ A)) (Setq TT (Ssname SS A)) ) (Setq C (Rtos (/ C 1))) (setq ent (car (entsel " Degisecek olani seciniz:"))) (if (/= ent nil) (command "change" ent "" "" "" "" "" "" C )) (Setvar "Aunits" AU) (princ) ; (Setq P (Getpoint "\nNereye Yazilacak....")) ; (Command "TEXT" P H R C) ; (Setvar "Aunits" AU) ) (DEFUN C:BOL (/ ENT AU B BB H R BL ) (Setq AU (Getvar "Aunits")) (Setvar "Aunits" 3) (Setq B (Entget (Car (Entsel "\nBölünecek Sayiyi Seçiniz....")))) (Setq BB (Entget (Car (Entsel "\nBölen Sayiyi Seçiniz....")))) (Setq H (Cdr (Assoc 40 B))) (Setq R (Cdr (Assoc 50 B))) (Setq B (Atof (Cdr (Assoc 1 B)))) (Setq BB (Atof (Cdr (Assoc 1 BB)))) (Setq BL (/ B BB)) (Setq BL (Rtos BL 2 2)) (setq ent (car (entsel " Degisecek olani seciniz:"))) (if (/= ent nil) (command "change" ent "" "" "" "" "" "" BL )) (Setvar "Aunits" AU) (princ) ; (Setq P (Getpoint "\nNereye Yazilacak....")) ; (Command "TEXT" P H R BL) ; (Setvar "Aunits" AU) ) SENDUR (09.12.2010 17:27 GMT) |
|
09.12.2010 19:26
 ProhibiT
|
|
Merhaba SENDUR :)
Bu AutoLisp fonksiyonlar buradaki halleriyle gerçekten çalışıyorlar mı? AutoLisp'te; (setq T 0) hata verir! Çünki; T Protected Symbol'dür True değerini sembolize eder. İsterseniz bunu AutoCAD komut satırından (setq T 0)<┘ girerek test edebilirsiniz... Fonksiyonların başında Aunits (Angular Units/açısal birim) neden kurcalanıyor ve neden değiştiriliyor? Fonksiyonların hiç bir yerinde açılarla ilgili bir işlem yapılmıyor ki! Fonksiyonlarda yer alan (assoc 40 ve (assoc 50 değerleri hiç bir yerde kullanılmıyor ki! Sonucun mevcut bir sayı değiştirilerek değil de, yeni bir Text olarak yazdırılması durumu için düşünülmüş ama, bu yol kullanılmamış... Ki; bu durumda bile Aunits'i kurcalamaya gerek yok! (ssget... fonksiyonunda seçilecek objelerin türü tanımlanmamış, bu durumda bad argument hatası vermesi normal... Bunlarla birlikte, çin işkencesi gibi (setq... ve (while... loop'lar kullanılmış... Gerek yok ki! Bu konularla ilgili yorum yapmak istemiyorum. Ama, ben olsam aynı fonksiyonu; Kod: (defun C:TP () şeklinde yazardım. Çok daha sade ve güvenli... Obje seçerken de hata yapmanıza izin vermez, bad argüment diye mızıkçılık etmez :)(princ "\n Toplanacak Sayilari Seçiniz...\r") (Setq SS (ssget (list (cons 0 "text"))) L (sslength SS) a -1 Tp 0) (While (< (setq a (1+ a)) L) (setq D (atof (cdr (assoc 1 (entget (ssname SS a))))) Tp (+ Tp D))) (princ "\n Toplamın yazılacağı Sayıyı seciniz...\r") (setq ent (entget (ssname (ssget ":s" (list (cons 0 "text"))) 0))) (setq ent (subst (cons 1 (rtos Tp 2 2)) (assoc 1 ent) ent)) (entmod ent) (entupd (cdr (assoc -1 ent))) (prin1) ) Çıkarma işlemine gelince, buradaki mantıkla seçilen sayıları nereden çıkaracak? Bir başlangıç değeri verilmezse sonuç negatif çıkacaktır. Bunun da toplama işlemine göre bir sanat değeri yok ki! Çıkarılacak Text objelerinnin değeri negatif (-) yazılabilir. Ya da toplama işlemi uygulanıp sonucun yazıldığı text objesi edit edilir, başına bir eksi (-) konuverir. Bununla birlikte, ihtiyacınızı daha net karşılayabileceğini düşündüğüm bir fonksiyon yazdım. Kod: (defun C:CK () Bu fonksiyonda, önce toplanacak sayılar seçilir, sonra çıkarılacak sayılar... ve nihayet sonucun yazdırılacağı sayı seçilir.(princ "\n Toplanacak Sayilari Seçiniz...\r") (Setq SS (ssget (list (cons 0 "text")))) (if SS (progn (setq L (sslength SS) a -1 Tp 0) (While (< (setq a (1+ a)) L) (setq D (atof (cdr (assoc 1 (entget (ssname SS a))))) Tp (+ Tp D)))) (setq Tp 0)) (princ "\n Çıkarılacak Sayilari Seçiniz...\r") (Setq SS (ssget (list (cons 0 "text"))) L (sslength SS) a -1) (While (< (setq a (1+ a)) L) (setq D (atof (cdr (assoc 1 (entget (ssname SS a))))) Tp (- Tp D))) (princ "\n Sonucun yazılacağı Sayıyı seciniz...\r") (setq ent (entget (ssname (ssget ":s" (list (cons 0 "text"))) 0))) (setq ent (subst (cons 1 (rtos Tp 2 2)) (assoc 1 ent) ent)) (entmod ent) (entupd (cdr (assoc -1 ent))) (prin1) ) Burada toplanacak sayılar seçim setini Enter ile boş geçerseniz, başlangıçta Tp değerini sıfır alacağı için sonuç negatif olarak hesaplanıp yazılacaktır. Mantık basit, çarpma ve bölme için kolayca edit edilebilir diye düşünüyorum. Kolay gelsin...
|
|
10.12.2010 07:31
SENDUR
|
|
Teşekürler EHYA yine döktürmüşsün
evet lisp çalışıyor ama dediğim gibi seçim olayı bazen sıkıntı yaratıyor malum bad argüment :) bide en son değiştirecek text bulmak gerekiyor :) dediğin gibi text oluştursa daha iyi olur :) senin yazdığın lispi çalıştıramadım bu arada "unıcode" ile kaydıt etmezsen bazı bilgiler kaybolacak filan yazı kayıt ediyorum gene ama çalışmıyor ck yazıyorum tepki vermiyor :) acad anlamadım :( bide lispi yazan arkadaş sanırım 1998 de yazmış malum 12 sene olmuş onuda anlamak lazım diye düşünüyorum
|
|
10.12.2010 09:12
 ehya
|
|
sendur
teşekkürü bana değil prohibit hocaya etmelisin.. :) Ben değilim bu lispi yazan... :)
|
|
SENDUR
|
|
alışkanlık işte :)
Teşekürler Prohibit hocam :)
|