AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Lisp istekleri
29.08.2013 08:05    
darkbreaker
Alıntı
MSucullu :
arkadaşlar daha önceden başka bir autocad dosyasında hazırladığım blok çizimlerimden istediğim birini, çalışmakta olduğum dosya içine kopyala-yapıştır yapan bir lisp yazılabiliyormu. Acil değil ama olursa iyi olur.
Mehmet ATALAY ın işine yararsa bir lisp gönderiyorum. Rakam sıralamak için "Num1", harf sıralamak için "NumA" yazıyorsun sonra değiştirmek istersen bunu kendine göre değiştirebilirsin.

Kod:

(defun C:Num1 ()

(setq yazıyüksekliği (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq başsayı (getdist (strcat "
Başlangıç sayısını yazınız : ")))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))

(while (> 10000)
(setq başsayı (+ 1 başsayı))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı))
)
)

(defun C:NumA ()

(setq yazıyüksekliği (getdist (strcat "
Yazi Yuksekligini Giriniz : ")))
(setq başharfi (getstring (strcat "
Başlangıç harfi yazınız : ")))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" başharfi)

(while (> 10000)
(if (= başharfi "A") (setq başharfi "B") (if (= başharfi "B") (setq başharfi "C") (if (= başharfi "C") (setq başharfi "D") (if (= başharfi "D") (setq başharfi "E") (if (= başharfi "F") (setq başharfi "G")
(if (= başharfi "G") (setq başharfi "H") (if (= başharfi "H") (setq başharfi "I") (if (= başharfi "I") (setq başharfi "İ") (if (= başharfi "İ") (setq başharfi "J") (if (= başharfi "J") (setq başharfi "K")
(if (= başharfi "K") (setq başharfi "L") (if (= başharfi "L") (setq başharfi "M") (if (= başharfi "M") (setq başharfi "N") (if (= başharfi "N") (setq başharfi "O") (if (= başharfi "O") (setq başharfi "Ö")
(if (= başharfi "Ö") (setq başharfi "P") (if (= başharfi "P") (setq başharfi "R") (if (= başharfi "R") (setq başharfi "S") (if (= başharfi "S") (setq başharfi "Ş") (if (= başharfi "Ş") (setq başharfi "T")
(if (= başharfi "T") (setq başharfi "U") (if (= başharfi "U") (setq başharfi "Ü") (if (= başharfi "Ü") (setq başharfi "V") (if (= başharfi "V") (setq başharfi "Y") (if (= başharfi "Y") (setq başharfi "Z")
)))))))))))))))))))))))))
(setq koordinat (getpoint "
yazılacak yeri tıklayınız :"))
(setq koordinatx (car koordinat))
(setq koordinaty (cadr koordinat))
(setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0))
(command "text" "m" koordinatxy yazıyüksekliği "0" başharfi))
)
)




selamlar . arkadaslar bu lips e benze bir lips arıyorum forum baya bir okudum ama göremedim yada gözden kaçırdım. sıra sıra numara verirken aynı anada bu numaraları daire içine alan ve sadece numara değilde mesela 'L1' tarzında başına harfte girebileceğim bir lips varmıdır acaba? Linye numarası vermek için kullacağım bir lips yani.
TEŞEKKÜRLER

29.08.2013 08:39    
ehya
Lips değil, "LISP" önce istediğiniz şeyin adını doğru öğrenin. :no

29.08.2013 21:21    
Travaci
Alıntı
darkbreaker :

Alın size bir lips :D
Kod:

(defun c:aNo2 (/)
   (command "_.undo" "g")
   (setq oek (geTsTring t "\nÖn ek:")
      yZi (geTreal "\nBaşlangıç numarası: "))
   (while
      (setq pNt (poLar (geTpoint "\nYerleştirilecek nokta: ")
         (/ pi 2) (geTvar "teXtsize")))
      (entmake (list (cons 0 "teXt") (cons 10 pNt)
         (cons 11 pNt) (cons 1 (strcat oek (rtos yZi 2 0)))
         (cons 40 (getvar "teXtsize")) (cons 72 1) (cons 73 2)))
      (entmake (list (cons 0 "ciRcle") (cons 10 pNt)
         (cons 40 (geTvar "teXtsize"))))
      (setq yZi (+ 1 yZi))
   ) (command "_.undo" "e") (princ)
)

Yazı yüksekliği için textsize komutunu kullanın.

30.08.2013 13:35    
k005
Alıntı
Travaci :

Etiketlendirme/Pozlama/Numaralandırma ya yönelik güzel bir Lisp çalışması olmuş hocam..Elinize sağlık.

31.08.2013 08:50    
kerem1453
sayın taravacı bu ano2 lispi rakamsal olarak numaralandırma yapıyo bunu harf olarakta yazma ekleme şansınız varmı ?

31.08.2013 22:24    
Travaci
Üşenmediğim bi zaman bakarım umarım : )

14.09.2013 05:39    
cagrikara
Merhabalar,

3 boyutlu çizimlerde seçilecek çizgilerin,noktaların ya da herhangi nesnelerin arasında en düşük ve en yüksek z değerlerini belirtebilecek bir lisp mümkünmüdür ? Artı olarak seçilen z değerlerinde en düşük ve en yüksek değerlerin ortalamalarını da belirtebilir mi ?

cagrikara (14.09.2013 06:13 GMT)

23.09.2013 06:36    
darkbreaker
lisp için teşekkürler yanlış yazım için kusura bakmayın :blush

26.09.2013 11:46    
SENDUR
69972-lisp istekk.dwg

Arkadaşlar dwg deki gibi tıkladığım noktalara daire çizen ve sağ köşesine istediğim sayıdan sonraki sayıları sıra ile yazan ( mümkünse sayıları tutup sağ sola çekebileceğim) bir lispe ihtiyacım var. İlgilenen arkdaşlara teşekkürler.

Saygılar...

27.09.2013 08:07    
özkan-wien
Alıntı
SENDUR :


Arkadaşlar dwg deki gibi tıkladığım noktalara daire çizen ve sağ köşesine istediğim sayıdan sonraki sayıları sıra ile yazan ( mümkünse sayıları tutup sağ sola çekebileceğim) bir lispe ihtiyacım var. İlgilenen arkdaşlara teşekkürler.

Saygılar...


bu yaptigin blogu her köseye kopyalayip ve sonra "attdeg" komutuyla rakamlarin üstüne tiklayip degistirebilirsin.

(defun c:attdeg ()
(if (= secim nil)
(setq secim "Değiştir"))
(if (= sayi nil)(setq sayi 1))
(setq bs (getint (strcat "\nBaşlangıç sayısı: < : " (rtos sayi 2 0)" : >")))
(if (= bs nil)(setq bs sayi))
(setq sayi bs)
(initget 1 "Değiştir Başa ekle Sona ekle")
(setq islem (getkword "\nYazı değiştirme seçeneği : Değiştir / Başa ekle / Sona ekle : "))
(setq nnn nil)
(while (= nnn nil)
(setq nes (nentsel "\nDeğişecek yazıyı seçin:"))
(if (= nes nil)
(progn
(if (= (getvar "errno") 7)(setq nnn nil))
(if (= (getvar "errno") 52)(setq nnn t)))
(progn
(setq ntur (cdr (assoc 0 (entget (car nes)))))
(if (/= ntur "ATTRIB")
(progn
(setq nnn nil)(princ "\nSeçilen nesne ATTRIB değil..."))
(progn
(setq icerik (cdr (assoc 1 (entget (car nes))))
data (entget (car nes)))
(if (= islem "Değiştir")(setq yyazi (rtos sayi 2 0)))
(if (= islem "Başa")(setq yyazi (strcat (rtos sayi 2 0)icerik)))
(if (= islem "Sona")(setq yyazi (strcat icerik (rtos sayi 2 0))))
(entmod (subst (cons 1 yyazi)(assoc 1 data)data))
(setq sayi (+ sayi 1))
(setq nnn nil)
)))))
(princ)
)

27.09.2013 10:27    
SENDUR
Elinize, emeğinize sağlık güzel bir lisp olmus. Teşekkür ederim. Yalnız bu bloğuda kendi çizseydi daha kullanışlı olur daha az zaman alırdı.
Teşekkürler.


Saygılar

27.09.2013 11:39    
özkan-wien
rica ederim lispi ben yazmadim, Ehya sagolsun benim icin yazmisti.

27.09.2013 11:41    
adigejanberk
Arkadaşlar kolay gelsin. Benimde şöyle bir lisp isteğim olacaktı.
Çizim içindeki belli layerlardaki nesnelerin layerlarını, benim belirlediğim diğer layerlar ile değiştrmek istiyorum.

Örneğin ben komutu girdiğimde otomatik olarak;
Tüm "x" layerındaki nesnelerin layerını "y" layerı yap,
Tüm "k" layerındaki nesnelerin layerını "z" layerı yap,
Tüm "a" layerındaki nesnelerin layerını "b" layerı yap,
Tüm "c" layerındaki nesnelerin layerını "d" layerı yap,
Tüm "e" layerındaki nesnelerin layerını "f" layerı yap...

gibi bir iş yapacak olan lisp gerekli bana. Değişiklik yapılacak layerları ben kendim koda yazarım sizlayerları; a,b,c,d,e,f,.. diye isimlendirebilrsiniz şimdilik. Şimdiden çok teşekkür ederim emeğinize sağlık. İyi çalışmalar :)

27.09.2013 12:26    
SENDUR
Alıntı
adigejanberk :
Arkadaşlar kolay gelsin. Benimde şöyle bir lisp isteğim olacaktı.
Çizim içindeki belli layerlardaki nesnelerin layerlarını, benim belirlediğim diğer layerlar ile değiştrmek istiyorum.

Örneğin ben komutu girdiğimde otomatik olarak;
Tüm "x" layerındaki nesnelerin layerını "y" layerı yap,
Tüm "k" layerındaki nesnelerin layerını "z" layerı yap,
Tüm "a" layerındaki nesnelerin layerını "b" layerı yap,
Tüm "c" layerındaki nesnelerin layerını "d" layerı yap,
Tüm "e" layerındaki nesnelerin layerını "f" layerı yap...

gibi bir iş yapacak olan lisp gerekli bana. Değişiklik yapılacak layerları ben kendim koda yazarım sizlayerları; a,b,c,d,e,f,.. diye isimlendirebilrsiniz şimdilik. Şimdiden çok teşekkür ederim emeğinize sağlık. İyi çalışmalar :)


Sebin istediğinin daha iyisini autocad yapmış. LAYTRANS komutunu incele işini görecektir.

Kolay gelsin

27.09.2013 13:09    
özkan-wien
söyle bi sey mi

(defun c:lad (/)

(command "-rename" "la" "eskilayeradi" "yenilayeradi" "")
................
................

.............

)

28.09.2013 11:29    
adigejanberk
laytrans işimi gördü. SENDUR ve özkan-wien çok teşekkürler :)

30.09.2013 13:12    
ec
Merhaba, bir lisp isteğim olacak. Dosya içinde text olarak blok isimleri var. Blok isimlerinin yanına pratik bir şekilde blokları "insert" ile çağırmak istiyorum. Blok isimleri alt alta text halinde. Tümü için ya da her text için ayrı ayrı da olabilir. Yani texte tıkladığımda bloğu çağırması da yeterli. İlgilenen arkadaşlara teşekkür ederim.

30.09.2013 15:29    
Travaci
ec

Kod:

(defun c:inst (/)
   (setvar "cmdecho" 0) (command "undo" "group")
   (setq osm (getvar "osmode") ss (ssget (list (cons 0 "*text"))) c 0)
   (if (= ss nil)
      (progn (princ "\nSeçim yapılamadı.!"))
      (progn
         (setvar "osmode" 0)
         (while (< c (sslength ss))
            (setq ed1 (entget (ssname ss c))
              pnt (cdr (assoc 10 ed1)) nme (cdr (assoc 1 ed1)) c (1+ c))
            (command "insert" nme pnt 1 0)
         )
      )
   )
   (setvar "osmode" osm) (command "undo" "end") (princ)
)
02.10.2013 09:01    
CAN123
Arkadaşlar merhaba,

Asağıdaki lispte değişecek textleri tek tek değilde crossingle toplu şekilde seçtirebilirmiyiz.

teşekkurler


Kod:

(vl-load-com)
(defun c:TG ( / AcDoc Space js ename string)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (eq (getvar "CVPORT") 1)
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (princ "\nSelect text source: ")
  (while
    (not
      (setq js
        (ssget "_+.:E:S:N"
          (list
            (cons 0 "*TEXT,MULTILEADER,ATTRIB")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      )
    )
  )
  (setq
    ename (vlax-ename->vla-object (cadar (ssnamex js 0)))
    string (vlax-get ename 'TextString)
  )
  (princ "\nSelect text target: ")
  (while
    (setq js
      (ssget "_+.:E:S:N"
        (list
          (cons 0 "*TEXT,MULTILEADER,ATTRIB")
          (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
          (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
        )
      )
    )
    (setq ename (vlax-ename->vla-object (cadar (ssnamex js 0))))
    (vlax-put ename 'TextString string)
    (princ "\nSelect text target: ")
  )
  (prin1)
)

ehya (02.10.2013 11:01 GMT)

02.10.2013 11:24    
ec
Teşekkür ederim.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] > 44 < [45] [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.305 saniye - Sorgu: 98 - Ortalama: 0.01332 saniye