Reklam

* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
17.12.2009 14:18
54092    
bluebeta

[1] Yeni üye

Online Durumu

21 ileti
Çevre Müh.
İstanbul

Arkadaşlar elinde attribute leri text e çeviren lispi olan var mı...

Çalışma, insanların vücut kuvvetlerini geliştirir ve hayat için gereken şeyleri temin eder. Çalışmaksızın, fikri gelişme ve ahlaki ilerleme de mümkün değildir. Tembellik bütün fenalıkların anasıdır.

M. Kemal ATATÜRK

17.12.2009 15:29
54095    
ehya

[90] Yönetici

Online Durumu

3178 ileti
Teknik Ressam
Ankara

Lisp'e gerek yok. Express menü komutlarından BURST komutu ile bu işlemi yapabilirsiniz.

17.12.2009 16:02
54096    
bluebeta

[1] Yeni üye

Online Durumu

21 ileti
Çevre Müh.
İstanbul

Bizim elimizdeki AutoCAD lerin hepsi LT. Sadece bir tane LT olmayan var o da 2004 ve express menü yok...
O yüzden 2004 de çalıştıracağım bir lisp arıyordum...

Çalışma, insanların vücut kuvvetlerini geliştirir ve hayat için gereken şeyleri temin eder. Çalışmaksızın, fikri gelişme ve ahlaki ilerleme de mümkün değildir. Tembellik bütün fenalıkların anasıdır.

M. Kemal ATATÜRK

18.12.2009 00:07
54101    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Merhaba arkadaşlar,

Bu konuyla ilgili ehya hocamın da bahsettiği gibi BURST diye bir komut (Express Tools içinde bir AutoLisp fonksiyonu) olmasına rağmen bir programcık yazdım. Belki de bluebeta arkadaşımızın problemini de çözmeyecek, vl-remove komutunu kullandım, AutoCAD 2004'te bu komut var mı, kullanılabiliyor mu? bilmiyorum çünki.

Bu fonksiyonu genel olarak AutoCAD kullanıcıları için değil de, AutoLisp yazan arkadaşlar için ilginç bir örnek olabilir düşüncesiyle yaplaşıyorum.

AtrYaz komutunu girdiğinizde, çizim içinde insert edilmiş bütün block'ları bulur, içlerinde attribute olup olmadığına bakar, attribute invisible ise işlem yapmaz, bunu dışındaki türde attribute içeren blockları explode eder ve içerdikleri (invisible olanların dışındaki) attribute'lerin değerini Text olarak yazar.

Yalnızca insert edilmiş block'ları explode ettiğinden ilgili block tanımlarını yok etmez...

Kod:

(defun c:atryaz ()
  (setvar "cmdecho" 0)
  (setq BLcks (ssget "x" (list (cons 0 "INSERT")))
        SLeng (sslength BLcks)
        n     0
  )
  (while (< n SLeng)
    (setq SObj (ssname BLcks n))
    (if (= 1 (cdr (assoc 66 (entget SObj))))
      (progn
        (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext SObj)))))
          (setq AtrOb (entget (entnext SObj)))
          (if (/= (cdr (assoc 70 AtrOb)) 1)
            (progn
              (setq AtrOb (vl-remove (assoc 280 AtrOb) AtrOb)
                    AtrOb (vl-remove (assoc 280 AtrOb) AtrOb)
                    AtrOb (vl-remove (assoc 2 AtrOb) AtrOb)
                    AtrOb (vl-remove (assoc 70 AtrOb) AtrOb)
                    AtrOb (vl-remove (assoc 74 AtrOb) Atrob)
                    AtrOb (vl-remove (assoc 5 AtrOb) AtrOb)
                    AtrOb (subst (cons 0 "TEXT") (assoc 0 AtrOb) AtrOb)
                    AtrOb (subst (cons 100 "AcDbText") (cons 100 "AcDbAttribute") AtrOb)
              )
              (entmake AtrOb)
            )
          )
          (setq SObj (entnext SObj))
        )
        (command "explode" Sobj)
        (command "erase" (ssget "p" (list (cons 0 "ATTDEF"))) "")
      )
    )
    (setq n (1+ n))
  )
  (prin1)
)


