15.01.2010 00:37    

ProhibiT
Merhaba arkadaşlar,
Bu Lisp, betonarme donatı açılımlarında kullanmak için yazılmıştı. Başka amaçlarla da kullanılabilir düşüncesiyle paylaşmak istedim.
[IMG]http://img189.imageshack.us/img189/3343/68403704.th.jpg[/IMG]
Ölçek ve ondalık basamak sayısı girilir, başlangıç noktası seçildikten sonra, her yeni nokta seçildiğinde ara mesafe yazılarak devam edilir... Son nokta seçildikten sonra enter (sağ tuş) girildiğinde, seçeceğiniz noktaya toplam mesafe yazılır. Bütün yazılar, paftanın sağ-alt köşesinden okunacak şekilde, toplam boy ise yatay olarak yazılırlar.
Kod:

(defun C:DB ()
  (setvar "cmdecho" 0)
  (command "undo" "group")
  (if (= lufo nil) (setq lufo 1))
  (if (= dpo nil) (setq dpo 2))
  (setq luf (getreal (strcat "\nCizilen/Yazılan orani <" (rtos lufo) "> :")))
  (if (= nil luf) (setq luf lufo))
  (setq dp (getreal (strcat "\nOndalik basamak sayisi <" (rtos dpo) "> :")))
  (if (= nil dp) (setq dp dpo))
  (setq dp (fix dp) l 0
        ds (* (getvar "dimscale") (getvar "dimgap"))
        tx (* (getvar "dimscale") (getvar "dimtxt"))
  )
  (princ "\nfrom point <")
  (if sn2 (princ sn2))
  (if (not (setq n1 (getpoint "> :"))) (setq n1 sn2))
  (setvar "lastpoint" n1)
  (while (setq n2 (getpoint "\n...to point "))
    (setq x1 (car n1) y1 (cadr n1) z1 (caddr n1)
          x2 (car n2) y2 (cadr n2) z2 (caddr n2)
          bn (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0))
          ac (angle n1 n2)
    )
    (while (> ac pi) (setq ac (- ac pi)))
    (if (= ac pi) (setq ac 0.0))
    (if (> ac (/ pi 2.0))
      (setq bn (polar bn (- ac (/ pi 2.0)) ds) ac (+ ac pi))
      (setq bn (polar bn (+ ac (/ pi 2.0)) ds))
    )
    (setq ms (rtos (* luf (distance n1 n2)) 2 dp) l (+ l (distance n1 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 bn) (cons 40 tx) (cons 1 ms)
                   (cons 50 ac) (cons 72 1) (cons 11 bn)))
    (setvar "lastpoint" n2)
    (setq sn2 n2 n1 n2)
  )
  (setq lp (getpoint "\nTotal Length insertion point : ") l (strcat "L=" (rtos (* l luf) 2 dp)))
  (if lp (entmake (list (cons 0 "TEXT") (cons 10 lp) (cons 40 tx) (cons 1 l)
                        (cons 50 0.0) (cons 72 1) (cons 11 lp))))
  (setq lufo luf dpo dp) (command "undo" "e") (prin1)
)

Selamlar, Sevgiler, Herkese Kolay Gelsin.

15.01.2010 08:41    

alirizasahin
Paylaşım için teşekkürler

21.09.2010 07:44    

alptoprak
teşekkürle

21.09.2010 08:46    

ProhibiT
Bu fonksiyon bir şekilde işinize yaradıysa,


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

linkine de bir göz atmanızı tavsiye ederim...

15.11.2010 08:59    

vicdan85
iyi günler kolay gelsin bizim gibi yeni başlayanlar için lispin nasıl kullanılacağını anlatırsanız seviniriz şimdiden sağolun

15.11.2010 09:07    

ProhibiT


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

linkinde açıklama var.
Konunun detayı da,

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

linkindeki makalede anlatılmıştır.
Kolay gelsin...

16.03.2011 11:06    

SchekiLL
Prohibit hocam şuna da bakın diye verdiğiniz link çalışmıyor.

bir de başlangıçta yazı boyutu sorsa daha iyi olmaz mı acaba? bu şekilde yeniden yapıştırmanız mümkün mü acaba kodu?

teşekkürler

16.03.2011 12:11    

ProhibiT
O zaman fonksiyonun bu haline bir bakın :)
Kod:

