08.12.2009 09:41    

mehmetyangın
arkadaşlar bi yardım edin lütfen.yol enkesitlerinde referans noktayı baz alarak enkesitte istenilen noktanın kot/mesafe degerlerini yazdıran bir lisp bulabilirmiyiz.teşekkürler..

08.12.2009 10:17    

macapapazi
lisp olmadan yapabilirsin bunu..ucs ayarlaması ile..referans noktanı "x=sıfır, y= (istegin deger)" olarak ayarla..."id" komutu ile istediğin degeri okuyup ekrana yazdırabilirsin...

saygılar

08.12.2009 20:53    

ProhibiT
Merhaba mehmetyangın :)

Gönderdiğin -.bmp dosyası ve verdiğin bilgiler doğrultusunda aşağıdaki lispi yazdım.
Belki başkalarının da işine yarar düşüncesiyle burada paylaşmak istiyorum.
Kod:

;;; Bu Program M.Ş. Güvercin tarafından
;;; Mehmet Yangın için Hazırlanmıştır. 
;;; 08.12.2009 22:10                   
(defun c:KoMe ()
  (command "undo" "group")
  (setvar "cmdecho" 0)
  (setq oosm  (getvar "osmode")
        ts    (getvar "textsize")
        eksen (car (entsel "\nEksen Çizgisini Seçiniz..."))
  )
  (while (/= "LINE" (cdr (assoc 0 (entget eksen))))
    (setq eksen (car (entsel "\nEksen Çizgisini Seçiniz...")))
  )
  (setq mesor (cadr (assoc 10 (entget eksen)))
        kotor (cadr (getpoint "\nReferans Kot Noktasını Seçiniz..."))
        refko (getreal "\nReferans Kot Değerini Giriniz: ")
        nokta (getpoint "\Yeni Nokta Seçiniz...")
  )
  (while nokta
    (setq nokx     (car nokta)
          noky     (cadr nokta)
          mesa     (rtos (abs (- mesor nokx)) 2 3)
          kot      (rtos (+ refko (- noky kotor)) 2 3)
          dogrultu (getpoint "\nYazıların yerini seçiniz...")
    )
    (if (= (atof kot) 0) (setq kot (strcat "%%p" kot)))
    (setq uz (strlen kot) sr 1)
    (while (and (< sr uz) (/= (substr kot sr 1) ".")) (setq sr (1+ sr)))
    (setq yer (- uz sr) frk (- 3 yer))
    (if (= yer 0) (setq kot (strcat kot ".")))
    (while (> frk 0) (setq kot (strcat kot "0") frk (1- frk)))
    (setq uz (strlen mesa) sr 1)
    (while (and (< sr uz) (/= (substr mesa sr 1) ".")) (setq sr (1+ sr)))
    (setq yer (- uz sr) frk (- 3 yer))
    (if (= yer 0) (setq mesa (strcat mesa ".")))
    (while (> frk 0) (setq mesa (strcat mesa "0") frk  (1- frk)))
    (if (> (cadr dogrultu) noky)
      (setq n1 (polar nokta (* pi 0.25) ts)
            n2 (polar nokta (* pi 0.75) ts)
            n3 (polar nokta (* pi 0.50) (* 1.00 ts))
            n4 (polar nokta (* pi 0.50) (* 2.50 ts))
      )
      (setq n1 (polar nokta (* pi 1.25) ts)
            n2 (polar nokta (* pi 1.75) ts)
            n3 (polar nokta (* pi 1.50) (* 2.00 ts))
            n4 (polar nokta (* pi 1.50) (* 2.50 ts))
      )
    )
    (setvar "osmode" 0)
    (command "pline" nokta n1 n2 "c")
    (command "change" "l" "" "p" "c" "1" "")
    (command "text" "c" n3 ts 0 kot)
    (if (> (cadr dogrultu) noky)
      (command "text" "ml" n4 ts 90 mesa)
      (command "text" "mr" n4 ts 90 mesa)
    )
    (command "change" "l" "" "p" "c" "1" "")
    (setvar "osmode" oosm)
    (setq nokta (getpoint "\Yeni Nokta Seçiniz..."))
  )
  (command "undo" "e")
  (prin1)
)


Selamlar, Sevgiler, Herkese Kolay Gelsin...

08.12.2009 22:29    

oden
Sayın ProhibiT, ara ara girdiğim bu platformda pek çok kişiye özverinizle yardımcı olduğunuzu gördüm. Üstte ve diğer başlıklarda yaptıklarınızı pek çok kişi aman bana ne anlayışı ile sallamaktadır.

Kendi adıma size ve sizin anlayışınızda olan arkadaşlara teşekkür ederim...

09.12.2009 08:26    

mehmetyangın
Sayın ProhibiT, platformda pek çok kişiye özverinizle yardımcı olduğunuzu gördüm. Gerçekten sizi tebrik ediyorum bu anlayış ve sağ duyunuzdan dolayı. bilği ve tecrübe paylaşınca güzeldir ama kıymetini bilene tabii.emeğinize sağlık..

Kendi adıma size ve sizin anlayışınızda olan arkadaşlara teşekkür ederim. M.Y.

09.12.2009 10:22    

macapapazi
TEŞEKKÜRLER....

09.12.2009 11:04    

ProhibiT
Güzel sözleriniz için teşekkür ederim arkadaşlar :)
Nazik iltifatlarınıza cevabım; imzamın sağ kısmında var zaten, "Beğenmek için anlamak lazım"
Anlaşılmak güzel, paylaşımların doğru yerini bulması da bir o kadar güzel.

Sizlerle çok keyifli bir sır paylaşmak isterim. Ne Müzikte, ne de Programcılıkta hiç hocam olmadı. Hasbelkader bildiğim herşeyi, birilerine birşeyler öğretmeye, anlatmaya çalışırken öğrendim. Demek ki, hiç hocam olmadı sözü aslında doğru değilmiş. Hepimiz biribirimizin öğretmeniyiz, hocasıyız :)

Selamlar, Sevgiler, Herkese Kolay Gelsin...

30.11.2010 09:38    

odrcmn
Cok güzel paylaşım için teşekkürler.

Saygılarımla

02.12.2010 10:59    

bud_0782
teşekkürler

16.07.2014 16:05    

SaiL
ProhibiT hocam;
bu lisp tam benim aradığım bir lisp..
sizden isteğim, benim için bunu biraz daha geliştirebilir misiniz..

netcad ortamında çizilmiş kesitleri bilirsiniz. ben bu kesitler üzerinde manuel oynama yapıyorum..

istediğim şu;
1-lisp bana yazı boyutunu sorsun..
2-değerleri alttaki banda yazsın..
3-eksenin solunda kalan eksene mesafelere - işareti koysun (-5.264 gibi)


örnek dosya:

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

SaiL (20.03.2015 13:40 GMT)

18.07.2014 22:00    