Selamlar, Sevgiler, Herkese Kolay Gelsin...

Harbi65 hocamın tavsiyesi doğrultusunda düzeltilmiş halidir.


ProhibiT (28.12.2009 10:34 GMT)

Where there is a will, there is a way... Beğenmek için anlamak lazım...

18.12.2009 00:46
54104    
Harbi65

[10] Üstad

Online Durumu

413 ileti
İnş.Tekn. Teknik Ressam
KASTAMONU

Hocam eline sağlık güzel bir örnek olmuş...
Ancak yeni text'i yazdığında Tag'ları silmesi gerekmez mi?
Bir de assoc 72 kodu olması gerekiyor galiba.. Text aynı yere yerleşmiyor...
AtrOb (vl-remove (assoc 72 AtrOb) Atrob)

18.12.2009 01:05
54106    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Harbi65 hocam haklısınız
assoc 72 kodu kullanılmayınca Horizontal Text Justification kayboluyor...

Tag'lara gelince, BLock'u explode edince entlast'tan başlayarak geri doğru tarayarak ATTDEF türü objeleri siliyoruz. Böylelikle Attribute tanımları (Tag, Prompt ve default Value) siliniyor. Ya da ben sınırlı örnekler üzerinde denediğim için bendeki özel halde öyle oluyordur

Bu arada ilginç olan bir şey; Objeleri çizim sıramız ve block yaparken seçim sıramız ne olursa olsun, BLock explode edilince, Attdef objeleri daima sonda sıralanıyorlar.

Onun için bir while loop içinde entlast objesini alıp Attdef ise siliyorum, o silinince bir önceki obje entlast durumuna geliyor... entlast objesi Attdef olmayıncaya kadar devam ederek, Attribute Definition'ları siliyorum.

Başta da yazdığım gibi, programlama mantığı açısından ilginç geldiği için paylaştım

Kolay Gelsin...

Where there is a will, there is a way... Beğenmek için anlamak lazım...

18.12.2009 01:10
54107    
Harbi65

[10] Üstad

Online Durumu

413 ileti
İnş.Tekn. Teknik Ressam
KASTAMONU

Paylaşımın içinçok teşekkürler.. Gerçekten güzel bir örnek oldu...
Bende silmesi lazım diye düşündüm ancak dediğim gibi.. 4 tane attribut içeren bi blok üzerinde denedim ATTDEF'lerin hiç birini silmedi..
Sanırım Explode yaptıktan sonra yeni bir seçim seti içinde taratmak gerekiyor...

18.12.2009 02:00
54108    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Harbi65 hocam,

Nezaket ve tevazu gösterip özel mesaj olarak yazdığınız çözümü müsadenizle burada paylaşmak istiyorum

demişsiniz ki;
Kod:

(command "explode" Sobj)
        (setq Sobj:Lst (ssget "p"))
        (setq li 0)
        (repeat  (sslength Sobj:Lst)
          (setq Lst:El (ssname Sobj:Lst li))
          (if (= "ATTDEF" (cdr (assoc 0 (entget Lst:El))))
            (entdel Lst:El)
            )
          (setq li (1+ li))
          )

şeklinde yazılsa daha doğru olmaz mı?

Kesinlikle haklısınız, benim şeytanımın aklına gelmez bir detayı gösterdiniz bana. Teşekkürler.

Explode edilen block objelerinin Previous Selection set'e alındığını bilmiyordum, denedim doğru.
Gene özel mesajınızda "belkide siz daha kısa çözersiniz" demişsiniz. Sizi haklı çıkarmak için yazıvereyim bari

Kod:

(command "explode" Sobj)
(setq Sobj:Lst (ssget "p" (list (cons 0 "ATTDEF"))) li 0)
(repeat (sslength Sobj:Lst)
  (entdel Lst:El)
  (setq li (1+ li))
)


Çok canımızı sıkarsa abartıp;
Kod:

(command "erase" (ssget "p" (list (cons 0 "ATTDEF"))) "")

şeklinde bile yazabiliriz ))

Where there is a will, there is a way... Beğenmek için anlamak lazım...

18.12.2009 02:04
54109    
Harbi65

[10] Üstad

Online Durumu

413 ileti
İnş.Tekn. Teknik Ressam
KASTAMONU

Daha pratik çözeceğinize emin olduğum için demiştim zaten..
Elinize sağlık. Bence şimdi sorun kalmadı... Teşekkürler.

18.12.2009 02:57
54110    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

bluebeta arkadaşımızın AutoCAD 2004 versiyonunda da işine yaramasını garanti etmek için vl-remove kullanmadan yeniden düzenlenmiş hali;
Kod:

(defun c:atryaz ()
  (setvar "cmdecho" 0)
  (setq BLcks (ssget "x" (list (cons 0 "INSERT")))
        SLeng (sslength BLcks)
        n     0
  )
  (while (< n SLeng)
    (setq SObj (ssname BLcks n))
    (if (= 1 (cdr (assoc 66 (entget SObj))))
      (progn
        (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext SObj)))))
          (setq AtrOb (entget (entnext SObj)))
          (if (/= (cdr (assoc 70 AtrOb)) 1)
            (entmake
              (list
                (cons 0 "TEXT")
                (cons 100 "AcDbEntity")
                (cons 67 (cdr (assoc 67 AtrOb)))
                (cons 410 (cdr (assoc 410 AtrOb)))
                (cons 8 (cdr (assoc 8 AtrOb)))
                (cons 100 "AcDbText")
                (cons 10 (cdr (assoc 10 AtrOb)))
                (cons 40 (cdr (assoc 40 AtrOb)))
                (cons 1 (cdr (assoc 1 AtrOb)))
                (cons 50 (cdr (assoc 50 AtrOb)))
                (cons 41 (cdr (assoc 41 AtrOb)))
                (cons 51 (cdr (assoc 51 AtrOb)))
                (cons 7 (cdr (assoc 7 AtrOb)))
                (cons 71 (cdr (assoc 71 AtrOb)))
                (cons 72 (cdr (assoc 72 AtrOb)))
                (cons 11 (cdr (assoc 11 AtrOb)))
                (cons 210 (cdr (assoc 210 AtrOb)))
                (cons 100 "AcDbText")
                (cons 73 (cdr (assoc 73 AtrOb)))
              )
            )
          )
          (setq SObj (entnext SObj))
        )
        (command "explode" Sobj)
        (command "erase" (ssget "p" (list (cons 0 "ATTDEF"))) "")
      )
    )
    (setq n (1+ n))
  )
  (prin1)
)


Selamlar, Sevgiler, Herkese Kolay Gelsin...


ProhibiT (29.12.2009 14:13 GMT)

Where there is a will, there is a way... Beğenmek için anlamak lazım...

18.12.2009 10:20
54114    
ehya

[90] Yönetici

Online Durumu

3178 ileti
Teknik Ressam
Ankara

hocam gecenin bi yarısı yine aşmışsınız ne diyeyim Elinize sağlık. Express menü kullanamayanlar için güzel bir lisp oldu...

18.12.2009 19:12
54132    
bluebeta

[1] Yeni üye

Online Durumu

21 ileti
Çevre Müh.
İstanbul

Arkadaşlar ellerinize sağlık. Çok işime yaradı. Hepinize çok teşekkürler...

Çalışma, insanların vücut kuvvetlerini geliştirir ve hayat için gereken şeyleri temin eder. Çalışmaksızın, fikri gelişme ve ahlaki ilerleme de mümkün değildir. Tembellik bütün fenalıkların anasıdır.

M. Kemal ATATÜRK

24.02.2011 18:48
62953    
aslanv

[5] Uzman

Online Durumu

86 ileti
Rest. Y. Mimar
İstanbul