(defun C:DB ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (if (= Lufo nil) (setq Lufo 1))
  (if (not (setq Luf (getreal (strcat "\n  Yazılan/Çizilen oranı <" (rtos Lufo) "> :"))))
    (setq Luf Lufo) (setq Lufo Luf))
  (if (= dpo nil) (setq dpo 2))
  (if (not (setq dp (getint (strcat "\n    Ondalik basamak sayisi <" (itoa dpo) "> :"))))
    (setq dp dpo) (setq dpo dp))
  (if (= txo nil) (setq txo (* (getvar "dimscale") (getvar "dimtxt"))))
  (if (not (setq tx (getreal (strcat "\n      Yazı Yüksekliği <" (rtos txo) "> :"))))
    (setq tx txo) (setq txo tx))
  (setq ds (* (getvar "dimscale") (getvar "dimgap")) L 0)
  (princ "\nfrom point <") (if sn2 (princ sn2))
  (if (not (setq n1 (getpoint "> :"))) (setq n1 sn2))
  (setvar "lastpoint" n1)
  (while (setq n2 (getpoint n1 "\n...to point "))
    (setq x1 (car n1) y1 (cadr n1) z1 (caddr n1) x2 (car n2) y2 (cadr n2) z2 (caddr n2)
          bn (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0)) ac (angle n1 n2))
    (while (> ac pi) (setq ac (- ac pi)))
    (if (= ac pi) (setq ac 0.0))
    (if (> ac (/ pi 2.0))
      (setq bn (polar bn (- ac (/ pi 2.0)) ds) ac (+ ac pi))
      (setq bn (polar bn (+ ac (/ pi 2.0)) ds)))
    (setq ms (LeaTra (* luf (distance n1 n2))) l (+ l (distance n1 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 bn) (cons 40 tx) (cons 1 ms)
                   (cons 50 ac) (cons 72 1) (cons 11 bn)))
    (setvar "lastpoint" n2) (setq sn2 n2 n1 n2))
  (setq lp (getpoint "\nTotal Length insertion point : ") len (strcat "L=" (LeaTra (* l luf))))
  (if lp (entmake (list (cons 0 "TEXT") (cons 10 lp) (cons 40 tx) (cons 1 Len)
                        (cons 50 0.0) (cons 72 1) (cons 11 lp))))
  (setq lufo luf dpo dp) (command "undo" "e") (prin1)
)
(defun LeaTra (vL / uz sr frk yer)
  (setq vL (rtos vL 2 dpo) uz (strlen vL) sr 1)
  (while (and (< sr uz) (/= (substr vL sr 1) ".")) (setq sr (+ sr 1)))
  (setq yer (- uz sr) frk (- dpo yer))
  (if (and (= yer 0) (/= dpo 0)) (setq vL (strcat vL ".")))
  (while (> frk 0) (setq vL (strcat vL "0")) (setq frk (- frk 1)))
  (setq vL vL)
)

22.03.2011 07:30    

yunushanilce
Prohibit hocam emekleriniz bizim için çok değerli herşey iiçin teşekkürler
yolda en kesit çizerken 10-20 dakika süren işlerim bu lisple 1-2 dk ancak sürüyor herşey teşekkürler tüm uğraşlarınız için

01.04.2011 13:58    

volkaneren
Prohibit hocam bende komut çalışıyor fakat yazılarla ölçü vermeye çalıştığım çizgiler arasında 3000 m gibi bir fark oluşuyor. yani çizim bir yerde yazılar çizimin solunda biryerde çıkıyor. yardımcı olabilirmisiniz neden kaynaklanıyor acaba.

05.04.2011 22:15    

ProhibiT
Yurtdışı seyahatim nedeniyle epeydir sorularınıza cevap yazamadım...
DIMGAP sistem değişkeninizin değerini kontrol edin.
fonksiyon, yazıları olçülendirilen çizgilerden dimgap X dimscale kadar uzakta yazar...

kolay gelsin.

ProhibiT (07.04.2011 10:59 GMT)

06.04.2011 09:54    

volkaneren
Hocam bu ayarlar tam olarak nerdedir ve ne olması gerekir...

06.04.2011 10:44    

ProhibiT
Autocad komut satırından dimgap<┘ girerseniz ve gene komut satırından dimscale<┘ girerseniz o an geçerli değelerini görebilirsiniz. çizgiden çok uzağa yazıyorsa, sizin dimgap veya dimscale değişkenlerinizden birinin değerinin abartılı büyük olma ihtimali kuvvetli... mantık olarak çalışılan çizim dosyasında, tüm ayarları yapılmış, oturmuş bir dimension style nasılsa vardır düşüncesiyle, genel ölçülendirme mantığına uygun davranılması için bu değerleri kullandım.

kolay gelsin.

01.02.2016 19:38    

ulkersah
Alıntı
ProhibiT :
O zaman fonksiyonun bu haline bir bakın :)
Kod:

