AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Attribute to Text
17.12.2009 11:18    
bluebeta
Arkadaşlar elinde attribute leri text e çeviren lispi olan var mı...

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

17.12.2009 13:02    
bluebeta
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...

17.12.2009 21:07    
ProhibiT
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 07:34 GMT)

17.12.2009 21:46    
Harbi65
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)

17.12.2009 22:05    
ProhibiT
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...

17.12.2009 22:10    
Harbi65
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...

17.12.2009 23:00    
ProhibiT
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 :)))

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

17.12.2009 23:57    
ProhibiT
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 11:13 GMT)

18.12.2009 07:20    
ehya
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... :yes

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

24.02.2011 15:48    
aslanv
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 15:48 GMT)

25.02.2011 04:11    
ProhibiT
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.

25.02.2011 08:25    
aslanv
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 12:28    
halilozcakir
Burst komutu att leri text e çeviriyor denedin mi ? şu lispleri lt lerde kullanamamak ne acı (:

25.02.2011 12:59    
aslanv
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 18:09    
ProhibiT
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.

28.02.2011 09:01    
aslanv
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 09:36    
Harbi65
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?

> 1 < [2] [3] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.608 saniye - Sorgu: 100 - Ortalama: 0.01608 saniye