Merhaba arkadaşlar,
aşağıdaki çizimi örrnek olarak yoluyorum ve size bir sorum olacak. en uygun konu da bu başlık altında. şimdi attribute ile oıluştutulmuş mahal pozları var. 5k-6k-8k ile başlayan yazılar tag ile oluşturulduğundan find ve replace ona işlemiyor. çizim içindeki tüm 5k ları 4k yap diyecektik o zaman farkettik. şimdi sorum şu tag leri nasıl text e dönüştürebilirim. teşekkürler.

52082-mahal.rar


serhatkoroglu (25.02.2011 18:48 GMT)

25.02.2011 07:11
62958    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Ben soruyu pek iyi anlayamadım herhalde bunun için değişik ihtimallere göre basit fonksiyonlar yazdım.
Kod:

;;; Seçilen tek bir Attribute Definition'ın Tag değerini Value olarak atama.
(defun c:TV ()
  (setq patr (entget (car (entsel))) patr (subst (cons 1 (cdr (assoc 2 patr))) (assoc 1 patr) patr))
  (entmod patr) (entupd (cdr (assoc -1 patr))) (prin1)
)

;;; Seçilen obje gurubu içibdeki Attribute Definition'ların
;;; Tag değerlerini Value olarak atama.
(defun c:TV1 ()
  (setq patrs (ssget (list (cons 0 "attdef"))) L (sslength patrs) n -1)
  (while (< (setq n (1+ n)) L)
    (setq patr (entget (ssname patrs n)) patr (subst (cons 1 (cdr (assoc 2 patr))) (assoc 1 patr) patr))
    (entmod patr) (entupd (cdr (assoc -1 patr)))) (prin1)
)

;;; Seçilen bLock Reference (insert) objesi içindeki
;;; Attribute (Atrrib) objelerinin Tag değerlerini Value olarak atama.
(defun c:TV2 ()
  (setq patr (ssname (ssget ":s" (list (cons 0 "insert") (cons 66 1))) 0))
  (while (= (strcase "attrib") (cdr (assoc 0 (entget (setq patr (entnext patr))))))
    (setq atrs (entget patr) atrs (subst (cons 1 (cdr (assoc 2 atrs))) (assoc 1 atrs) atrs))
    (entmod atrs) (entupd (cdr (assoc -1 atrs)))) (prin1)
)

;;; Seçilen obje gurubundaki bLock Reference (insert) objeleri içindeki
;;; Attribute (Atrrib) objelerinin Tag değerlerini Value olarak atama.
(defun c:TV3 ()
  (setq patrs (ssget (list (cons 0 "insert") (cons 66 1))) L (sslength patrs) n -1)
  (while (< (setq n (1+ n)) L)
    (setq patr (ssname patrs n))
    (while (= (strcase "attrib") (cdr (assoc 0 (entget (setq patr (entnext patr))))))
      (setq atrs (entget patr) atrs (subst (cons 1 (cdr (assoc 2 atrs))) (assoc 1 atrs) atrs))
      (entmod atrs) (entupd (cdr (assoc -1 atrs))))) (prin1)
)

;;; Seçilen obje gurubundaki bLock Reference (insert) objeleri içindeki
;;; Attribute (Atrrib) objelerinin girilen Tag değeri ile uyuşan
;;; Tag değerlerini Value olarak atama.
(defun c:TV4 ()
  (setq Tg (getstring "\Value atanacak Tag: ") patrs (ssget (list (cons 0 "insert") (cons 66 1))) L (sslength patrs) n -1)
  (while (< (setq n (1+ n)) L)
    (setq patr (ssname patrs n))
    (while (= (strcase "attrib") (cdr (assoc 0 (entget (setq patr (entnext patr))))))
      (if (= Tg (cdr (assoc 2 (entget patr))))
        (progn (setq atrs (entget patr) atrs (subst (cons 1 (cdr (assoc 2 atrs))) (assoc 1 atrs) atrs))
          (entmod atrs) (entupd (cdr (assoc -1 atrs))))))) (prin1)
)
Gözönüne almadığım bir ihtimal var, Atrribute'ün Tag'inin Text olarak yazdırılması ve Attribute objesinin yok edilmesi.