(defun C:DB ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (if (= Lufo nil) (setq Lufo 1))
  (if (not (setq Luf (getreal (strcat "\n  Yazılan/Çizilen oranı <" (rtos Lufo) "> :"))))
    (setq Luf Lufo) (setq Lufo Luf))
  (if (= dpo nil) (setq dpo 2))
  (if (not (setq dp (getint (strcat "\n    Ondalik basamak sayisi <" (itoa dpo) "> :"))))
    (setq dp dpo) (setq dpo dp))
  (if (= txo nil) (setq txo (* (getvar "dimscale") (getvar "dimtxt"))))
  (if (not (setq tx (getreal (strcat "\n      Yazı Yüksekliği <" (rtos txo) "> :"))))
    (setq tx txo) (setq txo tx))
  (setq ds (* (getvar "dimscale") (getvar "dimgap")) L 0)
  (princ "\nfrom point <") (if sn2 (princ sn2))
  (if (not (setq n1 (getpoint "> :"))) (setq n1 sn2))
  (setvar "lastpoint" n1)
  (while (setq n2 (getpoint n1 "\n...to point "))
    (setq x1 (car n1) y1 (cadr n1) z1 (caddr n1) x2 (car n2) y2 (cadr n2) z2 (caddr n2)
          bn (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0)) ac (angle n1 n2))
    (while (> ac pi) (setq ac (- ac pi)))
    (if (= ac pi) (setq ac 0.0))
    (if (> ac (/ pi 2.0))
      (setq bn (polar bn (- ac (/ pi 2.0)) ds) ac (+ ac pi))
      (setq bn (polar bn (+ ac (/ pi 2.0)) ds)))
    (setq ms (LeaTra (* luf (distance n1 n2))) l (+ l (distance n1 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 bn) (cons 40 tx) (cons 1 ms)
                   (cons 50 ac) (cons 72 1) (cons 11 bn)))
    (setvar "lastpoint" n2) (setq sn2 n2 n1 n2))
  (setq lp (getpoint "\nTotal Length insertion point : ") len (strcat "L=" (LeaTra (* l luf))))
  (if lp (entmake (list (cons 0 "TEXT") (cons 10 lp) (cons 40 tx) (cons 1 Len)
                        (cons 50 0.0) (cons 72 1) (cons 11 lp))))
  (setq lufo luf dpo dp) (command "undo" "e") (prin1)
)
(defun LeaTra (vL / uz sr frk yer)
  (setq vL (rtos vL 2 dpo) uz (strlen vL) sr 1)
  (while (and (< sr uz) (/= (substr vL sr 1) ".")) (setq sr (+ sr 1)))
  (setq yer (- uz sr) frk (- dpo yer))
  (if (and (= yer 0) (/= dpo 0)) (setq vL (strcat vL ".")))
  (while (> frk 0) (setq vL (strcat vL "0")) (setq frk (- frk 1)))
  (setq vL vL)
)


01.02.2016 19:51    

ulkersah
ProhibiT hocam lispinizi uzun zamandir kullaniyoruz çok teşekkür ederiz.
Çizdiğimiz "line" yada "pline" objelerinin ölçülerine tek tek yazdiriyoruz, ancak çizim üzerinde sadece değer yazıyor, değerden önce "L=" ve değerden sonra "m." yazdırmak mümkün müdür?

Diğer ve asıl öğrenmek istediğim şey; Autocad' de Dimension ile ölçülendirmede neden sadece x ve y koordinatları dikkate alınarak hesaplama yapılıyor? Örneğin x,y,z Koordinatına sahip 2 point objesi arası gerçek uzunluk z koordinatininda dikkate alınarak hesaplandigi değer degilmidir?

01.02.2016 20:26    

Travaci
ulkersah


Bunu
Kod:

(cons 1 ms)

Bununla değiştirin.
Kod:

(cons 1 (strcat "L=" ms " m."))


Sorunuzun cevabı; baktığınız düzleme göre ölçülendirme yapar.

06.02.2016 20:07    

ulkersah
Çok teşekkür ederim bilgi icin
hocam bu lispi "pl" yada "3p" için kullanmamız mümkün müdür?

ulkersah (03.05.2017 15:20 GMT)

28.12.2018 12:01    

mrtelkt
hocam merhabalar
öncelikle lisp leriniz için Allah razı olsun ,
bu lisp le ilgili iki değişiklik mümkün mü acaba;

1- her gelinen noktaya kadarki toplam mesafeleri her ölçülen mesafenin sonuna yazabilir mi;

