16.12.2010 09:46    

murat___aksoy@hotmail.co
Iyi günler,
katı modelde yapılan bir çizimdeki malzemeleri kalınlıklarna göre verilen ölçü doğrultusunda bir dikdörtgene yerleştirecek bir lips varmıdır. veya nasıl yazılır.
yardımlarınız iin şimdiden teşekkürler.

ehya (09.07.2011 07:41 GMT)

28.01.2011 03:10    

pepper1988
Selamlar;
Sıra numarasını text yazan lispler oldukça yaygın fakat ben bi adım öteye geçmiş bi lisp arıyorum. Bi attiribute olusturdum nacizane :) blok şekline getirdim. içinde 3 adet Tag var.
1) Obje ismi Örn: H1
2) Numarası Örn: 00
3) Kot (visible modda block içinde attiribute olarak mevcut opsiyonel)

Bu örnekleri tek bir cümleyle özetlersek H1XX şeklinde blocklarım var.Bu XX yazan yere tıkladıgım sırayla numara yazmasını istiyorum text yazan lisp gibi attiribute içine girim num isimli tagı degiştiricek sadece zor bir şey mi bilmiyorum ama ilgilenen olursa sevinirim.
Birde sorum olacak Z degeri sıfır olarak picklediğim attiributleri X Y kordinatları aynı bir 3D ploy line üzerinden Z degeri aldırabilirmiyiz. İlk sorumdaki kot'dan bagmsız bir soru. Ama ikisini birleştirerekde bir lisp yazılabiliyorsa ne âlâ :) Bu iki soruma yanıt arıyorum engin bilgilerinizle beni aydınaltırsanız minnettar kalırım.
İyi forumlar. :)

28.01.2011 10:18    

ProhibiT
Bakış açısına bağlı olarak, basit denebilir ama aslında bakarsanız komplike bir konu.

Bahsettiğimiz Attribute objeleri Main objects gurubuna girmezler, sub object olduklarından AutoLisp içinde modify edilmeleri farklı bir prosedür gerektirir. Block adı, Her üç atrribute'ün de Tag ve Prompt'larını yazarsanız size bir örnek fonksyion yazarım.

Kot değeri elbette PoLyLine objesinden alınabilir. Bu noktada bahsettiğiniz 3D PoLyLine dan neyi kasdediyoruz? Yani LwPoLyLine değil de, PoLyLine mı? yoksa gerçekten her bir vertex'inin z koordinatları farklı olmasını mı kasdediyoruz? Yoksa bütün vertex'leri aynı z koordinatında (elevation verilmiş) bir PoLyLine'dan mı bahsediyoruz.

İki fonksiyondan bahsediyoruz.
Birincisi; tıklanıp seçilen bLock altındaki sıra numarası Attribute'e tıklanma sırasına göre değer atama.
İkincisi; tıklanıp seçilen bLock altındaki KOT atrribute'üne gene tıklanıp seçilecek bir PolyLine objesinin Elevation değerini (Z koordinatı) verme.

Bence bu iki fonksiyon birleştirilmemeli bağımsız olarak yazılmalı.

ProhibiT (30.01.2011 12:10 GMT)

28.01.2011 19:17    

pepper1988


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


Buraya 2 tane dwg upload ettim. Birinde numaralandırmak istedigim bloklar var. Digernde bloklar yerlernde ve Z düzleminde ploy line ın üzerine inmeleri gerekiyo elevation alınmasına gerek yok. Bu ployline ın olusumunu size anlatıyım br yüzey var elimizde poly line ı yüzeye bir programla yapıstırıyoruz ve o yüzeyin kotlarını alıyor.Program vertexleri gereken yerlerde kendi yüzeye göre belirledigi noktalara atıyor. Dwg nin içinde Hem 3d hali hem 2 d hali mevcut ploy line ın blocklarda mevcut. İlginize teşşekkür ediyorum. Degerli vaktinizi harcamak istemem ama bi göz atabilirseniz sevnirim :)

