28.05.2010 12:29    

id
Seçilen yazıyı benim ismini atayacağım oluşturulan yeni bir layera taşıyan bir lisp mümkün mü?. Bu lispte seçtiğim yazının justification özelliklerini bottom-center veya top_center seçenekleri de olacak.

Bu da olmazsa sadece yazının justify özelliğini bottom-center veya top_center yapabileceğim bir lisp için yardımcı olacak üstatlara şimdiden teşekkürler....

id (28.05.2010 14:21 GMT)

28.05.2010 13:20    

beyto
lispe gerek yok yazının ismini oluşturacağın layer oluştur ondan sonra masprop (fırça ile) yeni oluşturduğun tabaka ile bi çizgi çiz sonra fırça ile çizgiyi seç sonra yazıları seç dediğin olay çözülmüş olacaktır

28.05.2010 14:45    

ProhibiT
Teşhis ve çözüm son derece isabetli. Ama, sürç-ü klavye olmuş sanırım :)
Massprop başka bir şey, kastedilen Match Properties olsa gerek...

ProhibiT (28.05.2010 16:40 GMT)

02.06.2010 10:04    

id
Ben yanlış ifade ettim o zaman.
Benim amacım bir çizgiye paralel olan yazıları hem oluşturacağım bir layre taşımak hem de bir defada aynı paralelde ve benim atayacağım bir mesafeye taşımaktır. Ama bunu teker teker seçerek yapacağıma toplu olarak yapmaktır. Konuyla ilgileneceklere şimdiden teşekkürler...

02.06.2010 23:09    

ProhibiT
Aslında AutoLisp yazmak için pek anlamlı bir konu değil.
İki ayrı fonksiyon yazdım. Birincisinde, işleme alacağınız text'leri mouse ile tek, tek seçiyoruz.
İkinci fonksiyonda, Window ile objeler gurubu seçiyoruz. Window ile seçerken seçime giren objelerden yalnızca text olanlar işleme alınır, diğerleri gözardı edilir.
Her iki fonksiyonun da ortak yönü:
Text objelerini taşıyacağımız Layer adı sorulur.
Açı ve Mesafe sorularak istediğiniz işlem gerçekleşir...
Kod:

(defun c:tlm1 ()
;;; Prepared by, M.S.G
  (setq oosm (getvar "osmode")) (setvar "osmode" 0)
  (setq Lyr (getstring "\n     Layer adı: ")
        aci (/ (* pi (getreal "\n  Açı (derece): ")) 180.0)
        msf (getreal "\nMesafe (birim): "))
  (while (setq yaz (car (entsel "\nText seçiniz... ")))
    (if (= "TEXT" (cdr (assoc 0 (entget yaz))))
      (progn
        (setq ayz (entget yaz) ayz (subst (cons 8 Lyr) (assoc 8 ayz) ayz)
              ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz)
        )
        (entmod ayz) (entupd (cdr (assoc -1 ayz))))))
  (setvar "osmode" oosm) (prin1)
)

(defun c:tlm2 ()
;;; Prepared by, M.S.G
  (setq oosm (getvar "osmode")) (setvar "osmode" 0)
  (setq Lyr (getstring "\n     Layer adı: ")
        aci (/ (* pi (getreal "\n  Açı (derece): ")) 180.0)
        msf (getreal "\nMesafe (birim): "))
  (princ "\nText objelerini seçiniz... ")
  (while (/= 3 (car (setq ll (grread T 4 0)))) (setq ll (cadr ll)))
  (setq ll (list (caadr ll) (cadadr ll)) x1 (car ll) y1 (cadr ll) pp1 nil)
  (while (/= 3 (car (setq ur (grread T 4 1))))
    (setq ur (list (caadr ur) (cadadr ur)) x2 (car ur) y2 (cadr ur))
    (if (/= ur ru) (progn
      (if pp1 (progn (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1)))
      (setq pp1 (list x1 y1) pp2 (list x2 y1) pp3 (list x2 y2) pp4 (list x1 y2))
      (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1))) (setq ru ur))
  (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1)
  (setq yzs (ssget "W" pp1 pp3 (list (cons 0 "TEXT"))) l (sslength yzs) m -1)
  (while (< (setq m (1+ m)) l)
    (setq yaz (ssname yzs m)
          ayz (entget yaz) ayz (subst (cons 8 Lyr) (assoc 8 ayz) ayz)
          ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz))
    (entmod ayz) (entupd (cdr (assoc -1 ayz))))
  (setvar "osmode" oosm) (prin1)
)


Kolay gelsin.

ProhibiT (02.06.2010 23:34 GMT)

03.06.2010 07:03    

id
Sayın prohibit yüzlerce yazıyı seçip taşımak gerçekten zaman alan bir iş. İlginize teşekkür ederim. Ancak sanırım bir sorun var.

Textler taşınamadı. Açıyı line objesini referans alarak mı vereceğiz. Acaba açıyı mı yanlış veriyorum. Teşekkürler...

03.06.2010 10:22    

halilozcakir
bence lispleri yanlış yükledin.
iki ayrı lisp var dikkatli yükle.

03.06.2010 13:29    

beyto
yahu bu autocad için lisp yazmak zor mudur acaba programcımı olmak lazım yoksa hiç bilmeyen biri öğrenirmi acaba, tabiki ilk olarak emeklemek lazım da zormudur öğrenmesi ?

03.06.2010 17:04    

ProhibiT
Merhaba id, Açı ve Mesafe değerlerini sayısal (real) olarak komut satırından girilecek şekilde yazmıştım.

Halilozcakir arkadaşımızın yazdığı gibi iki ayrı fonksiyon var. Ama iki fonksiyon tek bir dosya halinde yüklenebilir.

beyto arkadaşımızın sorusuna gelince, bu AutoLisp işleri aslında çok kolay :) Programcı olmak şart değil. Ama, gerekli (ne demekse :)) Değerli bir büyüğümüzün söylediğine göre Programcı olunmaz... doğulur! Şaka bir yana dehanın ancak %10 kadarının doğuştan geldiği, geri kalanın da çalışarak ele edildiği söylenir... ehya hocamın hazırladığı ve sitemizde mevcut AutoLisp kitabına bir göz atarak başlayabilirsiniz.

id arkadaşımızın problemini anladım. Fonksiyonları yazarken Text objelerinin daima Left Justified (default alignment) olduklarını varsaymışım. Bu durumda (assoc 10... ile işlem yapmak yeterli oluyor. Bunun dışında bir Text Hizalama seçeneği kullanılınca, (assoc 11... ile işlem yapmak gerekiyor. Programı bu şekilde değiştirdim.
Bir de mesafe ve açı değerlerini ekrandan sayısal olara okutmak yerine, Mouse ile iki nokta (base point ve second point) olarak girilecek şekilde değiştirdim.
Fonksiyonların son hallerini tekrar paylaşıyorum.

AutoLisp ile ilgilenen arkadaşlarımızın ilgisini çekebilecek 2 teknik kullandım.
1- (setq nk2 (getpoint (setq nk1 (getpoint "\nBirinci noktayı seçiniz")) "\rİkinci noktayı seçiniz")))
satırında içiçe 2 setq ve iki getpoint kullanımına dikatinizi çekmek isterim :)
2- Gene aynı satırdaki "\nBirinci noktayı seçiniz" ve "\rİkinci noktayı seçiniz"
bölümlerine dikkat ederseniz birincisinde \n (newline) kullanırken, diğerinde \r (carriage return) kullandım.
Aynı şekilde "\rText seçiniz... " yazarak, tekrarlanan mesajların ekranda yeni satırlarda değil, aynı satırda biribirinin yerine yazılarak ekranın kaymasını engelledim...

Kod:

;;;Prepared by, M.S.G.
(defun c:tlm1 ()
  (setq Lyr (getstring "\n     Layer adı: ")
        nk2 (getpoint (setq nk1 (getpoint "\nBirinci noktayı seçiniz")) "\rİkinci noktayı seçiniz")
        aci (angle nk1 nk2)
        msf (distance nk1 nk2)) (princ "\n ")
  (while (setq yaz (car (entsel "\rText seçiniz... ")))
    (if (= "TEXT" (cdr (assoc 0 (entget yaz))))
      (progn
        (setq ayz (entget yaz) ayz (subst (cons 8 Lyr) (assoc 8 ayz) ayz))
        (if (assoc 11 ayz)
          (setq ayz (subst (cons 11 (polar (cdr (assoc 11 ayz)) aci msf)) (assoc 11 ayz) ayz))
          (setq ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz)))
        (entmod ayz) (entupd (cdr (assoc -1 ayz))))))(prin1)
)

(defun c:tlm2 ()
  (setq Lyr (getstring "\n     Layer adı: ")
        nk2 (getpoint (setq nk1 (getpoint "\nBirinci noktayı seçiniz")) "\rİkinci noktayı seçiniz")
        aci (angle nk1 nk2)
        msf (distance nk1 nk2))
  (princ "\nText objelerini seçiniz (Window) ")
  (while (/= 3 (car (setq ll (grread T 4 0)))) (setq ll (cadr ll)))
  (setq ll (list (caadr ll) (cadadr ll)) x1 (car ll) y1 (cadr ll) pp1 nil)
  (while (/= 3 (car (setq ur (grread T 4 1))))
    (setq ur (list (caadr ur) (cadadr ur)) x2 (car ur) y2 (cadr ur))
    (if (/= ur ru) (progn
      (if pp1 (progn (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1)))
      (setq pp1 (list x1 y1) pp2 (list x2 y1) pp3 (list x2 y2) pp4 (list x1 y2))
      (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1))) (setq ru ur))
  (grdraw pp1 pp2 -1 1) (grdraw pp2 pp3 -1 1) (grdraw pp3 pp4 -1 1) (grdraw pp4 pp1 -1 1)
  (setq yzs (ssget "W" pp1 pp3 (list (cons 0 "TEXT"))) l (sslength yzs) m -1)
  (while (< (setq m (1+ m)) l)
    (setq yaz (ssname yzs m) ayz (entget yaz) ayz (subst (cons 8 Lyr) (assoc 8 ayz) ayz))
    (if (assoc 11 ayz)
      (setq ayz (subst (cons 11 (polar (cdr (assoc 11 ayz)) aci msf)) (assoc 11 ayz) ayz))
      (setq ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz)))
    (entmod ayz) (entupd (cdr (assoc -1 ayz)))) (prin1)
)


Herkese kolay gelsin...

Düzenleme:
İki fonksiyonun birleştirilmiş ve sadeleştirilmiş hali:
Kod:

;;;Prepared by, M.S.G.
(defun c:tLm ()
  (setq Lyr (getstring "\nLayer adı (Obje seçmek için Enter): "))
  (if (= Lyr nil) (setq Lyr (cdr (assoc 8 (entget (car (entsel)))))))
  (setq nk2 (getpoint (setq nk1 (getpoint "\nBirinci noktayı seçiniz")) "\rİkinci noktayı seçiniz")
        aci (angle nk1 nk2) msf (distance nk1 nk2)
        yzs (ssget (list (cons 0 "TEXT"))) l (sslength yzs) m -1)
  (while (< (setq m (1+ m)) l)
    (setq yaz (ssname yzs m) ayz (entget yaz) ayz (subst (cons 8 Lyr) (assoc 8 ayz) ayz))
    (if (assoc 11 ayz)
      (setq ayz (subst (cons 11 (polar (cdr (assoc 11 ayz)) aci msf)) (assoc 11 ayz) ayz)
            ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz))
      (setq ayz (subst (cons 10 (polar (cdr (assoc 10 ayz)) aci msf)) (assoc 10 ayz) ayz)))
    (entmod ayz) (entupd (cdr (assoc -1 ayz)))) (prin1)
)

ProhibiT (06.06.2010 18:17 GMT)

> 1 <
Copyright © 2004-2022 SQL: 1.336 saniye - Sorgu: 67 - Ortalama: 0.01993 saniye