Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.878 saniye - Sorgu: 101 - Ortalama: 0.01859 saniye
 |
 |
 |
 |
|
|
|
|
02.02.2011 13:52
 emasi
|
|
Abi çok sağ ol ellerine sağlık. :yes
ama bilmedim nedense çalışmıyor. :blush
|
|
02.02.2011 14:14
 ProhibiT
|
|
Fonksiyon adı ilkinden farklı. ilki crp idi bunun adı crpm bu konuda hata yapıyor olabilir misiniz?
şimdi buldum hatayı, ne sizden ne de benden kaynaklanıyor. yeni halini buradan alıp kullanabilirsiniz. . . kolay gelsin. ProhibiT (02.02.2011 14:40 GMT) |
|
03.02.2011 05:20
emasi
|
|
Yine teşekkürümü bildirirem abi. Çok sağ ol:yes
bizlerin yardımında bulunduğunuz için size ve autocadokulu istifadeçilerine sayqılar ve hörmetler. uğurlar
|
|
07.02.2011 08:54
oguzkilic
|
|
Çarpım lispini yazan ve yardımcı olan herkese çok teşekkür ederim. gerçekten çok işe yaradı
|
|
07.02.2011 09:30
ProhibiT
|
|
Çarpım ve toplam yapan autolisp fonksiyonların ilgi görmesi, arkadaşlarımızın işine yaraması ve gelen istekler doğrultusunda bazı düzenlemeler yaptık:
Kod: (defun c:crpm () (command "undo" "group") (setvar "cmdecho" 0) (princ "\n çarpılacak sayıları seçiniz") (setq crpn (ssget (list (cons 0 "*text"))) l (sslength crpn) n -1 rslt nil txh (cdr (assoc 40 (entget (ssname crpn 0))))) (while (< (setq n (1+ n)) l) (setq pvt (cdr (assoc 1 (entget (ssname crpn n)))) m (strlen pvt) o 0) (while (< (setq o (1+ o)) m) (if (= (substr pvt o 1) (chr 44)) (setq pvt (strcat (substr pvt 1 (1- o)) (chr 46) (substr pvt (1+ o) (- m o))))) (if (or (< (ascii (substr pvt o 1)) 44) (> (ascii (substr pvt o 1)) 57)) (setq pvt (strcat (substr pvt 1 (1- o)) (substr pvt (1+ o) (- m o)))))) (if rslt (setq rslt (* rslt (atof pvt))) (setq rslt (atof pvt)))) (princ "\n çarpımı seçiniz") (while (/= 3 (car (setq sp (grread t 4 2))))) (setq sp (cadr sp) np (list (car sp) (cadr sp)) crpm (ssget np)) (if crpm (progn (setq crpm (entget (ssname crpm 0))) (if (or (= (cdr (assoc 0 crpm)) "text") (= (cdr (assoc 0 crpm)) "mtext")) (progn (setq crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm)) (entmod crpm) (entupd (cdr (assoc -1 crpm)))))) (entmake (list (cons 0 "text") (cons 10 sp) (cons 50 0) (cons 40 txh) (cons 1 (rtos rslt 2))))) (command "undo" "e") (prin1) ) - çarpılacak sayılar olarak seçtiğiniz text objeleri içinde nümerik olmayan karakterler olabilir. bunlar gözardı edilerek text'in yalnızca nümerik kısmı alınır. - textler içinde virgül varsa nokta olarak alınır. - sonucun yazılması için obje seçmeniz istendiğinde, tıkladığınız yerde bir text veya mtext objesi varsa sonuç bu obje değiştirilerek yazılır. eğer boş bir yer seçtinizse, yeni bir text objesi oluşturularak, sonuç yazdırılır. kolay gelsin. ProhibiT (07.02.2011 09:37 GMT) |
|
08.02.2011 20:28
miyatu
|
Alıntı hocam yukardaki satırda sitedeki düzenlemelerden kaynaklı bir hata oluşmuş. hata;yukarda görülen fonksiyon içindeki text ve mtext in buyuk harflerle yazılmaması durumunda varolan textin değiştirilmesi işlemi gercekleştirilmiyor. ayrıca herzamanki gibi algoritmanıza bayıldım. saygılarımla kolay gelsin. . . miyatu (08.02.2011 20:40 GMT) |
|
08.02.2011 21:03
ProhibiT
|
|
Evet miyatu hocam, sitede geçici olarak böyle bir problem var. hatta bunun yanında noktalardan sora da boşluk ekleniyor otomatik olarak. onun için kod içinde real sayı yazamıyoruz. noktanın kendini yazmak gerekince de, (chr 46) yazıyoruz. umarım kısa sürede düzeltilmiş olacaktır.
ilgili satırı, Kod: (if (or (= (cdr (assoc 0 crpm)) (strcase "text")) (= (cdr (assoc 0 crpm)) (strcase "mtext"))) olarak değiştirip yeniden yüklüyorum şimdilik :)Kod: (defun c:crpm () teşekkürler, kolay gelsin.
(command "undo" "group") (setvar "cmdecho" 0) (princ "\n çarpılacak sayıları seçiniz") (setq crpn (ssget (list (cons 0 "*text"))) l (sslength crpn) n -1 rslt nil txh (cdr (assoc 40 (entget (ssname crpn 0))))) (while (< (setq n (1+ n)) l) (setq pvt (cdr (assoc 1 (entget (ssname crpn n)))) m (strlen pvt) o 0) (while (< (setq o (1+ o)) m) (if (= (substr pvt o 1) (chr 44)) (setq pvt (strcat (substr pvt 1 (1- o)) (chr 46) (substr pvt (1+ o) (- m o))))) (if (or (< (ascii (substr pvt o 1)) 44) (> (ascii (substr pvt o 1)) 57)) (setq pvt (strcat (substr pvt 1 (1- o)) (substr pvt (1+ o) (- m o)))))) (if rslt (setq rslt (+ rslt (atof pvt))) (setq rslt (atof pvt)))) (princ "\n çarpımı seçiniz") (while (/= 3 (car (setq sp (grread t 4 2))))) (setq sp (cadr sp) np (list (car sp) (cadr sp)) crpm (ssget np)) (if crpm (progn (setq crpm (entget (ssname crpm 0))) (if (or (= (cdr (assoc 0 crpm)) (strcase "text")) (= (cdr (assoc 0 crpm)) (strcase "mtext"))) (progn (setq crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm)) (entmod crpm) (entupd (cdr (assoc -1 crpm)))))) (entmake (list (cons 0 "text") (cons 10 sp) (cons 50 0) (cons 40 txh) (cons 1 (rtos rslt 2))))) (command "undo" "e") (prin1) )
|
|
05.04.2011 10:45
oguzkilic
|
|
Att içindeki alanların toplamı yapılabilecek bir komut var mı?
|
|
30.06.2011 15:34
pepper1988
|
|
Selamlar;
yeni bir lisp ihtiyacım var. elimde 1/300 1/ 400 1/424 seklinde slope degerleri var. bu degerlerin hepsi text şeklinde planda mevcut. ben bu degerlerin içindeki işlemin yapılıp %0,3 %0,4 şeklinde virgülden sonra tek dijitlik bir texte dönüştürebilen bi lisp istiyorum. toplu seçim özelliği olması mümkünse süper olur. eger müsaitseniz ve yardımcı olabilirseniz çok makbule geçer... :) saygılar..
|
|
30.06.2011 20:38
ProhibiT
|
|
Kod: ;;; --------------------------------------------------------------------------- ;;; | Fractional formatta yazılmış sayılar içeren Text ve Mtext objelerini | ;;; | seçerek Text içeriklerini Decimal formatta sayılara çevirir | ;;; --------------------------------------------------------------------------- (write-line "\n Hazırlayan M. Sahin Güvercin - www.autocadokulu.com") (defun C:F2D (/ obj L n pvt tic yer pay payda rsL) (setvar "cmdecho" 0) (command "undo" "group") (setvar "modemacro" "Prepared by:M. Şahin Güvercin") (setq obj (ssget (list(cons 0 "*text")(cons 1 "*/*"))) L (sslength obj) n -1) (while (< (setq n (1+ n)) L) (setq pvt (entget (ssname obj n)) tic (cdr (assoc 1 pvt)) yer (vl-string-position (ascii "/") tic) pay (atof (substr tic 1 yer)) payda (atof (substr tic (+ yer 2))) rsL (rtos (/ pay payda) 2 1)) (if (not (vl-string-position (ascii ".") rsL))(setq rsL (strcat rsL ".0"))) (setq pvt (subst (cons 1 rsL) (assoc 1 pvt) pvt)) (entmod pvt) (entupd (cdr (assoc -1 pvt)))) (command "undo" "e") (prin1) ) - Obje seçerken elinizi korkak alıştırmayın. seçtiğiniz obje gurubu içindeki text ve mtext objelerinden içeriğinde / olanlar işleme alınacaktır. - işlem sonucu tamsayı (integer) çıkması durumunda sonuna .0 ekleyerek 1'er basamak yürütme konusunda diğerleriyle uyumlu olması sağlanır. - bir text içinde 2 tane / varsa şansınıza küsün. ilk 2 sayının bölümünü hesaplayıp obje içeriğini değiştirecektir. kolay gelsin. ProhibiT (21.12.2013 18:06 GMT) |
|
30.06.2011 21:20
neuyuz
|
|
Merhaba
autocad de eğik mesafeyi nasıl bulabiliriz acaba.Polyline veya line objelerinin toplam eğik ve yatay mesafelerini doğruların üzerine yazdırabileceğimiz lisp yazabilirmiyiz. (tüm noktaların üzerinden 3d polyline ile geçerek list ile eğik mesafeyi buluyorum ama uzun sürüyor.) yardımcı olursanız sevinirim...
|
|
01.07.2011 10:30
ProhibiT
|
|
Sorunuz biraz belirsiz ve tanımsız kalmış. bununla beraber,
Linkleri görebilmek için ÜYE olmalısınız. linkine bir göz atmanızı tavsiye ederim. Paylaştığım DB isimli AutoLisp fonksiyon istediğiniz işlemi yapar gibi geldi bana.
|
|
08.07.2011 19:56
pepper1988
|
|
Teşekkürler prohibit hocam
her ihtiyacımızda hiç çekinmeden yardım elinizi uzatıyorsunuz. her gün yeni bi sorun çıkıyor karsıma.. her gün yeni bir lispe ihtiyacım oluyor. artık benimde kendi kendime lisp yazıp sizin gibi buradaki arkadaslara yardım etme zamanım geldide geçiyor bile .. derslere başlıyorum hemen =) yeni bi lispe ihtiyac duyuyorum şu sıralar yardımcı olabilmenin mümkün mü... elimde 2 adet block var içlerinde birer att objesi taşıyorlar.(tag: num prompt: num) sizden istedigim şey birindeki degeri digerine kopyalabilmek. elimde buna dair bi lisp var ama sadece textlerin içerigini kopyalayabiliyor. eger vaktiniz varsa yardımcı olursanız sevinirim.. teşekkürlerr tekrar tekrar..
|
|
09.07.2011 06:41
ProhibiT
|
|
Daha önce de bahsettiğim bir karmaşa var burada.
"block" diye bahsettiğimiz block tanımı mı? block tanımı bir "tables object" tir. yoksa, tanımlı bir block'a refere edilmiş "insert" (block reference) objeleri mi? "block reference" bir "drawing object" tir. her iki kavram da o kadar farklı ki biribirinden. block tanımı içindeki attribute tag, prompt ve default olmak üzere 3 özniteliğe sahiptir. block reference (insert) objesinde ise attribute'ün tag, prompt ve value olmak üzere gene 3 özniteliği vardır. hangi tür için hangi özniteliklerin birinden diğerine aktarılacağı netleştirildiğinde, çözüm o kadar da karmaşık olmasa gerek.
|
|
09.07.2011 13:00
pepper1988
|
|
Hocam açıklamalarınızda geçen iki block objesi arasındaki farkı tam olarak kavrayamadım. olayın teknik detayını o kadar fazla bilmiyorum. önceden yaptıgımız bir nesneyi ''block definition'' menusunden bir block olarak tanımladım elimde bir kaç farklı block var. bu blockların her birine aynı tagla aynı prompt ismiyle (tag: num prompt: num) attiributeler yerleştirdim. daha önce yazdıgınız bi lisp vardı. bu attiributelere numara veren. Aynı numarayı bide diger Attiribute kopyalamak istiyorum kısacası
Kod: ;;;====================================================;;; ;;; Hayırlayan: M. Sahin Guvercin ;;; ;;; sahinguvercin@hotmail.com ;;; ;;;====================================================;;; (defun c:AtrNo () (setvar "cmdecho" 0)(command "undo" "group") (if (= nil esayi) (setq esayi 1)) (setq sayi (getint (strcat "\nBaslangic sayisi (bLock seçmek için negatif sayı giriniz) <" (itoa esayi) "> :"))) (if (= sayi nil) (setq sayi esayi) (if (< sayi 0) (progn (setq refr (car (entsel "\nSon numarayı almak istediğiniz bLock seçiniz..."))) (if (and (= (cdr (assoc 0 (entget refr))) "INSERT") (= (cdr (assoc 66 (entget refr))) 1)) (while (= (cdr (assoc 0 (entget (setq refr (entnext refr))))) "ATTRIB") (if (= (cdr (assoc 2 (entget refr))) "NUM") (setq sayi (atoi (cdr (assoc 1 (entget refr))))))))))) (if (= amk nil) (setq eamk 1)) (setq amk (getint (strcat "Artis miktari <" (itoa eamk) "> : "))) (if (= nil amk) (setq amk eamk)) (while (setq bLck (car (entsel "\Numaralandırılmak istenen bLock'u seçiniz"))) (while (= (cdr (assoc 0 (entget (setq bLck (entnext bLck))))) "ATTRIB") (if (= (cdr (assoc 2 (entget bLck))) "NUM") (progn (setq sayi (1+ sayi)) (if (< sayi 10) (setq sy (strcat "0" (itoa sayi))) (setq sy (itoa sayi))) (setq pivot (entget bLck) pivot (subst (cons 1 sy) (assoc 1 pivot) pivot) esayi sayi) (entmod pivot) (entupd (cdr (assoc -1 pivot))))))) (command "undo" "e")(prin1) Bu isizin daha önce yazmış oldugunuz numaralandırma lispi aynı lispi bu blocklardada işler hale getirdim. sadece aynı numarayı başka bir bloğa kopyalamak istiyorum. bilmiyorum anlatabildim mi problemimi.. bi ufak bi ricam daha olacak bu numara degiştirilen lispte numarası değişen objenin rengide degişebilirmi sadece kontrol amaçlı. mümkünse süper olu :)
|
|
12.07.2011 07:58
ProhibiT
|
|
"numarası değişen objenin rengi..." tanımsız. olayın özünü yakalamaya çalışın, kafanızda netleştirin. Burada bahsedilen, Block'un mu, Block Reference'ın mı, Attdef (Attribute Definitin) in mi, Attibute'ün mü rengi?
Kod: (defun c:AvM (/ Sob Dob) ;;; Attribute Value Match İşin aslına bakarsanız, Attribute içeren Kaynak ve Hedef bLock'ları birlikte seçip properties penceresinden değişiklik yapmak hiç te zor değil. böyle bir fonksiyon yazarken kendimi hiç iyi hissetmedim.
(command "_.undo" "group") (setvar "cmdecho" 0) (setq Sob (entget (car (entsel "\n Source Object: "))) Dob (entget (car (entsel "\nDestination Object: ")))) (if (and (= (cdr (assoc 2 Sob)) (cdr (assoc 2 Dob))) (and (= (cdr (assoc 66 Sob)) 1) (= (cdr (assoc 66 Dob)) 1)) (= (cdr (assoc 2 (entget (entnext (cdr (assoc -1 Sob)))))) (cdr (assoc 2 (entget (entnext (cdr (assoc -1 Dob)))))))) (progn (setq Sob (entget (entnext (cdr (assoc -1 Sob)))) Dob (entget (entnext (cdr (assoc -1 Dob)))) Dob (subst (assoc 1 Sob) (assoc 1 Dob) Dob)) (entmod Dob) (entupd (cdr (assoc -1 Dob))))) (command "_.undo" "e") (princ) )
|
|
12.07.2011 13:37
pepper1988
|
|
Dogru diyosunuz hocam ama aynı anda hem numaralandırma lispi ile numara veriyorum hemde diger ona baglı elemanlara aynı numarayı kopyalıyorum. 1 2 tane deil bu blocklar 10 528 tane block var. teşekkür ederim yardımınız için.. renk degişikliği konusuda çok önemli degil..
teşekkür ederim ilgilendiginiz için... bir blogun içinde birden fazla att objesi varsa secici bi özellik varmı bu lispin içinde. tagına göre seçilebilirmi
|
|
18.09.2011 02:36
kerem1453
|
|
Statik projelerde hava bacasının ebatını otomatik girince içinin taramasıyla birlikte yapan lsp varmı ?
|
|
20.09.2011 06:38
byengineer01
|
|
Merhaba arkadaşlar,
ben mekanik tesisat proje danışmanlık firmasında proje mühendisliği yapıyorum benim istediğim lisp block isimlerine tıklandığı zaman bu, tıkladığım block isim üzerinden tanıyıp ona göre bir değer atayacak mesala; bulaşık makinesine tıklandığı zaman onun sarfiyat birimi olan 4 sb değerini block altına atayacak. aşağıda mesala verilen lisp çizgi üzerine bm kodunu girdikten sonra atıyo ben bunun kod girmeden block üzerine bu bm kodunu block isiminden tanıyıp o değeri atamısnı istiyorum . yardım ederseniz sevinirim çalıştığım lisp örneği : (defun c:sb () (setq va (getstring "\n armatur kodunu gir:")) (while (/= va nil) (cond ((= va "h") (setq sb (strcat "8" "sb")) ) ((= va "d") (setq sb (strcat "7" "sb")) ) ((= va "l") (setq sb (strcat "2" "sb")) ) ((= va "e") (setq sb (strcat "4" "sb")) ) ((= va "p") (setq sb (strcat "1" "sb")) ) ((= va "cm") (setq sb (strcat "4" "sb")) ) ((= va "bm") (setq sb (strcat "4" "sb")) ) ) (setq yp1 (getpoint "\n yazma noktasını seç:")) (command "text" yp1 "" sb "") (setq va (getstring "\n armatur kodunu gir:")) ) ) ayrıca bir sorunum daha var text yazı stilini ve yuksekliğni ayarlama dongusu koyarsanız sevinirim birde bu lisp i çalıstırmadım ....
|
 ehya
|
|
Byengineer01
bu konu ile ilgili örnek kod göndermiştim.. olmadı mı ?
|