28.01.2011 21:04    

miyatu
secim asaması biraz sacma poınt secer gibi secim yapılıyor...

bi dene belki işine yarar...

daha iyisini ustalarımız mutlaka yapacaklardır...

kolay gelsin...

Kod:

(defun c:num ()
  (if (= count nil)
    (progn
      (setq count 1)
    )
  )
  (initget "N")
  (setq p1 (getpoint (strcat "\nBlogu sec [baslangic No degistir]<"
     (rtos count 2 0)
     ">:"
     )
   )
  )
  (if (= p1 "N")
    (progn
      (setq old_count count)
      (setq count_al (getint "\nBaslangıc no gir:"))
      (if (= count_al nil)
(progn
  (setq count old_count)
)
(progn
  (setq count count_al)
)
      )
      (setq p1 (getpoint "\nBlogu sec:"))
    )
  )
  (setq secim (ssget p1))
  (kny_att_oku secim)
)

(defun kny_att_oku (#secim)
  (setq #key 2
#entity (ssname #secim 0)
#0 (cdr (assoc 0 (entget #entity)))
#66 (cdr (assoc 66 (entget #entity)))
  )
  (if (and (= #0 "INSERT") (= #66 1))
    (progn
      (setq #entity (entnext #entity)
    #0     (cdr (assoc 0 (entget #entity)))
    #66     (cdr (assoc 66 (entget #entity)))
      )
      (while (or (= #0 "ATTRIB") (= #66 1))
(setq #2 (cdr (assoc #key (entget #entity))))
(if (= #2 "NUM")
  (progn
    (if (< count 10)
      (progn
(setq count_y (strcat "0" (rtos count 2 0)))
      )
      (progn
(setq count_y (rtos count 2 0))
      )
    )
    (setq #dt (entget #entity))
    (setq
      #dt (subst (cons 1 count_y) (assoc 1 #dt) #dt)
    )
    (entmod #dt)
  )
)
(setq #entity (entnext #entity)
      #0      (cdr (assoc 0 (entget #entity)))
      #66     (cdr (assoc 66 (entget #entity)))
)
      )
    )
  )
  (setq count (+ count 1))
)

28.01.2011 21:23    

pepper1988
Teşekkür ederim Miyatu hiç amatör durmuyo emegine ellerine saglık :)
Ufak bi ricam olacak mümkünse komutun sürekliligi olabilme ihtimali var mı :)

28.01.2011 22:41    

ProhibiT
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
        (princ "\nSon numarayı almak istediğiniz bLock seçiniz...")
        (setq refb (ssget ":s" (list (cons 0 "BLOCK") (cons 66 1))))
        (while (= (cdr (assoc 0 (entget (setq refb (entnext refb))))) "ATTRIB")
          (if (= (cdr (assoc 2 (entget refb))) "NUM")
            (setq sayi (atoi (cdr (assoc 1 (entget refb))))))))))
  (if (= amk nil) (setq eamk 1))
  (setq amk (getint (strcat "Artis miktari <" (itoa eamk) "> : ")))
  (if (= nil amk) (setq amk eamk))
  (while (setq refb (ssget ":s" (list (cons 0 "BLOCK") (cons 66 1))))
    (setq sayi (1+ sayi) SOb bLck)
    (if (< sayi 10) (setq sy (strcat "0" (itoa sayi))) (setq sy (itoa sayi)))
    (if (= 1 (cdr (assoc 66 (entget bLck))))
      (progn
        (while (= (cdr (assoc 0 (entget (setq SOb (entnext SOb))))) "ATTRIB")
          (if (= (cdr (assoc 2 (entget SOb))) "NUM")
            (progn
              (setq pivot (entget SOb)
                    pivot (subst (cons 1 sy) (assoc 1 pivot) pivot)
                    esayi sayi)
              (entmod pivot) (entupd (cdr (assoc -1 pivot)))))))
      (princ "\nSeçtiğiniz obje Attribute içeren bir bLock olmalıdır...")))
  (command "undo" "e")(prin1)
)
İlk fonksiyon; seçtiğiniz bLock içindeki NUM tag'lı attribute'ün değerini verdiğiniz başlangıç numarasından başlayarak, verdiğiniz artış miktarı kadar her seferinde artırarak, siz bLock seçtiğiniz sürece devam eder. Numaralandırmaya ara verip, yeniden başladığınızda kaldığı numarayı hatırlar ve size teklif olarak getirir.Teklif edilen başlangıç numarasını kabul ediyorsanız ENTER ile geçmeniz yetlerli. Verdiğiniz numaraları unuttunuzsa, attributler invisible olduğu için bakması uzun olur düşüncesiyle, başlangıç numarası olarak negatif bir tamsayı girerseniz, sizden bir bLock seçmeniz istenir, seçilen bLock altında NUM attribute'ünün değeri başlangıç numarası olarak alınarak numaralandırmaya devam edilir.
Kod:

;;;====================================================;;;
;;;      Hayırlayan: M. Sahin Guvercin                 ;;;
;;;          sahinguvercin@hotmail.com                 ;;;
;;;====================================================;;;
(defun c:AtrKot ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (princ "\nKot işlenecek bLock seçiniz...")
  (setq bLck (ssget ":s" (list (cons 0 "INSERT") (cons 66 1))))
  (princ "\nKot alınacak PoLyLine seçiniz...")
  (setq koTpL (ssget ":s" (list (cons 0 "POLYLINE") (cons 66 1)))
        edst 1.0E9 vTx (ssname koTpL 0)
        bLins (cdr (assoc 10 (entget (ssname blck 0)))))
  (while (= (cdr (assoc 0 (entget (setq vTx (entnext vTx))))) "VERTEX")
    (setq dst (distance bLins (cdr (assoc 10 (entget vTx)))))
    (if (< dst edst) (setq pivot (cdr (assoc 10 (entget vTx))) edst dst)))
  (setq eLev (rtos (caddr pivot)) SOb (ssname bLck 0))
  (while (= (cdr (assoc 0 (entget (setq SOb (entnext SOb))))) "ATTRIB")
    (if (= (cdr (assoc 2 (entget SOb))) "ELEV")
      (progn
        (setq pivot (entget SOb)
              pivot (subst (cons 1 eLev) (assoc 1 pivot) pivot))
        (entmod pivot) (entupd (cdr (assoc -1 pivot))))))
  (command "undo" "e") (prin1)
)
İkinci fonksiyonumuz Seçilen bLock objesinin içindeki ELEV tag'lı attribute değerini, seçilen PoLyLine objesindeki Vertex'lerden en yakınında olanının Z koordinat değeri olarak set eder.

Yazdığım bu fonksiyonlarda değişiklik ve düzenleme istemeyiniz lutfen. Örnek olması bakımından yazdım. Görüldüğü gibi basit fonksiyonlar olmakla birlikte pek çok temel AutoLisp komutununun çok karmaşık sayılabilecek incelikli kullanımı söz konusu. Kolayca takip edilebilecek bir düzen ile yazdım, herhangi bir yazar alıp düzenleyerek istenen son hale getirebilir...

Kolay gelsin.

ProhibiT (31.01.2011 09:15 GMT)

28.01.2011 23:50    

pepper1988
Her iki lisp içinde Ayrı Ayrı Çok çok çok teşekkür ederim. :) Elimden gelse bende bi lisp yazardım. Ne kadar teşşekkür etsem az lisple otomasyon yapardım devamlı ederdi. Sonsuz teşekkürler.... :):)