2- bir sonraki mesafe için ilk noktayı da(son noktadan devam etmeden) (bir sonraki mesafenin ilk noktası yeni noktadan başlasın istenirse ölçüm esnasında girilecek bir tuşla olursa daha süper olur ) yeniden seçebilir miyiz.

yardımcı olursanız çok sevinirim

teşekkürler

mrtelkt (28.12.2018 12:13 GMT)

20.01.2020 12:02    

keremhazar
Alıntı
ProhibiT :
Merhaba arkadaşlar,
Bu Lisp, betonarme donatı açılımlarında kullanmak için yazılmıştı. Başka amaçlarla da kullanılabilir düşüncesiyle paylaşmak istedim.
[IMG]http://img189.imageshack.us/img189/3343/68403704.th.jpg[/IMG]
Ölçek ve ondalık basamak sayısı girilir, başlangıç noktası seçildikten sonra, her yeni nokta seçildiğinde ara mesafe yazılarak devam edilir... Son nokta seçildikten sonra enter (sağ tuş) girildiğinde, seçeceğiniz noktaya toplam mesafe yazılır. Bütün yazılar, paftanın sağ-alt köşesinden okunacak şekilde, toplam boy ise yatay olarak yazılırlar.
Kod:

(defun C:DB ()
  (setvar "cmdecho" 0)
  (command "undo" "group")
  (if (= lufo nil) (setq lufo 1))
  (if (= dpo nil) (setq dpo 2))
  (setq luf (getreal (strcat "\nCizilen/Yazılan orani <" (rtos lufo) "> :")))
  (if (= nil luf) (setq luf lufo))
  (setq dp (getreal (strcat "\nOndalik basamak sayisi <" (rtos dpo) "> :")))
  (if (= nil dp) (setq dp dpo))
  (setq dp (fix dp) l 0
        ds (* (getvar "dimscale") (getvar "dimgap"))
        tx (* (getvar "dimscale") (getvar "dimtxt"))
  )
  (princ "\nfrom point <")
  (if sn2 (princ sn2))
  (if (not (setq n1 (getpoint "> :"))) (setq n1 sn2))
  (setvar "lastpoint" n1)
  (while (setq n2 (getpoint "\n...to point "))
    (setq x1 (car n1) y1 (cadr n1) z1 (caddr n1)
          x2 (car n2) y2 (cadr n2) z2 (caddr n2)
          bn (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) (/ (+ z1 z2) 2.0))
          ac (angle n1 n2)
    )
    (while (> ac pi) (setq ac (- ac pi)))
    (if (= ac pi) (setq ac 0.0))
    (if (> ac (/ pi 2.0))
      (setq bn (polar bn (- ac (/ pi 2.0)) ds) ac (+ ac pi))
      (setq bn (polar bn (+ ac (/ pi 2.0)) ds))
    )
    (setq ms (rtos (* luf (distance n1 n2)) 2 dp) l (+ l (distance n1 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 bn) (cons 40 tx) (cons 1 ms)
                   (cons 50 ac) (cons 72 1) (cons 11 bn)))
    (setvar "lastpoint" n2)
    (setq sn2 n2 n1 n2)
  )
  (setq lp (getpoint "\nTotal Length insertion point : ") l (strcat "L=" (rtos (* l luf) 2 dp)))
  (if lp (entmake (list (cons 0 "TEXT") (cons 10 lp) (cons 40 tx) (cons 1 l)
                        (cons 50 0.0) (cons 72 1) (cons 11 lp))))
  (setq lufo luf dpo dp) (command "undo" "e") (prin1)
)

Selamlar, Sevgiler, Herkese Kolay Gelsin.




merhaba noktalar arasını seçtiğimizde mesafeyi vermesi harika benim bir de şuna ihtiyacım var diyelim peş peşe 10 tene nokta seçtim hepsini sıralı ve aralarında + olarak yazabilir mi çizimde ölçü verince çok karışık olduğu durumlarda bu şekilde yazmamız gerekiyor ölçü vermeden

misal 40+150+500+1540+85 gibi yapılabilir mi

20.01.2020 18:24    

ehya
Arkadaşlar, lisp konusunda bu olabilir mi? şu olabilir mi? gibi mesajlarınız oluyor.
Emin olabilirsiniz. Hepsi olabilir. Ama bu kadar seçeneği bir lisp yazarı her defasında tek tek düzenleyemez.
Sizler de işlerinizin yükünü azatmak için isteklerde bulunuyorsunuz ama, bu tür isteklerin sonu yok maalesef...

Copyright © 2004-2022 SQL: 2.539 saniye - Sorgu: 100 - Ortalama: 0.02539 saniye