* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
15.01.2010 03:37
54876    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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.

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

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

15.01.2010 11:41
54878    
alirizasahin

[8] Kıdemli Uzman

Online Durumu

118 ileti
Makina Mühendisi

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

21.09.2010 11:44
59574    
alptoprak

[2] Girişimci

Online Durumu

1 ileti
inşaat muh
konya

teşekkürle

21.09.2010 12:46
59577    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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

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

15.11.2010 11:59
60726    
vicdan85

[1] Yeni üye

Online Durumu

1 ileti
inşaat teknikeri
istanbul

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 12:07
60727    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara



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

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

16.03.2011 14:06
63374    
SchekiLL

[2] Girişimci

Online Durumu

1 ileti
Elk.Müh
istanbul

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 15:11
63377    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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

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

22.03.2011 10:30
63473    
yunushanilce

[1] Yeni üye

Online Durumu

12 ileti
öğrenci
ankara

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 17:58
63689    
volkaneren

[1] Yeni üye

Online Durumu

4 ileti
t.ressam
ankara

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.

06.04.2011 02:15
63738    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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 14:59 GMT)

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

06.04.2011 13:54
63741    
volkaneren

[1] Yeni üye

Online Durumu

4 ileti
t.ressam
ankara

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

06.04.2011 14:44
63744    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

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.

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

01.02.2016 22:38
82849    
ulkersah

[2] Girişimci

Online Durumu

17 ileti
inş. müh
kayseri

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 22:51
82850    
ulkersah

[2] Girişimci

Online Durumu

17 ileti
inş. müh
kayseri

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 23:26
82855    
Travaci

[70] Editör

Online Durumu

2151 ileti
Teknik Ressam
Konstantinopol

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 23:07
82924    
ulkersah

[2] Girişimci

Online Durumu

17 ileti
inş. müh
kayseri

Ç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 19:20 GMT)

28.12.2018 15:01
86940    
mrtelkt

[2] Girişimci

Online Durumu

1 ileti
elektrik
adana

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

> 1 <
Copyright © 2004-2019 | Tüm Hakları Saklıdır | 864 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam
SQL: 2.807 saniye - Sorgu: 130 - Ortalama: 0.02159 saniye