Hocam o kadar Teşekkür ettim ama minnettarlık duygumu anlatamam
hala içimde çocuksu bir sevinç yüzümde anlamsız bi gülümseme :)
Lisp yazan tanıdıklar var hepsi bi havalarda kimse öyle kolay kolay ilgilenmiyor. Genellikle meşguller. Siz tanımadıgınız halde yardım ediosunuz ya ne diyim Cennetliksiniz ya :)

Biliyorum cok oldum ama;

Bu elevation yazan lisple ilgili bi sorum olacak X Y kordinatları sabit Z ye perpendicular inip degerini mi alıyo yoksa en yakın vertexi mi secio onu çözemedim. Bi satır bişi daha eklesek o aldıgı z degerine pick pointinden move etse olur mu :?
Blok içine numara veren lispte düşünce olarak tam istedigim gibi aslında tek kelimeyle mükemmel ufak bi uyumsuzluk var heralde Blok seçmiyo bir türlü :(

pepper1988 (29.01.2011 03:40 GMT)

29.01.2011 07:07    

ProhibiT
Teşekkür ederim pepper1988 :)

İşinize yaramasına sevindim.
Elevation yazan fonksiyon, X ve Y koordinatları bLock'un X ve Y koordinatlarına en yakın olan vertex'in Z değerini alıyor. Çiziminizi incelediğimde, söz konusu PoLyLine objelerinizin yeteri kadar sık vertex'lerle tanımlandığını gördüm. Bahsettiğiniz gibi, bLock'un PoLyLine üzerindeki izdüşümünün, komşu iki vertex elevation değerleri arasında orantı kurup, o değeri yazdırmak mümkün elbette. Bu durumda en yakın 2 nokta pivot olarak alınacak. Keskin bükülmeler varsa hataya sebep olması ihtimali de var. Ama düşünelim şimdi, arazinin alımı yapılırken, kum tanelerine kadar almak mümkün değil. Bunları çizime ya da digital ortama aktarırken, bir kademe daha yaklaşım var. Bir de bahsettiğimiz arazi modeli üzerine hatları çizen fonksiyon kendi sınırları içinde yaklaşıyor. Bütün bunlar varken, bahsedilen hassasiyet ne kadar gerekir? bilemiyorum! Kulakları çınlasın bir hocamız; "Mühendis adam, ondalık noktasından sonra hangi basamakta duracağını bilendir" derdi.