Kolay gelsin.

Where there is a will, there is a way... Beğenmek için anlamak lazım...

25.02.2011 11:25
62962    
aslanv

[5] Uzman

Online Durumu

86 ileti
Rest. Y. Mimar
İstanbul

Hocam elinize sağlık ancak sanırım gözönüne almadığınız ihtimal benim yapmak istediğim ihtimal. :-) seçeceğim tag objelerin text e dönüşmesi ve tag özelliğinin gitmesi.

25.02.2011 15:28
62965    
halilozcakir

[10] Üstad

Online Durumu

541 ileti
Mekanik Teknik Ressam /Teniker
İstanbul

Burst komutu att leri text e çeviriyor denedin mi ? şu lispleri lt lerde kullanamamak ne acı (:

25.02.2011 15:59
62967    
aslanv

[5] Uzman

Online Durumu

86 ileti
Rest. Y. Mimar
İstanbul

Burst komutunu biliyorum o text'e çeviriyor ancak benim sorunum bloklanmadan tag olarak yazılmış bütün yazıları text haline getirmek. henüz çözemedim.

25.02.2011 21:09
62979    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Aslında yukarıda verdiğim tv ve tv1 fonksiyonları block yapılmamış attribute definition'ların tag değerini value olarak atama işlemini yapıyor. bu işlemden sonra da, find/replace kullanabilirsiniz. attribute definition'da "tag", "prompt" ve "default value" olur, block içinde insert edilince girdiğiniz değer (veya kabul edip geçerseniz default value) value olarak atanır. value değeri olmayan attribute definition objesi find/replace ile bulunamaz.

özet olarak illede text'e çevirmek gibi bir ihtiyacınız yoksa; tv2 kullanın, select object(s) dendiğinde "all" girip bütün çizimi seçebilirsiniz. bu basit işlemden sonra, attribute definition'larınıza value atanmış olacağından, find/replace işlemi yapabilirsiniz.
Kod:

;;; Seçilen obje gurubu içibdeki Attribute Definition'ların
;;; Tag değerlerine göre Text'e dönüştürülmesi
(defun c:TV5 ()
  (setq patrs (ssget (list (cons 0 "attdef"))) L (sslength patrs) n -1)
  (while (< (setq n (1+ n)) L)
    (setq patr (entget (ssname patrs n)))
    (entmake (list
               (cons 0 "TEXT") (assoc 67 patr) (assoc 410 patr) (assoc 8 patr)
               (assoc 10 patr) (assoc 40 patr) (cons 1 (cdr (assoc 2 patr)))
               (assoc 50 patr) (assoc 41 patr) (assoc 51 patr) (assoc 7 patr)
               (assoc 71 patr) (assoc 72 patr) (assoc 11 patr) (assoc 73 patr)))
    (entdel (cdr (assoc -1 patr))))
  (prin1)
)
Fonksiyonuyla, bütün attribute definition'ları Text objelerine dönüştürebilirsiniz.

Kolay gelsin.

Where there is a will, there is a way... Beğenmek için anlamak lazım...

28.02.2011 12:01
63009    
aslanv

[5] Uzman

Online Durumu

86 ileti
Rest. Y. Mimar
İstanbul

Prohibit hocam çok sağolun. tv5 istediğim şeydi. çok yardımcı oldunuz. tekrar teşekkürler emeğinize sağlık.

20.05.2013 13:36
73229    
Harbi65

[10] Üstad

Online Durumu

413 ileti
İnş.Tekn. Teknik Ressam
KASTAMONU

Prohibit Hocam;
Yukarıda paylaştığınız Atryaz lispi ile ilgili sorun yaşıyorum. Sorun benim bloklardan mı kaynaklanıyor onuda anlamadım.
Mirror yapılmış blokda Attributeleri texte çeviriyor fakat explode yaptıktan sonra tagları görmüyor ve dolayısıyla silmiyor. Taglar ters bi şekilde görünüyor. Bu sorunu nasıl çözebiliriz?

Copyright © 2004-2018 | Tüm Hakları Saklıdır | 3149 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam