Reklam

* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
08.12.2009 12:41
53829    
mehmetyangın

[1] Yeni üye

Online Durumu

3 ileti
harita(topoğrafya)
giresun

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 13:17
53830    
macapapazi

[1] Yeni üye

Online Durumu

31 ileti
k.ressam
oran

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 23:53
53854    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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...

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

09.12.2009 01:29
53858    
oden

[3] Kıdemli Girişimci

Online Durumu

26 ileti
Mimar
Ankara

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 11:26
53862    
mehmetyangın

[1] Yeni üye

Online Durumu

3 ileti
harita(topoğrafya)
giresun

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 13:22
53863    
macapapazi

[1] Yeni üye

Online Durumu

31 ileti
k.ressam
oran

TEŞEKKÜRLER....

09.12.2009 14:04
53865    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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...

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

30.11.2010 12:38
60970    
odrcmn

[3] Kıdemli Girişimci

Online Durumu

27 ileti
topoğraf
bursa

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

Saygılarımla

02.12.2010 13:59
61022    
bud_0782

[10] Üstad

Online Durumu

320 ileti
Yapı Öğr.+Teknik Res.
Antalya

teşekkürler

~~~~~~~~~~~~~~~~~~~~~~~~
Düşün , hisset, uygula… İşte hepsi bu…
~~~~~~~~~~~~~~~~~~~~~~~~

16.07.2014 20:05
78125    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

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 16:40 GMT)

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

19.07.2014 02:00
78140    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

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


SaiL (19.07.2014 12:27 GMT)

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

30.08.2014 13:06
78479    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

unutuldu mu acaba bu konu..

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

20.03.2015 17:27
80981    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

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..

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

19.09.2015 11:53
81989    
moyari

[2] Girişimci

Online Durumu

5 ileti
Harita Müh
rize

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?

29.09.2015 01:02
82039    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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 15:29 GMT)

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

29.09.2015 14:51
82055    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

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

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

29.09.2015 15:30
82056    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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

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

29.09.2015 16:03
82058    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

elinize sağlık..

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

29.09.2015 16:08
82059    
SaiL

[5] Uzman

Online Durumu

71 ileti
topoğraf
adana

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

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

ESKİ DOST OLUR; ESKİ ARKADAŞ OLMAZ...

17.11.2016 11:54
84201    
macros55

[5] Uzman

Online Durumu

87 ileti
Haritaci
Ankara

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

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