Elevation değerini Atrribute'e atarken,
(setq eLev (rtos (caddr pivot))) fonksiyonunu,
(setq eLev (rtos (caddr pivot) 2 2) şeklinde yazarak, ondalık sayı formatında ve ondalık noktasından sonra 2 basamak yazacak şekilde düzenleyebilirsiniz. Buradaki ikinci 2 ondalık basamk sayısını tanımlar.

Kolay gelsin.

ProhibiT (30.01.2011 12:15 GMT)

29.01.2011 14:22    

pepper1988
Şahin Bey,
Detaylı açıklamalarınızla beni aydnlattıgınız icin cok teşekkür ederm :)
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
        (princ "\nSon numarayı almak istediğiniz bLock seçiniz...")
        (setq refb (ssget ":s" (list (cons 0 "BLOCK") (cons 66 1))))
        (while (= (cdr (assoc 0 (entget (setq refb (entnext refb))))) "ATTRIB")
          (if (= (cdr (assoc 2 (entget refb))) "NUM")
            (setq sayi (atoi (cdr (assoc 1 (entget refb))))))))))
  (if (= amk nil) (setq eamk 1))
  (setq amk (getint (strcat "Artis miktari <" (itoa eamk) "> : ")))
  (if (= nil amk) (setq amk eamk))
  (while (setq refb (ssget ":s" (list (cons 0 "BLOCK") (cons 66 1))))
    (setq sayi (1+ sayi) SOb bLck)
    (if (< sayi 10) (setq sy (strcat "0" (itoa sayi))) (setq sy (itoa sayi)))
    (if (= 1 (cdr (assoc 66 (entget bLck))))
      (progn
        (while (= (cdr (assoc 0 (entget (setq SOb (entnext SOb))))) "ATTRIB")
          (if (= (cdr (assoc 2 (entget SOb))) "NUM")
            (progn
              (setq pivot (entget SOb)
                    pivot (subst (cons 1 sy) (assoc 1 pivot) pivot)
                    esayi sayi)
              (entmod pivot) (entupd (cdr (assoc -1 pivot)))))))
      (princ "\nSeçtiğiniz obje Attribute içeren bir bLock olmalıdır...")))
  (command "undo" "e")(prin1
)

Bu lispte bi sıkıntı var tıkladıgım blok aktif olmuyo ve numara vermiyo neden olabilir bir fikriniz varmı

30.01.2011 10:07    

ProhibiT
Bu fonksiyon;
- Seçtiğiniz objenin bLock olup olmadığına bakıyor. (cons 0 "BLOCK")
- Atrribute içerip içermediğine bakıyor. (cons 66 1)
- İlk iki şart doğru ise, attribute'ler içinde Tag'ı "NUM" olanı arıyor (= (assoc 2 (entget SOb)) "NUM").
Bütün bunlar doğru ise, sıradaki numarayı Attribute'e değer olarak veriyor.

Bu açıklamadan sonra;
- nasıl olmuşsa sondan bir önceki satırda (prin1 olmuş. burada parantez kapatılmalı (prin1) olmalı. Hata bundan kaynaklanıyordur.

Sorunuzla ilgili fonksiyon kod'una bakınca 2 şey dikkatimi çekti;
- Obje seçilirken bLock olup olmadığına, arrtibute içerip içermediğine bakılıyor. Bu şartları sağlamayan obje zaten seçilemez. Devam eden bölümde tekrar Attribute içerip içermediğini kontrol ettirmişim. Buna gerek yok.
- Eğer seçilen obje bLock ve attribute içeriyor, fakat "NUM" Tag'lı attribute yoksa işlem yapmıyor. Ama, numarayı bir artırıyor. İşlem yapamadıysa sıra numarasının artırılmaması gerekir.

Bahsettiğimiz 3 durumuda düzelttiğimizde, her iki fonksiyonu;
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)
)

;;;====================================================;;;
;;;      Hayırlayan: M. Sahin Guvercin                 ;;;
;;;          sahinguvercin@hotmail.com                 ;;;
;;;====================================================;;;
(defun c:AtrKot ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (while (setq bLck (car (entsel "\nKot işlenecek bLock seçiniz...")))
    (if (and
          (= (cdr (assoc 0 (entget bLck))) "INSERT")
          (= (cdr (assoc 66 (entget bLck))) 1))
      (progn
        (setq Ob (entget bLck) edst 1.0E9 bLins (cdr (assoc 10 (entget bLck))))
        (while (= (cdr (assoc 0 (entget (setq bLck (entnext bLck))))) "ATTRIB")
          (if (= (cdr (assoc 2 (entget bLck))) "ELEV")
            (progn
              (setq koTpL (car (entsel "\n     Kot alınacak PoLyLine seçiniz...")))
              (if (and
                    (= (cdr (assoc 0 (entget koTpL))) "POLYLINE")
                    (= (cdr (assoc 66 (entget koTpL))) 1))
                (while (= (cdr (assoc 0 (entget (setq koTpL (entnext koTpL))))) "VERTEX")
                  (setq dst (distance bLins (cdr (assoc 10 (entget koTpL)))))
                  (if (< dst edst)
                    (setq pivot (cdr (assoc 10 (entget koTpL))) edst dst))))
              (setq eLev (rtos (caddr pivot)) SOb (entget bLck)
                    SOb (subst (cons 1 eLev) (assoc 1 SOb) SOb)
                    ob (subst (cons 10 (list (car bLins) (cadr bLins) (atof eLev)))
                              (assoc 10 ob) ob))
              (entmod SOb) (entupd (cdr (assoc -1 SOb)))
              (entmod Ob) (entupd (cdr (assoc -1 Ob)))))))))
  (command "undo" "e") (prin1)
)
şeklinde yazıp kullanmak daha doğrudur. Bir noktaya dikkat; numaralandırmaya 1'den başlamak için başlangıç numarası olarak 0 girilmelidir. AtrKot fonksiyonuna bahsettiğiniz satırı ekledim, bLock objesini Attribute'de yazan elevation'a getiriyor.