SaiL
bir önceki mesajıma yardım edebilecek arkadaş yok mu.. :(

SaiL (19.07.2014 08:27 GMT)

30.08.2014 09:06    

SaiL
unutuldu mu acaba bu konu.. :(

20.03.2015 14:27    

SaiL
Alıntı
SaiL :
bu lisp tam benim aradığım bir lisp..
sizden isteğim, benim için bunu biraz daha geliştirebilir misiniz..

netcad ortamında çizilmiş kesitleri bilirsiniz. ben bu kesitler üzerinde manuel oynama yapıyorum..

istediğim şu;
1-lisp bana yazı boyutunu sorsun..
2-değerleri alttaki banda yazsın..
3-eksenin solunda kalan eksene mesafelere - işareti koysun (-5.264 gibi)


örnek dosya:

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





güncel..

19.09.2015 07:53    

moyari
Alıntı
ProhibiT :
Merhaba mehmetyangın :)

Gönderdiğin -.bmp dosyası ve verdiğin bilgiler doğrultusunda aşağıdaki lispi yazdım.
Belki başkalarının da işine yarar düşüncesiyle burada paylaşmak istiyorum.
Kod:

;;; Bu Program M.Ş. Güvercin tarafından
;;; Mehmet Yangın için Hazırlanmıştır. 
;;; 08.12.2009 22:10                   
(defun c:KoMe ()
  (command "undo" "group")
  (setvar "cmdecho" 0)
  (setq oosm  (getvar "osmode")
        ts    (getvar "textsize")
        eksen (car (entsel "\nEksen Çizgisini Seçiniz..."))
  )
  (while (/= "LINE" (cdr (assoc 0 (entget eksen))))
    (setq eksen (car (entsel "\nEksen Çizgisini Seçiniz...")))
  )
  (setq mesor (cadr (assoc 10 (entget eksen)))
        kotor (cadr (getpoint "\nReferans Kot Noktasını Seçiniz..."))
        refko (getreal "\nReferans Kot Değerini Giriniz: ")
        nokta (getpoint "\Yeni Nokta Seçiniz...")
  )
  (while nokta
    (setq nokx     (car nokta)
          noky     (cadr nokta)
          mesa     (rtos (abs (- mesor nokx)) 2 3)
          kot      (rtos (+ refko (- noky kotor)) 2 3)
          dogrultu (getpoint "\nYazıların yerini seçiniz...")
    )
    (if (= (atof kot) 0) (setq kot (strcat "%%p" kot)))
    (setq uz (strlen kot) sr 1)
    (while (and (< sr uz) (/= (substr kot sr 1) ".")) (setq sr (1+ sr)))
    (setq yer (- uz sr) frk (- 3 yer))
    (if (= yer 0) (setq kot (strcat kot ".")))
    (while (> frk 0) (setq kot (strcat kot "0") frk (1- frk)))
    (setq uz (strlen mesa) sr 1)
    (while (and (< sr uz) (/= (substr mesa sr 1) ".")) (setq sr (1+ sr)))
    (setq yer (- uz sr) frk (- 3 yer))
    (if (= yer 0) (setq mesa (strcat mesa ".")))
    (while (> frk 0) (setq mesa (strcat mesa "0") frk  (1- frk)))
    (if (> (cadr dogrultu) noky)
      (setq n1 (polar nokta (* pi 0.25) ts)
            n2 (polar nokta (* pi 0.75) ts)
            n3 (polar nokta (* pi 0.50) (* 1.00 ts))
            n4 (polar nokta (* pi 0.50) (* 2.50 ts))
      )
      (setq n1 (polar nokta (* pi 1.25) ts)
            n2 (polar nokta (* pi 1.75) ts)
            n3 (polar nokta (* pi 1.50) (* 2.00 ts))
            n4 (polar nokta (* pi 1.50) (* 2.50 ts))
      )
    )
    (setvar "osmode" 0)
    (command "pline" nokta n1 n2 "c")
    (command "change" "l" "" "p" "c" "1" "")
    (command "text" "c" n3 ts 0 kot)
    (if (> (cadr dogrultu) noky)
      (command "text" "ml" n4 ts 90 mesa)
      (command "text" "mr" n4 ts 90 mesa)
    )
    (command "change" "l" "" "p" "c" "1" "")
    (setvar "osmode" oosm)
    (setq nokta (getpoint "\Yeni Nokta Seçiniz..."))
  )
  (command "undo" "e")
  (prin1)
)


Selamlar, Sevgiler, Herkese Kolay Gelsin...



Öncelikle emeğinize çok teşekkürler. Yazdığınız lisp te Ekrana yazılan yazının boyutunu ayarlama işini kendimize göre textsize komutuyla yarlayabiliyoruz. Fakat ne kadar değiştirsemde (rtos 2 3) ondalık sayı kısmını sürekli 3 hane yazıyor. Bu tarz lisplerde rtos komutundaki parantez içindeki ikinci değeri değiştirdiğimde ondalık kısmı değişiyordu. Sizin lispinizde değişme olmuyor. Neden acaba?

28.09.2015 21:02    

ProhibiT
Merhaba arkadaşlar.

Bundan 6 yıl önce burada paylaştığım Lisp program. O zamanın şartlarına göre, arkadaşlarımızın istekleri doğrultusunda yazılmıştı. Zaman içinde gelen isteklerin tümünü karşılayacak şekilde yeniden düzenleyip paylaşıyorum.
Kod:

;|---------------------------------------------------------------------------|
| Bu Program M.Ş. Güvercin tarafından                                       |
| Mehmet Yangın için Hazırlanmıştır. 08.12.2009 22:10                       |
| Bu konu başlığı altında gelen isteklere göre Düzenlendi...                |
|           ProhibiT www.cizimokulu.com 28.08.2015  14:15                   |
|---------------------------------------------------------------------------|;
(defun c:KoMe (/ dgrl eksen kot kotor msf mesor n1 n2 n3 n4 nokta nokx noky
               onbs otsz refko tsz)
  (defun tRL  (dgr ob / frk) (if (not (vl-string-search "." dgr))
      (setq dgr (strcat dgr ".") frk ob)
      (setq frk (- ob (- (strlen dgr) (1+ (vl-string-search "." dgr))))))
    (if (> frk 0) (repeat frk (setq dgr (strcat dgr "0"))) (setq dgr dgr)))
  (command "undo" "group") (setvar "cmdecho" 0)
  (if (not tsz) (setq tsz (getvar "textsize"))) (if (not (setq otsz tsz tsz
(getreal (strcat "\nYazı Yüksekliği <" (rtos tsz 2) ">: ")))) (setq tsz otsz))
  (if (not onbs) (setq onbs (getvar "Luprec")))
  (if (not (setq oonb onbs onbs (getint
(strcat "\nOndalik Basamak Sayısı <" (itoa onbs) ">: ")))) (setq onbs oonb))
  (while (/= "LINE" (cdr (assoc 0 (entget
                (setq eksen (car (entsel "\nEksen Çizgisini Seçiniz..."))))))))
  (setq mesor (cadr (assoc 10 (entget eksen)))
        kotor (cadr (getpoint "\nReferans Kot Noktasını Seçiniz..."))
        refko (getreal "\nReferans Kot Değerini Giriniz: "))
  (while (setq nokta (getpoint "\Yeni Nokta Seçiniz..."))
    (setq nokx (car nokta) noky (cadr nokta) msf (rtos (- nokx mesor) 2 onbs)
          kot  (rtos (+ refko (- noky kotor)) 2 onbs)
          dgrl (getpoint nokta "\nYazıların yerini seçiniz..."))
    (setq msf (tRL msf onbs) kot  (tRL kot onbs))
    (if (zerop (atof kot)) (setq kot (strcat "%%p" kot))
      (if (> (atof kot) 0) (setq kot (strcat "+" kot))))
      (if (> (atof msf) 0) (setq msf (strcat "+" msf)))
    (if (> (cadr dgrl) noky)
      (setq n1 (polar nokta (* pi 0.25) (* tsz 0.707106781))
            n2 (polar nokta (* pi 0.75) (* tsz 0.707106781))
            n3 (polar nokta (* pi 0.50) (* tsz 1.00))
            n4 (polar nokta (* pi 0.50) (* tsz 2.50)))
      (setq n1 (polar nokta (* pi 1.25) (* tsz 0.707106781))
            n2 (polar nokta (* pi 1.75) (* tsz 0.707106781))
            n3 (polar nokta (* pi 1.50) (* tsz 2.00))
            n4 (polar nokta (* pi 1.50) (* tsz 2.50))))
    (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0)
      '(100 . "AcDbPolyline") '(90 . 3) '(70 . 1) '(62 . 1) (cons 10 nokta)
       (cons 10 n1) (cons 10 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 n3) (cons 1 kot) (cons 40 tsz)
       (cons 72 1) (cons 73 0) (cons 50 0) (cons 73 0) (cons 11 n3)))
    (if (> (cadr dgrl) noky)
      (entmake (list (cons 0 "TEXT") (cons 10 n4) (cons 1 msf) (cons 40 tsz)
        (cons 62 1) (cons 50 (/ pi 2.0)) (cons 72 0) (cons 73 2) (cons 11 n4)))
      (entmake (list (cons 0 "TEXT") (cons 10 n4) (cons 1 msf) (cons 40 tsz)
      (cons 62 1) (cons 50 (/ pi 2.0)) (cons 72 2) (cons 73 2) (cons 11 n4)))))
  (command "undo" "e") (prin1))

Herkese kolay gelsin.

ProhibiT (29.09.2015 11:29 GMT)

29.09.2015 10:51    

SaiL
bu lispi yükleyemiyorum, galiba bi eksiklik var..
komut satırında şu uyarıyı veriyor. Command: ; error: malformed list on input

29.09.2015 11:30    

ProhibiT
Olası hatayı düzelttim, tekrar dener misiniz?

29.09.2015 12:03    

SaiL
elinize sağlık..

29.09.2015 12:08    

SaiL
eksene mesafe kotları aşağıdaki çizimdeki gibi bantlara yazdırmamız mümkün mü..

69261-espey-pompa-binasi-kesitler-son.dwg

17.11.2016 08:54    

macros55
Hocam kot mesafe lispinin sadece kot yazdıran hali varmı?

Copyright © 2004-2022 SQL: 1.787 saniye - Sorgu: 100 - Ortalama: 0.01787 saniye