Bazı fonksiyonları, AutoCAD ve Visual Lisp Editor kullanmadan doğrudan başka platformlarda yazdığım için... bazı basit hatalar olabiliyor.

Kolay gelsin.

ProhibiT (30.01.2011 12:25 GMT)

01.02.2011 04:16    

pepper1988
Ellerine saglık hocam bi internet problemim olduda yeni ulasabildim foruma mükemmel olmuş. Eline koluna emegine saglık. Açıklamaların süper ya lsipin gizemini çözmekte bizim gibi acemilere yol gösteriyorsunuz. Çok teşekkürler... :)

02.02.2011 06:33    

ProhibiT
Istediklerinizden bir tek, elevation alırken polyline'ın en yakın vertex z değerini değil de, enterpolasyon yapılarak daha hassas değerinin alınması kaldı. ne kadar gerekli bilmiyorum. en yakın 2 noktayı bulmak yetlerli olmayacaktır, en yakın iki nokta block'un aynı tarafında çıkabilir. bu nedenle bir algoritma kurulup, block'u ortaya alacak en yakın iki nokta bulunmalı. daha önce de bahsettiğim gibi örnek olması bakımından temel kavramları ve mantığını açıklamak amacıyla yazdığım fonksiyonların amacını aşar diye düşünüyorum.

kolay gelsin.

02.02.2011 08:57    

oguzkilic
Dt komutuyla yazılmış sayı ile yine başka bir sayıyı çarpıp sonucuna baska bir sayıya tıkladığımızda veren bir lsip yazılabilinirmi acaba?

02.02.2011 09:32    

ProhibiT
Örnek olması için basit bir fonksiyon;
- birinci çarpan olarak text objesi seçilir
- ikinci çarpan olarak text objesi seçilir
- sonucun yazılacağı text objesi seçilir.
- seçilen text objeleri, mtext'te olabilir.
- çarpanların içeriği sayısal olmalıdır.
- sonuç yazılacak text veya mtext objesi sayısal ya da alfasayısal olabilir.
Kod:

(defun c:crp ()
  (setq rslt (* (atof (cdr (assoc 1 (entget (car (entsel "\n  birinci çarpanı seçiniz.  .  .  "))))))
                (atof (cdr (assoc 1 (entget (car (entsel "\n    ikinci çarpanı seçiniz.  .  .  ")))))))
        crpm (entget (car (entsel "\n      çarpımı seçiniz.  .  .  ")))
        crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm))
  (entmod crpm)
  (entupd (cdr (assoc -1 crpm)))
  (prin1)
)


kolay gelsin.

ProhibiT (06.04.2011 09:25 GMT)

02.02.2011 10:10    

miyatu
Prohibit hocamız konuyu cok kısa ve öz olarak mukemmel bir şekilde yanıtlamış. . .

benimde deneme ve calışmalarım sırasında yazdıgım ve şimdi bir kaç kenar süsü eklediğim bir calışmam

bu fonksiyon cözümü uzun yoldan ele almıştır

sonucu 4 hane hassasiyetle verir
nesne secilemez yada secilen nesne text değilse tekrar secim yapmanızı ister.

Kod:

;ana fonksıyon

;fonksıyonu tanımlama ve calıstırma kodunu belirleme

(defun c:crp ()
 
  ;ilk sayının seçilmesi eger secilen nesne text degilse yada nesne secilememişse tekrar sec
 
  (while (or (= (setq secim1 (entsel "\nılk sayiyi sec:")) nil)(/= (entdal secim1 0) "text")))
 
  ;ikinci sayının secilmesi eger secilen nesne text degilse yada nesne secilememişse tekrar sec
 
  (while (or (= (setq secim2 (entsel "\nıkinci sayiyi sec:")) nil)(/= (entdal secim2 0) "text")))
 
  ;ilk sayı ve ikinci sayı için nesneden bilgi alan kısmın tetiklenmesi ve sonucun hazırlanması
 
  (setq sonuc (rtos (* (atof (entdal secim1 1)) (atof (entdal secim2 1)))2 4))
 
  ;degisecek text in secilmesi secilemez yada secilen nesne text değilse tekrar sec
 
  (while (or (= (setq secim3 (entsel "\ndegisecek text i sec:")) nil)(/= (entdal secim3 0) "text")))
 
  ;text değiştiren kısmın tetiklenmesi
 
  (text_deg secim3 sonuc)
 
  ;fonksiyon sonu mesaj
 
  (princ "\nmiyatu tool kullanıldı [crp]. . . ")
 
  ;son mesajın temizlenmesi cıktıyı tekrarlamayı önler
 
  (princ)
)

;yukleme sonrası mesaj

(princ "\nıkı sayıyı carpan lısp yuklendı calıstırmak ıcın [crp] yaz. . . ")

;entsel ıle secilen nesneden bilgi alır

(defun entdal (#liste #key)
  (setq #data (cdr (assoc #key (entget (car #liste)))))
)

;entsel ıle secilen texti önceden hazırlanmış başka text ile değişitrir

(defun text_deg (#secim #yeni)
  (setq #dt (entget (car #secim)))
  (setq #dt (subst (cons 1 #yeni) (assoc 1 #dt) #dt))
  (entmod #dt)
)

miyatu (02.02.2011 10:17 GMT)

02.02.2011 10:38    

emasi
Prohibit hoca. bu son verdiyiniz çarpan lispe eyer bir neçe çarpılan rakam varsa onu bir birine çarpan lispe düzenlerseniz iyi olurdu.
bu çarpma işini lispsizde yapmak çokta vakit almıyor amma bizde bi işçi var hesap makinesinde çok gürültü yapıyorda :):):)
uğurlar

emasi (02.02.2011 10:43 GMT)

02.02.2011 10:58    

ProhibiT
Miyatu iltifatın ve katkıların için teşekkür ederim :)
tevazu gösterip, deneme çalışmalarım diye nitelediğin güzel lisp'lerini araştırıcı ve gelişime açık yaklaşımını da severek izliyorum. . .
söz bu konudan açılmışken;
Kod:

(while (not (setq secim1 (ssget ":s" (list (cons 0 "*text"))))))
(setq secim1 (ssname secim1 0))
şeklinde kontrollü seçim tarzını denemeni tavsiye ederim, seveceğinizi tahmin ediyorum.
(ssget ":s" kullanarak aynı (entsel 'de olduğu gibi tek obje seçiliyor.
(cons 0 "*text") ile de seçilen objenin text veya mtext olması kontrol ediliyor.
tek sıkıntı while loop'tan çıkınca seçim seti oluşturulduğundan tek elemanlı seçim setinin ilk elemanını tekrar alarak, object name'e dönmek.

emasi arkadaşımızın isteğine karşılık bir açıklama yapma gereği duyuyorum.
burada verdiğimiz bu ayaküstü fonksiyonlardan amaç, soruyu soran arkadaşımızın bütün ihtiyaçlarını karşılayacak, o konuya has bir fonksiyon yazmak değil. sorunun kapsamını genişletip, daha genel amaca hizmet eden bir şeyler yazarken, aynı zamanda verilen basit fonksiyonu değiştiriverip ihtiyacına göre uyarlayacak arkadaşları teşvik etmek, yeni yazarlar kazanmak :) ben böyle bir fonksiyonu görsem ilk aklıma gelen; * işaretini -, + veya / yaparak diğer işlemleri yapan yeni fonksiyonları türetmek olurdu. .

sonuç olarak fonksyionun temel mantığı belli, bahsettiğiniz gibi seçilen iki'den ziyade sayıların çarpımını yapan fonksiyonu sizler yazabilirsiniz diye düşünüyorum. . .

kolay gelsin.

02.02.2011 11:37    

miyatu
Alıntı
prohibit :
miyatu iltifatın ve katkıların için teşekkür ederim :)
tevazu gösterip, deneme çalışmalarım diye nitelediğin güzel lisp'lerini araştırıcı ve gelişime açık yaklaşımını da severek izliyorum. . .
söz bu konudan açılmışken;
Kod:

(while (not (setq secim1 (ssget ":s" (list (cons 0 "*text"))))))
(setq secim1 (ssname secim1 0))
şeklinde kontrollü seçim tarzını denemeni tavsiye ederim, seveceğinizi tahmin ediyorum.
(ssget ":s" kullanarak aynı (entsel 'de olduğu gibi tek obje seçiliyor.
(cons 0 "*text") ile de seçilen objenin text veya mtext olması kontrol ediliyor.
tek sıkıntı while loop'tan çıkınca seçim seti oluşturulduğundan tek elemanlı seçim setinin ilk elemanını tekrar alarak, object name'e dönmek.

emasi arkadaşımızın isteğine karşılık bir açıklama yapma gereği duyuyorum.
burada verdiğimiz bu ayaküstü fonksiyonlardan amaç, soruyu soran arkadaşımızın bütün ihtiyaçlarını karşılayacak, o konuya has bir fonksiyon yazmak değil. sorunun kapsamını genişletip, daha genel amaca hizmet eden bir şeyler yazarken, aynı zamanda verilen basit fonksiyonu değiştiriverip ihtiyacına göre uyarlayacak arkadaşları teşvik etmek, yeni yazarlar kazanmak :) ben böyle bir fonksiyonu görsem ilk aklıma gelen; * işaretini -, + veya / yaparak diğer işlemleri yapan yeni fonksiyonları türetmek olurdu. .

sonuç olarak fonksyionun temel mantığı belli, bahsettiğiniz gibi seçilen iki'den ziyade sayıların çarpımını yapan fonksiyonu sizler yazabilirsiniz diye düşünüyorum. . .

kolay gelsin.



hocam ilginiz ve tavsiyeleriniz için çok teşekkür ederim. . .

bir konuya açıklık getirmek isterim. . .

ben lisp de yeni bir konu öğrendiğimde, bunu ilk aritmetik işlemlerde denerim. . .
yukarda paylaşmış oldugum lisp benim için uzun ve sancılı bir dönemin ürününün düzenlenmiş halidir.

02.02.2011 11:48    

ProhibiT
Emasi, sizin o arkadaşın gürültülü hesap makinesinden kurtulmanız için :);
Kod:

(defun c:crpm ()
  (princ "\n  çarpılacak sayıları seçiniz.  .  .  ")
  (setq crpn (ssget (list (cons 0 "*text")))
        l (sslength crpn) n -1 rslt 1)
  (while (< (setq n (1+ n)) l)
    (setq rslt (* rslt (atof (cdr (assoc 1 (entget (ssname crpn n))))))))
  (setq crpm (entget (car (entsel "\n    çarpımını seçiniz.  .  .  ")))
        crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm))
  (entmod crpm)
  (entupd (cdr (assoc -1 crpm)))
  (prin1)
)
burada anlatmak istediğim o ki; (setq rslt (* rslt (atof (cdr (assoc 1 (entget (ssname crpn n)))))))) satırındaki * işareti yerin + koyarsanız seçilen sayıları toplayan bir fonksiyon haline getirmiş olacaksınız.

kolay gelsin.

ProhibiT (02.02.2011 14:39 GMT)

> 1 < [2] [3] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.42 saniye - Sorgu: 108 - Ortalama: 0.01315 saniye