Sonraki Sayfa| Yazar | İleti |
|
Sibay
konu,
457 ileti |
#669 21.09.2005 09:46 GMT |
B.T. Yukarıdaki metin bana özel mesaj olarak gönderilmiş, şu sıralar benim zaman problemim var. Elinde benzer fonksiyonlar içeren lisp olan bir arkadaşımız varsa veya zaman ayırıp bu lispi hazırlayabilecek biri, sitede yayınlar arkadaşımızın problemine çözüm bulmuş oluruz. iyi çalışmalar...
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#671 21.09.2005 16:02 GMT |
|
;;; İSTENİLENE GÖRE BİR LISP HAZIRLADIM. İSTEYEN KİŞİ BAKSIN, EĞER İSTEDİĞİ BİR DÜZELTME VARSA TEKRAR DÜZENLERİM...
(defun c:uy () (setq uy_os (getvar "osmode")) (setq uy_sec nil) (setq uy_sec (ssget (list (cons 0 "LINE")))) (if (= uy_sec nil) (progn (princ " Nesne seçimi yok. Komut bitirildi...")) (progn (if (= uy_yaz_yuk nil)(setq uy_yaz_yuk 12)) (initget 2) (setq uy_yaz_y (getdist (strcat " Yazılacak yazının Yüksekliği:<" (rtos uy_yaz_yuk) ">:"))) (if (= uy_yaz_y nil)(setq uy_yaz_y uy_yaz_yuk)) (setq uy_yaz_yuk uy_yaz_y) (setq uy_c 0) (setq uy_say (sslength uy_sec)) (while (< uy_c uy_say) (setq uy_sec_tek (ssname uy_sec uy_c)) (setq uy_sec_tek_10 (cdr (assoc 10 (entget uy_sec_tek))) uy_sec_tek_11 (cdr (assoc 11 (entget uy_sec_tek)))) (setq uy_sec_tek_mes (distance uy_sec_tek_10 uy_sec_tek_11)) (setq uy_sec_tek_10_x (car uy_sec_tek_10) uy_sec_tek_10_y (cadr uy_sec_tek_10) uy_sec_tek_11_x (car uy_sec_tek_11) uy_sec_tek_11_y (cadr uy_sec_tek_11)) (setq uy_yaz_x (/ (+ uy_sec_tek_10_x uy_sec_tek_11_x) 2.00) uy_yaz_y (/ (+ uy_sec_tek_10_y uy_sec_tek_11_y) 2.00) uy_yaz (list uy_yaz_x uy_yaz_y)) (if (< uy_sec_tek_10_x uy_sec_tek_11_x) (progn (setq uy_sec_aci_bas uy_sec_tek_10) (setq uy_sec_aci_son uy_sec_tek_11) ) (progn (setq uy_sec_aci_bas uy_sec_tek_11) (setq uy_sec_aci_son uy_sec_tek_10))) (setq uy_sec_tek_aci (angle uy_sec_aci_bas uy_sec_aci_son)) (command "style" "cizgiyazi" "" "" "" "" "" "" "") (command "osnap" "node") (command "text" "j" "bc" uy_yaz uy_yaz_yuk (angtos uy_sec_tek_aci) (rtos uy_sec_tek_mes)) (setq uy_c (+ uy_c 1)) )))(setvar "osmode" uy_os)(princ)) (princ " Komutu çalıştırmak için [UY] yazın")(princ)
|
|
|
Sibay
konu,
457 ileti |
#673 21.09.2005 17:27 GMT |
|
Eline sağlık, gerçekten çok iyi bir çalışma yapmışsın.
Bu lisp download bölümüne de eklenmiştir. "uy.lsp olarak"
|
|
|
den_yeliz [2] Acemi
konu,
1 ileti |
#697 26.09.2005 11:02 GMT |
|
Herkese selamlar.Ben makine resim öğr. okuyorum ve autolisple ilgili bir tezim var.Tezim herhangi çizilmiş bir resmi kare(dikdörtgen, yamukta olabilir) yada üçgen şekillerini kullanarak bölecek.Yalnız bölme işleminde ana resmin köşelerine böldüğümüz kare şekiller denk gelecek.Bana en azından olabilir olamaz diye fikir beyan edebilirseniz sevinirim.
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#698 26.09.2005 11:28 GMT |
|
Olmaz diye birşey yok. Lisp diğer dillere göre çok gelişmiş olmasa da, bu tür basit komutları rahatlıkla çözebilir. Yeter ki, yazan kişi fonksiyonları doğru analiz etsin.
|
|
|
MSucullu
konu,
7 ileti |
#699 26.09.2005 11:38 GMT |
|
Bu lispler düzenlenerek download bölümüne download > Lispler > Kanalizasyon lispleri olarak eklenmiştir.
[admin] selam ben Denizli den Mustafa. İnternetle uğraşacak fazla vaktim olmuyor. İnşaat mühendisiyim ve kanalizasyon işleri ile uğraşan bir inşaat firmasında çalışıyorum. Kendi işlerimde kullandığım bir kaç lisp kodum var, isteyen kendine göre düzenlesin fakat bu kodları ayrı ayrı lisp (lsp uzantılı) dosyalarına kaydetmenizi tavsiye ederim, çünkü karışabilir. (Yüklemeyi tools....load application....(lsp dosyası)tıklayarak yapıyorum) Command satırına "defun c:" den sonra gelen komutu yazıp (örneğin aşağıdaki ilk kodun komutu " 1 ") gerisini takip et. Elinde başka lisp kodları olan varsa gönderebilirse sevinirim. Yeni öğreniyorum kendimi geliştirmem lazım. ilgilenenlere ve site sahibine Teşekkür ederim........ Kod: (DEFUN C:1 ( )
;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq bd 4.5) ;büyük daire yarıçapı. (setq kyy 1.7) ;Kot yazısı yüksekliği. (setq any 2) ;Arazi no yazısı yüksekliği. (setq bny 3) ;Baca no yazısı yüksekliği. (setq kyym 0.01) ;Baca merkezi yazı yüksekliği. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "osmode" 0) (setq arazino (getdist " arazi no: ")) (setq an0 (fix arazino)) (setq an1 (fix (/ an0 100))) (setq an2 (fix (- (/ an0 10) (* 10 an1)))) (setq an3 (fix (- (/ an0 1) (+ (* 10 an2) (* 100 an1))))) (setq an1 (itoa an1)) (setq an2 (itoa an2)) (setq an3 (itoa an3)) (setq an (strcat "an" an1 an2 an3)) (setq zeminkot (getdist " Zemin kotu:")) (setq zk0 (fix (* zeminkot 100))) (setq zk1 (fix (/ zk0 10000))) (setq zk2 (fix (- (/ zk0 1000) (* 10 zk1)))) (setq zk3 (- (/ zk0 100) (* (fix (/ zk0 1000)) 10))) (setq zk4 (- (/ zk0 10) (* (fix (/ zk0 100)) 10))) (setq zk5 (- (/ zk0 1) (* (fix (/ zk0 10)) 10))) (setq zk1 (itoa zk1)) (setq zk2 (itoa zk2)) (setq zk3 (itoa zk3)) (setq zk4 (itoa zk4)) (setq zk5 (itoa zk5)) (setq zk (strcat zk1 zk2 zk3 "." zk4 zk5)) (setq B1 (getpoint " Baca yeri: ")) (setq B2 (getpoint " No yeri: ")) (setq rad1 kd) (setq rad2 bd) (command "layer" "m" "BACA" "c" "White" "" "") (command "circle" B1 rad1) (command "layer" "m" "DAIRE" "c" "White" "" "") (command "circle" B2 rad2) (command "layer" "m" "0" "c" "White" "" "") (setq xB2 (car B2)) (setq yB2 (cadr B2)) (setq ç1 (list (- xB2 4.1) yB2 0)) (setq ç2 (list (+ xB2 4.1) yB2 0)) (command "layer" "m" "0" "c" "White" "" "") (setq xaltyazı xB2) (setq yaltyazı (- yB2 0)) (setq altyazı (list xaltyazı yaltyazı)) (setq anyazısı (if (< arazino 10) an3 (if (< arazino 100) (strcat an2 an3) (strcat an1 an2 an3)))) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "ARAZINO" "c" "cyan" "" "") (command "text" "j" "Mc" altyazı any "0" anyazısı) (command "layer" "m" "0" "c" "White" "" "") (setq xkotyazısı (+ xB2 0)) (setq ykotyazısı (+ yB2 8.12)) (setq kotyazısı (list xkotyazısı ykotyazısı)) (setq zkyazısı (if (< zeminkot 10) (strcat zk3 "." zk4 zk5) (if (< zeminkot 100) (strcat zk2 zk3 "." zk4 zk5) (strcat zk1 zk2 zk3 "." zk4 zk5) ))) (command "_style" "KOT" "Arial" kyy "0.8" "0" "NO" "NO" "N") (command "layer" "m" "KOT" "c" "White" "" "") (command "text" "j" "mc" kotyazısı "0" zkyazısı "") (command "_style" "KOT" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "KOT" "c" "white" "" "") (command "text" "j" "mc" B1 "0" zkyazısı) (command "layer" "m" "0" "c" "White" "" "") (command "_style" "NO" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "S" "c" "white" "" "") (command "text" "j" "mc" B1 "0" "s") (command "layer" "m" "0" "c" "White" "" "") (command "_style" "0" "Arial" "0" "0.8" "0" "NO" "NO") (setvar "Orthomode" 0) ) (DEFUN C:2 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq bd 4.5) ;büyük daire yarıçapı. (setq kyy 1.7) ;Kot yazısı yüksekliği. (setq any 2) ;Arazi no yazısı yüksekliği. (setq bny 3) ;Baca no yazısı yüksekliği. (setq kyym 0.01) ;Baca merkezi yazı yüksekliği. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "osmode" 0) (setq an 0) (setq zeminkot (getdist " Zemin kotu:")) (setq zk0 (fix (* zeminkot 100))) (setq zk1 (fix (/ zk0 10000))) (setq zk2 (fix (- (/ zk0 1000) (* 10 zk1)))) (setq zk3 (- (/ zk0 100) (* (fix (/ zk0 1000)) 10))) (setq zk4 (- (/ zk0 10) (* (fix (/ zk0 100)) 10))) (setq zk5 (- (/ zk0 1) (* (fix (/ zk0 10)) 10))) (setq zk1 (itoa zk1)) (setq zk2 (itoa zk2)) (setq zk3 (itoa zk3)) (setq zk4 (itoa zk4)) (setq zk5 (itoa zk5)) (setq zk (strcat zk1 zk2 zk3 "." zk4 zk5)) (setq B1 (getpoint " Baca yeri: ")) (setq B2 (getpoint " No yeri: ")) (setq rad1 kd) (setq rad2 bd) (command "layer" "m" "BACA" "c" "White" "" "") (command "circle" B1 rad1) (command "layer" "m" "DAIRE" "c" "White" "" "") (command "circle" B2 rad2) (command "layer" "m" "0" "c" "White" "" "") (setq xB2 (car B2)) (setq yB2 (cadr B2)) (setq xaltyazı xB2) (setq yaltyazı (- yB2 1.82)) (setq altyazı (list xaltyazı yaltyazı)) (setq xkotyazısı (+ xB2 0)) (setq ykotyazısı (+ yB2 8.12)) (setq kotyazısı (list xkotyazısı ykotyazısı)) (setq zkyazısı (if (< zeminkot 10) (strcat zk3 "." zk4 zk5) (if (< zeminkot 100) (strcat zk2 zk3 "." zk4 zk5) (strcat zk1 zk2 zk3 "." zk4 zk5) ))) (command "_style" "KOT" "Arial" kyy "0.8" "0" "NO" "NO" "N") (command "layer" "m" "KOT" "c" "White" "" "") (command "text" "j" "mc" kotyazısı "0" zkyazısı "") (command "_style" "KOT" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "KOT" "c" "white" "" "") (command "text" "j" "mc" B1 "0" zkyazısı) (command "layer" "m" "0" "c" "White" "" "") (command "_style" "NO" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "S" "c" "white" "" "") (command "text" "j" "mc" B1 "0" "s") (command "layer" "m" "0" "c" "White" "" "") (command "_style" "0" "Arial" "0" "0.8" "0" "NO" "NO") (setvar "Orthomode" 0) ) (DEFUN C:3 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq bd 4.5) ;büyük daire yarıçapı. (setq kyy 1.7) ;Kot yazısı yüksekliği. (setq any 2) ;Arazi no yazısı yüksekliği. (setq bny 3) ;Baca no yazısı yüksekliği. (setq kyym 0.01) ;Baca merkezi yazı yüksekliği. (setq dL 7) ;araya atılacak baca nolarının eksenden uzağa atılacak mesafesi. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "osmode" 4) (setq L1 (getpoint "1. bacaya tıklayınız")) (setvar "osmode" 0) (prompt "1. bacanın kot yazısına tıklayınız") (setq a (entsel)) (setq b (entget (car a))) (setq kotyazı1 (cdr (assoc 1 b))) (setq kotyazı1 (atof kotyazı1)) (setvar "osmode" 4) (setq L2 (getpoint "2. bacaya tıklayınız")) (setvar "osmode" 0) (prompt "2. bacanın kot yazısına tıklayınız") (setq d (entsel)) (setq e (entget (car d))) (setq kotyazı2 (cdr (assoc 1 e))) (setq kotyazı2 (atof kotyazı2)) (setq uzu (distance L1 L2)) (if (< uzu 61) (alert "Mesafe 60 m. den küçük") "") (setq arasayısı (if (> (rem uzu 60) 1) (+ 1 (fix (/ uzu 60))) (/ uzu 60))) (setq arakotfarkı (/ (- kotyazı2 kotyazı1) arasayısı)) (setq L1x (car L1)) (setq L1y (cadr L1)) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (if (> L1x L2x) (setq arauzaklıklar (/ uzu arasayısı )) (* (- 0 1) (setq arauzaklıklar (/ uzu arasayısı )))) (if (< uzu 61) (setq arauzaklıklar (/ uzu 2)) "") (if (< uzu 61) (setq arasayısı 2) "") (setq arakotfarkı (/ (- kotyazı2 kotyazı1) arasayısı)) (setq sayı 0) (While (< sayı (- arasayısı 1)) (setq sayı (+ sayı 1)) (setvar "osmode" 0) (setq an 0) (setq zeminkot (+ kotyazı1 (* sayı arakotfarkı))) (setq zk0 (fix (* zeminkot 100))) (setq zk1 (fix (/ zk0 10000))) (setq zk2 (fix (- (/ zk0 1000) (* 10 zk1)))) (setq zk3 (- (/ zk0 100) (* (fix (/ zk0 1000)) 10))) (setq zk4 (- (/ zk0 10) (* (fix (/ zk0 100)) 10))) (setq zk5 (- (/ zk0 1) (* (fix (/ zk0 10)) 10))) (setq zk1 (itoa zk1)) (setq zk2 (itoa zk2)) (setq zk3 (itoa zk3)) (setq zk4 (itoa zk4)) (setq zk5 (itoa zk5)) (setq zk (strcat zk1 zk2 zk3 "." zk4 zk5)) ;B1 bulunuşu.;;;;;;;;;;; ;g değeri L1 den olan mesafe. ;h değeri çizgiye dik olan mesafe. (setq g (* sayı arauzaklıklar)) (setq h 0) (setq beta (Atan (/ h g))) (setq g2g (expt g 2)) (setq h2h (expt h 2)) (setq x (sqrt (+ g2g h2h))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq B1x (+ L1x deltax)) (setq B1y (+ L1y deltay)) (setq B1 (list B1x B1y 0)) ;B2 bulunuşu.;;;;;;;;;;; ;g değeri L1 den olan mesafe. ;h değeri çizgiye dik olan mesafe. (setq g (* sayı arauzaklıklar)) (if (< L2x L1x) (setq h dL) (setq h (- 0 dL))) (setq beta (Atan (/ h g))) (setq g2g (expt g 2)) (setq h2h (expt h 2)) (setq x (sqrt (+ g2g h2h))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq B2x (+ L1x deltax)) (setq B2y (+ L1y deltay)) (setq B2 (list B2x B2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq rad1 kd) (setq rad2 bd) (command "layer" "m" "BACA" "c" "White" "" "") (command "circle" B1 rad1) (command "layer" "m" "DAIRE" "c" "White" "" "") (command "circle" B2 rad2) (command "layer" "m" "0" "c" "White" "" "") (setq xB2 (car B2)) (setq yB2 (cadr B2)) (setq xaltyazı xB2) (setq yaltyazı (- yB2 1.82)) (setq altyazı (list xaltyazı yaltyazı)) (setq xkotyazısı (+ xB2 0)) (setq ykotyazısı (+ yB2 8.12)) (setq kotyazısı (list xkotyazısı ykotyazısı)) (setq zkyazısı (if (< zeminkot 10) (strcat zk3 "." zk4 zk5) (if (< zeminkot 100) (strcat zk2 zk3 "." zk4 zk5) (strcat zk1 zk2 zk3 "." zk4 zk5) ))) (command "_style" "KOT" "Arial" kyy "0.8" "0" "NO" "NO" "N") (command "layer" "m" "KOT" "c" "White" "" "") (command "text" "j" "mc" kotyazısı "0" zkyazısı "") (command "_style" "KOT" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "KOT" "c" "white" "" "") (command "text" "j" "mc" B1 "0" zkyazısı) (command "layer" "m" "0" "c" "White" "" "") (command "_style" "NO" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "S" "c" "white" "" "") (command "text" "j" "mc" B1 "0" "s") (command "layer" "m" "0" "c" "White" "" "") (command "_style" "0" "Arial" "0" "0.8" "0" "NO" "NO") (setvar "Orthomode" 0) ) ) (DEFUN C:4 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq bd 4.5) ;büyük daire yarıçapı. (setq kyy 1.7) ;Kot yazısı yüksekliği. (setq any 2) ;Arazi no yazısı yüksekliği. (setq bny 3) ;Baca no yazısı yüksekliği. (setq kyym 0.01) ;Baca merkezi yazı yüksekliği. (setq dL 7) ;araya atılacak baca nolarının eksenden uzağa atılacak mesafesi. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "osmode" 4) (setq L1 (getpoint "1. bacaya tıklayınız")) (setvar "osmode" 0) (prompt "1. bacanın kot yazısına tıklayınız") (setq a (entsel)) (setq b (entget (car a))) (setq kotyazı1 (cdr (assoc 1 b))) (setq kotyazı1 (atof kotyazı1)) (setvar "osmode" 4) (setq L2 (getpoint "2. bacaya tıklayınız")) (setvar "osmode" 0) (prompt "2. bacanın kot yazısına tıklayınız") (setq d (entsel)) (setq e (entget (car d))) (setq kotyazı2 (cdr (assoc 1 e))) (setq kotyazı2 (atof kotyazı2)) (setq uzu (distance L1 L2)) (setq ilerinoktap (getpoint " 3. noktayı tıklayınız.")) (setq ileri (distance ilerinoktap L1)) (setq düşeyeğim (/ (- kotyazı2 kotyazı1) uzu)) (setq kotfarkı (* ileri düşeyeğim)) (setq kotyazı3 (+ (* ileri düşeyeğim) kotyazı1)) (setvar "osmode" 0) (setq zeminkot kotyazı3) (setq zk0 (fix (* zeminkot 100))) (setq zk1 (fix (/ zk0 10000))) (setq zk2 (fix (- (/ zk0 1000) (* 10 zk1)))) (setq zk3 (- (/ zk0 100) (* (fix (/ zk0 1000)) 10))) (setq zk4 (- (/ zk0 10) (* (fix (/ zk0 100)) 10))) (setq zk5 (- (/ zk0 1) (* (fix (/ zk0 10)) 10))) (setq zk1 (itoa zk1)) (setq zk2 (itoa zk2)) (setq zk3 (itoa zk3)) (setq zk4 (itoa zk4)) (setq zk5 (itoa zk5)) (setq zk (strcat zk1 zk2 zk3 "." zk4 zk5)) (setq B1 ilerinoktap) (setq B2 (getpoint " No yerini tıklayınız: ")) (setq rad1 kd) (setq rad2 bd) (command "layer" "m" "BACA" "c" "White" "" "") (command "circle" B1 rad1) (command "layer" "m" "DAIRE" "c" "White" "" "") (command "circle" B2 rad2) (command "layer" "m" "0" "c" "White" "" "") (setq xB2 (car B2)) (setq yB2 (cadr B2)) (setq xaltyazı xB2) (setq yaltyazı (- yB2 1.82)) (setq altyazı (list xaltyazı yaltyazı)) (setq xkotyazısı (+ xB2 0)) (setq ykotyazısı (+ yB2 8.12)) (setq kotyazısı (list xkotyazısı ykotyazısı)) (setq zkyazısı (if (< zeminkot 10) (strcat zk3 "." zk4 zk5) (if (< zeminkot 100) (strcat zk2 zk3 "." zk4 zk5) (strcat zk1 zk2 zk3 "." zk4 zk5) ))) (command "_style" "KOT" "Arial" kyy "0.8" "0" "NO" "NO" "N") (command "layer" "m" "KOT" "c" "White" "" "") (command "text" "j" "mc" kotyazısı "0" zkyazısı "") (command "_style" "KOT" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "KOT" "c" "white" "" "") (command "text" "j" "mc" B1 "0" zkyazısı) (command "layer" "m" "0" "c" "White" "" "") (command "_style" "NO" "Arial" kyym "0.8" "0" "NO" "NO") (command "layer" "m" "S" "c" "white" "" "") (command "text" "j" "mc" B1 "0" "s") (command "layer" "m" "0" "c" "White" "" "") (command "_style" "0" "Arial" "0" "0.8" "0" "NO" "NO") (setvar "Orthomode" 0) ) command "units" "2" "1" "4" "0" "0" "n" (command "units" "2" "4" "4" "0" "0" "n") (DEFUN C:bk1 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. (setq kdb 2.25) ;başlangıç çizisi başlangıç uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "0" "c" "White" "" "") (setq L1 (getpoint "Başlangıç bacasını seçiniz")) (command "layer" "m" "1" "c" "red" "" "") (setq L1x (car L1)) (setq L1y (cadr L1)) (command "") (setq L2 (getpoint "Bitiş bacasını seçiniz")) (setq uzu (distance L1 L2)) (setq arasayısı (fix (/ uzu 60))) (setq arauzaklık (/ uzu (+ arasayısı 1))) (setq dikkat (strcat "uzunluk " (itoa (fix uzu)) " m. olduğu için araya " (itoa arasayısı) " adet daha baca yerleştirmelisiniz. (ara uzaklıklar " (itoa (fix arauzaklık)) " m olabilir.)")) (if (> uzu 62) (alert dikkat) "") (setq kademe 1) (setvar "osmode" 0) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (setq kdb 2.25) ;başlangıç çizisi başlangıç uzaklığı. (setq L3 (list (+ L1x (* kdb (cos teta))) (+ L1y (* kdb (sin teta))) 0)) (command "line" L3 L2 "") (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (/ uzu 2)) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix uzu)) 0.5) uzu (fix (+ 1 uzu)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;Pline noktaları;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (< kademe 2) (command "_linetype" "s" "continuous" "") (command "_linetype" "s" "dashed" "")) (command "line" L3 nokta1 "") (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") ;;;;;;;;;;;;;;;Başlangıç 1 noktasıi;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;nokta baş1; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a 2.25) (setq b 1.25) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq noktabaş1x (+ L1x deltax)) (setq noktabaş1y (+ L1y deltay)) (setq noktabaş1 (list noktabaş1x noktabaş1y 0)) ;;;;;;;;;;;;;;;Başlangıç 2 noktası;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;nokta baş1; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a 2.25) (setq b (- 0 1.25)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq noktabaş2x (+ L1x deltax)) (setq noktabaş2y (+ L1y deltay)) (setq noktabaş2 (list noktabaş2x noktabaş2y 0)) (command "line" noktabaş1 noktabaş2 "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) command "units" "2" "1" "4" "0" "0" "n" (command "units" "2" "4" "4" "0" "0" "n") (DEFUN C:bk2 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "0" "c" "White" "" "") (setq L1 (getpoint "Başlangıç bacasını seçiniz")) (command "layer" "m" "1" "c" "red" "" "") (setq L1x (car L1)) (setq L1y (cadr L1)) (command "") (setq L2 (getpoint "Bitiş bacasını seçiniz")) (setq uzu (distance L1 L2)) (setq arasayısı (fix (/ uzu 60))) (setq arauzaklık (/ uzu (+ arasayısı 1))) (setq dikkat (strcat "uzunluk " (itoa (fix uzu)) " m. olduğu için araya " (itoa arasayısı) " adet daha baca yerleştirmelisiniz. (ara uzaklıklar " (itoa (fix arauzaklık)) " m olabilir.)")) (if (> uzu 62) (alert dikkat) "") (setq kademe 2) (setvar "osmode" 0) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (setq kdb 2.25) ;başlangıç çizisi başlangıç uzaklığı. (setq L3 (list (+ L1x (* kdb (cos teta))) (+ L1y (* kdb (sin teta))) 0)) (command "line" L3 L2 "") (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (/ uzu 2)) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix uzu)) 0.5) uzu (fix (+ 1 uzu)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;Pline noktaları;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (< kademe 2) (command "_linetype" "s" "continuous" "") (command "_linetype" "s" "dashed" "")) (command "line" L3 nokta1 "") (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") ;;;;;;;;;;;;;;;Başlangıç 1 noktasıi;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;nokta baş1; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a 2.25) (setq b 1.25) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq noktabaş1x (+ L1x deltax)) (setq noktabaş1y (+ L1y deltay)) (setq noktabaş1 (list noktabaş1x noktabaş1y 0)) ;;;;;;;;;;;;;;;Başlangıç 2 noktası;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;nokta baş1; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a 2.25) (setq b (- 0 1.25)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq noktabaş2x (+ L1x deltax)) (setq noktabaş2y (+ L1y deltay)) (setq noktabaş2 (list noktabaş2x noktabaş2y 0)) (command "line" noktabaş1 noktabaş2 "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) command "units" "2" "1" "4" "0" "0" "n" (command "units" "2" "4" "4" "0" "0" "n") (DEFUN C:k1 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "0" "c" "White" "" "") (setq L1 (getpoint "Başlangıç bacasını seçiniz")) (command "layer" "m" "1" "c" "red" "" "") (setq L1x (car L1)) (setq L1y (cadr L1)) (command "") (setq L2 (getpoint "Bitiş bacasını seçiniz")) (setq uzu (distance L1 L2)) (setq arasayısı (fix (/ uzu 60))) (setq arauzaklık (/ uzu (+ arasayısı 1))) (setq dikkat (strcat "uzunluk " (itoa (fix uzu)) " m. olduğu için araya " (itoa arasayısı) " adet daha baca yerleştirmelisiniz. (ara uzaklıklar " (itoa (fix arauzaklık)) " m olabilir.)")) (if (> uzu 62) (alert dikkat) "") (setq kademe 1) (setvar "osmode" 0) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (command "line" L1 L2 "") (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (/ uzu 2)) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix uzu)) 0.5) uzu (fix (+ 1 uzu)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;Pline noktaları;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (< kademe 2) (command "_linetype" "s" "continuous" "") (command "_linetype" "s" "dashed" "")) (setq L3 (list (+ L1x (* kd (cos teta))) (+ L1y (* kd (sin teta))) 0)) (command "line" L3 nokta1 "") (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) command "units" "2" "1" "4" "0" "0" "n" (command "units" "2" "4" "4" "0" "0" "n") (DEFUN C:k2 ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_linetype" "s" "continuous" "") (setq L1 (getpoint "Başlangıç bacasını seçiniz")) (setq L1x (car L1)) (setq L1y (cadr L1)) (command "") (setq L2 (getpoint "Bitiş bacasını seçiniz")) (setq uzu (distance L1 L2)) (setq arasayısı (fix (/ uzu 60))) (setq arauzaklık (/ uzu (+ arasayısı 1))) (setq dikkat (strcat "uzunluk " (itoa (fix uzu)) " m. olduğu için araya " (itoa arasayısı) " adet daha baca yerleştirmelisiniz. (ara uzaklıklar " (itoa (fix arauzaklık)) " m olabilir.)")) (if (> uzu 62) (alert dikkat) "") (setq kademe 2) (setvar "osmode" 0) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (command "line" L1 L2 "") (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (/ uzu 2)) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix uzu)) 0.5) uzu (fix (+ 1 uzu)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;Pline noktaları;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (< kademe 2) (command "_linetype" "s" "continuous" "") (command "_linetype" "s" "dashed" "")) (setq L3 (list (+ L1x (* kd (cos teta))) (+ L1y (* kd (sin teta))) 0)) (command "line" L3 nokta1 "") (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) (DEFUN C:kö ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "0" "c" "White" "" "") (setq L1 (getpoint "Başlangıç bacasını seçiniz")) (command "layer" "m" "1" "c" "red" "" "") (setq L1x (car L1)) (setq L1y (cadr L1)) (command "") (setq L2 (getpoint "Bitiş bacasını seçiniz")) (setq uzu (distance L1 L2)) (setq arasayısı (fix (/ uzu 60))) (setq arauzaklık (/ uzu (+ arasayısı 1))) (setq dikkat (strcat "uzunluk " (itoa (fix uzu)) " m. olduğu için araya " (itoa arasayısı) " adet daha baca yerleştirmelisiniz. (ara uzaklıklar " (itoa (fix arauzaklık)) " m olabilir.)")) (if (> uzu 62) (alert dikkat) "") (setq kademe 1) (setvar "osmode" 0) (setq L2x (car L2)) (setq L2y (cadr L2)) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (command "line" L1 L2 "") (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (/ uzu 2)) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix uzu)) 0.5) uzu (fix (+ 1 uzu)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;Pline noktaları;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta5;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta5x (+ L1x deltax)) (setq nokta5y (+ L1y deltay)) (setq nokta5 (list nokta5x nokta5y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta6x (+ L1x deltax)) (setq nokta6y (+ L1y deltay)) (setq nokta6 (list nokta6x nokta6y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta7x (+ L1x deltax)) (setq nokta7y (+ L1y deltay)) (setq nokta7 (list nokta7x nokta7y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (< kademe 2) (command "_linetype" "s" "continuous" "") (command "_linetype" "s" "dashed" "")) (setq L3 (list (+ L1x (* kd (cos teta))) (+ L1y (* kd (sin teta))) 0)) (command "line" L3 nokta5 "") (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") (command "_pline" nokta5 nokta6 nokta1 nokta7 nokta5 "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) (command "units" "2" "4" "4" "0" "0" "n") (DEFUN C:q ( ) (setq data (open "C:/Documents and Settings/Exper/Desktop/şemsi/LİSPPROG/test.csv" "r")) ;;;;;;;;;;yukarıdaki dosya açma adresini kendinize göre ayarlamanız lazım;;;;;;;;;; (setq satırsayı (getint " işlem yapılacak satır sayısını giriniz")) (repeat satırsayı (setq bilgi (read-line data)) ;;;;;;;;;;;;;;;harf harf uzunluklar;;;;;;;;;;;;;;;;;; (setq başkoordinat 20) (setq sonkoordinat 20) (setq kadem 2) (setq boruboyu 3) (setq başderinlik 4) (setq sonderinlik 4) (setq çap 4) (setq başsırtkotu 6) (setq sonsırtkotu 6) ;;;;;;;;;;;;;;;baş derinlik;;;;;;;;;;;;;;;;;; (setq bh (Substr bilgi 54 başderinlik)) ;;;;;;;;;;;;;;;son derinlik;;;;;;;;;;;;;;;;;; (setq uh (Substr bilgi 61 sonderinlik)) ;;;;;;;;;;;;;;;;;;;;;;;MECRANIN ATILMASI;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kd 1.25) ;küçük daire yarıçapı. (setq Lyazı 1.7) ;uzunluk, cap, eğim yazısı. (setq Lyazı2 1.6) ;sırt kot yazısı. (setq ok 3) ;ok uzunluğu. (setq dL 1.8) ;uzunluk yazısının çizgiden uzaklığı. (setq değim 1.8) ;eğim yazısının çizgiden uzaklığı. (setq dçap 1.8) ;çap yazısının çizgiden uzaklığı. (setq dbaşsırt 1.5) ;çap yazısının çizgiden uzaklığı. (setq duçsırt 1.5) ;çap yazısının çizgiden uzaklığı. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;, (setvar "osmode" 4) (command "_style" "Standart" "txt" "0" "1" "0" "NO" "NO" "N") (command "layer" "m" "1" "c" "red" "" "") ;;;;;;;;;;;;;;;baş koordinatın bulunması;;;;;;;;;;;;;;;;;; (setq bk (Substr bilgi 1 başkoordinat)) (setq bkx (atof (Substr bk 2 9))) (setq bky (atof (Substr bk 12 9))) ;;;;;;;;;;;;;;;son koordinatın bulunması;;;;;;;;;;;;;;;;;; (setq uk (Substr bilgi 22 sonkoordinat)) (setq ukx (atof (Substr uk 2 10))) (setq uky (atof (Substr uk 12 10))) (setq L1x bkx) (setq L1y bky) (setq L2x ukx) (setq L2y uky) (setq L1 (list bkx bky 0)) (setq L2 (list ukx uky 0)) (setq uzu (distance L1 L2)) ;;;;;;;;;;;;;;;kadem;;;;;;;;;;;;;;;;;; (setq k (Substr bilgi 43 kadem)) (setq ki (substr bilgi 44 1)) (setq kademe (distof ki)) (setvar "osmode" 0) (setq teta (angle L1 L2)) (command "layer" "m" "1" "c" "red" "" "") (command "line" L1 L2 "") ;;;;;;;;;;;;;Pline nokta koordinatlarının bulunması;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta1x (+ L1x deltax)) (setq nokta1y (+ L1y deltay)) (setq nokta1 (list nokta1x nokta1y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;Nokta2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta2x (+ L1x deltax)) (setq nokta2y (+ L1y deltay)) (setq nokta2 (list nokta2x nokta2y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta3x (+ L1x deltax)) (setq nokta3y (+ L1y deltay)) (setq nokta3 (list nokta3x nokta3y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta4x (+ L1x deltax)) (setq nokta4y (+ L1y deltay)) (setq nokta4 (list nokta4x nokta4y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta5;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b 0) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta5x (+ L1x deltax)) (setq nokta5y (+ L1y deltay)) (setq nokta5 (list nokta5x nokta5y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b kd) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta6x (+ L1x deltax)) (setq nokta6y (+ L1y deltay)) (setq nokta6 (list nokta6x nokta6y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;nokta7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (- uzu kd ok ok)) (setq b (- 0 kd)) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq nokta7x (+ L1x deltax)) (setq nokta7y (+ L1y deltay)) (setq nokta7 (list nokta7x nokta7y 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "layer" "m" "KANAL" "c" "32" "" "") (if (> kademe 2) (command "_linetype" "s" "continuous" "") (if (> kademe 1) (command "_linetype" "s" "dashed" "") (command "_linetype" "s" "continuous" ""))) (if (> kademe 2) (command "line" L1 nokta5 "") (command "line" L1 nokta1 "")) (command "layer" "m" "YON" "c" "White" "" "") (command "_pline" nokta1 nokta2 nokta3 nokta4 nokta1 "") (if (> kademe 2) (command "_pline" nokta5 nokta6 nokta1 nokta7 nokta5 "") "") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;MESAFE;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_linetype" "s" "continuous" "") (command "layer" "m" "MESAFE" "c" "White" "" "") ;;;;;;;;;;;;;;;Uzunluk yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;boru uzunluğu;;;;;;;;;;;;;;;;;; (setq bb (atoi (Substr bilgi 48 boruboyu))) ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (if (> uzu 25) (setq a (* uzu 0.6)) (setq a (* (- uzu 4.25) 0.5))) (if (< L1x L2x) (setq b dL) (setq b (- 0 dL))) (if (> uzu 25) (setq b b) (setq b (if (> L2x L1x) (+ b 2) (- b 2)))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq uzboru (if (< (- uzu (fix bb)) 0.5) bb (fix (+ 1 bb)))) (setq uzboru (itoa (fix uzboru))) (setq Lyaz (strcat "L:" uzboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta Lyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) Lyaz)) ;;;;;;;;;;;;;;;EĞİM;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_linetype" "s" "continuous" "") (command "layer" "m" "EGİM" "c" "White" "" "") ;;;;;;;;;;;;;;;eğim yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;baş sırt kotu;;;;;;;;;;;;;;;;;; (if (> (atoi (Substr bilgi 74 başsırtkotu)) 99) (setq bs (Substr bilgi 74 başsırtkotu)) (setq bs (Substr bilgi 75 (- başsırtkotu 1)))) ;;;;;;;;;;;;;;;son sırt kotu;;;;;;;;;;;;;;;;;; (if (> (atoi (Substr bilgi 83 sonsırtkotu)) 99) (setq us (Substr bilgi 83 sonsırtkotu)) (setq us (Substr bilgi 84 (- sonsırtkotu 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (if (> uzu 25) (setq a (* (- uzu 4.25) 0.3)) (setq a (* (- uzu 4.25) 0.5))) (if (< L1x L2x) (setq b değim) (setq b (- 0 değim))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq eğim (/ uzu (- (distof bs) (distof us)))) (setq eğboru (if (< (- eğim (fix eğim)) 0.5) eğim (fix (+ 1 eğim)))) (setq eğboru (itoa (fix eğboru))) (setq eğyaz (strcat "1/" eğboru)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta eğyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) eğyaz)) ;;;;;;;;;;;;;;;ÇAP;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_linetype" "s" "continuous" "") (command "layer" "m" "CAP" "c" "White" "" "") ;;;;;;;;;;;;;;;çap yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;cap;;;;;;;;;;;;;;;;;; (setq c (distof (Substr bilgi 67 çap))) ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (setq a (* (- uzu 4.25) 0.5)) (if (> L1x L2x) (setq b dçap) (setq b (- 0 dçap))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq çapyaz (Rtos c)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı teta çapyaz) (command "text" "j" "mc" Lyazınokta Lyazı (+ teta pi) çapyaz)) ;;;;;;;;;;;;;;;BAŞ SIRT KOTU;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_linetype" "s" "continuous" "") (command "layer" "m" "AKOT" "c" "White" "" "") ;;;;;;;;;;;;;;;sırtkot yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (if (> uzu 25) (setq a 3.25) (setq a 2.25)) (if (> L1x L2x) (setq b dbaşsırt) (setq b (- 0 dbaşsırt))) (if (> uzu 25) (setq b b) (setq b (if (> L2x L1x) (- b 3) (+ b 3)))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq başsırtyaz bs) (setq dikaçı (+ teta (/ pi 2))) (if (> uzu 25) (setq kullanılacakaçı teta) (setq kullanılacakaçı dikaçı)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı2 kullanılacakaçı başsırtyaz) (command "text" "j" "mc" Lyazınokta Lyazı2 (+ kullanılacakaçı pi) başsırtyaz)) ;;;;;;;;;;;;;;;SON SIRT KOTU;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;sırtkot yazısının yazılışı;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;a değeri L1 den olan mesafe. ;b değeri çizgiye dik olan mesafe. (if (> uzu 25) (setq a (- uzu 8)) (setq a (- uzu 5.5))) (if (> L1x L2x) (setq b dbaşsırt) (setq b (- 0 dbaşsırt))) (if (> uzu 25) (setq b b) (setq b (if (> L2x L1x) (- b 3) (+ b 3)))) (setq beta (Atan (/ b a))) (setq a2a (expt a 2)) (setq b2b (expt b 2)) (setq x (sqrt (+ a2a b2b))) (setq deltax (* x (cos (- teta beta)))) (setq deltay (* x (sin (- teta beta)))) (setq Lyazınoktax (+ L1x deltax)) (setq Lyazınoktay (+ L1y deltay)) (setq Lyazınokta (list Lyazınoktax Lyazınoktay 0)) (setq sonsırtyaz us) (setq dikaçı (+ teta (/ pi 2))) (if (> uzu 25) (setq kullanılacakaçı teta) (setq kullanılacakaçı dikaçı)) (if (< L1x L2x) (command "text" "j" "mc" Lyazınokta Lyazı2 kullanılacakaçı başsırtyaz) (command "text" "j" "mc" Lyazınokta Lyazı2 (+ kullanılacakaçı pi) sonsırtyaz)) (command "layer" "m" "0" "c" "White" "" "") (command "_linetype" "s" "continuous" "") ) (close data) )
Bu site çok faydalı bir site. Tüm arkadaşlarıma tavsiye ediyorum. Böyle bir sitenin olması iş ortamındaki yardımlaşmanın en güzel yolu. site sahibine ne kadar teşekkür etsek azdır.alt yapı inş. konularında yardım isteyen arkadaşlara yardımcı olabilirim. |
|
|
Sibay
konu,
457 ileti |
#700 26.09.2005 12:12 GMT |
|
Yukarıdaki lispleri hazırlayan arkadaşa teşekkür ederiz, ancak kodlar buradan kopyalanarak kullanılamıyor ve bazı hatalar oluşuyor. Bu hataları düzeltip lispi tekrar yayınlayana kadar lütfen kullanmayın. Sadece incelemek için kullanın.
|
|
|
MSucullu
konu,
7 ileti |
#701 26.09.2005 14:34 GMT |
|
lisp kodların dosyalarını e-mailinize (tekniker_aydin@yahoo.com adresine)gönderdim. adresim:
Bu site çok faydalı bir site. Tüm arkadaşlarıma tavsiye ediyorum. Böyle bir sitenin olması iş ortamındaki yardımlaşmanın en güzel yolu. site sahibine ne kadar teşekkür etsek azdır.alt yapı inş. konularında yardım isteyen arkadaşlara yardımcı olabilirim. |
|
|
SnipeTR
konu,
11 ileti |
#723 29.09.2005 13:46 GMT |
|
merhaba arkadaşlar bana dairelerin eksenlerini çizecek bir lisp lazım (center mark gibi) ama bundan tek farkı dairenin boyutuna göre eksen çizmesi
örn: 100 mm çaplı bir daireyi seçtiğim zaman 110 mm lik eksen çizgisi koyacak şimdiden teşekkür ederim
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#724 29.09.2005 16:57 GMT |
|
snipeTR
bu dairelerin dışa çıkan pas payı standar mı olacak. yoksa çemberin çapına orantılı birşey mi? orantılı ise bu oranı söylersen en kısa zamanda hazırlarım.
|
|
|
SnipeTR
konu,
11 ileti |
#725 29.09.2005 17:06 GMT |
|
dairelerden 3 mm çıksa bana yeter ehya yani 50+3 25+3 30+3
vb bu şekilde olursa çok iyi olur vede teşekkür ederim
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#726 29.09.2005 17:45 GMT |
|
;;; pas payları konusunda düşündüm ki, isteğe bağlı olsun, tek kişiye değil, genele hitap etsin istedim. Komutun ismi "dec" çoklu seçim yapabilirsiniz.
Kod: (defun c:dec ()
(setvar "cmdecho" 0) (setvar "modemacro" "Archme Design 2005 ©") (setq dec_sec (ssget (list (cons 0 "CIRCLE")))) (if (= dec_sec nil) (progn (princ " Seçim yok!...Komut bitirildi..")) (progn (if (= dec_pas nil)(setq dec_pas 3)) (initget 2) (setq dec_p (getdist (strcat " Pas Payı:<" (rtos dec_pas)">:"))) (if (= dec_p nil)(setq dec_p dec_pas)) (setq dec_pas dec_p) (setq dec_c 0) (setq dec_say (sslength dec_sec)) (while (< dec_c dec_say) (setq dec_sec_tek (ssname dec_sec dec_c)) (setq dec_sec_tek_yr (cdr (assoc 40 (entget dec_sec_tek))) dec_sec_tek_mr (cdr (assoc 10 (entget dec_sec_tek)))) (setq dec_os (getvar "osmode")) (setvar "osmode" 0) (setq dec_1a (polar dec_sec_tek_mr (angtof "0") (+ dec_sec_tek_yr dec_pas)) dec_1b (polar dec_sec_tek_mr (angtof "180") (+ dec_sec_tek_yr dec_pas)) dec_2a (polar dec_sec_tek_mr (angtof "90") (+ dec_sec_tek_yr dec_pas)) dec_2b (polar dec_sec_tek_mr (angtof "270") (+ dec_sec_tek_yr dec_pas))) (command "line" dec_1a dec_1b "") (command "line" dec_2a dec_2b "") (setq dec_c (+ dec_c 1)) ))) (setvar "osmode" dec_os) (princ) )
|
|
|
SnipeTR
konu,
11 ileti |
#727 29.09.2005 20:26 GMT |
|
teşekkür ederim ehya arkadaşım yani tabiri caizsse cuk diye oturdu eline ve emeğine sağlık
|
|
|
mehmetatalay_5 [2] Acemi
konu,
1 ileti |
#729 01.10.2005 11:17 GMT |
|
arkadaslar mimari projelerde aks numaralarını ve aks harflerini kolayca verebilecegim bir lisp var mı elinizde?
yardımcı olabilirseniz sevinirim ............................................... E-mail adresi vermek yasaktır.
|
|
|
MSucullu
konu,
7 ileti |
#730 01.10.2005 11:38 GMT |
|
arkadaşlar daha önceden başka bir autocad dosyasında hazırladığım blok çizimlerimden istediğim birini, çalışmakta olduğum dosya içine kopyala-yapıştır yapan bir lisp yazılabiliyormu. Acil değil ama olursa iyi olur.
Mehmet ATALAY ın işine yararsa bir lisp gönderiyorum. Rakam sıralamak için "Num1", harf sıralamak için "NumA" yazıyorsun sonra değiştirmek istersen bunu kendine göre değiştirebilirsin. Kod: (defun C:Num1 ()
(setq yazıyüksekliği (getdist (strcat " Yazi Yuksekligini Giriniz : "))) (setq başsayı (getdist (strcat " Başlangıç sayısını yazınız : "))) (setq koordinat (getpoint " yazılacak yeri tıklayınız :")) (setq koordinatx (car koordinat)) (setq koordinaty (cadr koordinat)) (setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0)) (command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı)) (while (> 10000) (setq başsayı (+ 1 başsayı)) (setq koordinat (getpoint " yazılacak yeri tıklayınız :")) (setq koordinatx (car koordinat)) (setq koordinaty (cadr koordinat)) (setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0)) (command "text" "m" koordinatxy yazıyüksekliği "0" (fix başsayı)) ) ) (defun C:NumA () (setq yazıyüksekliği (getdist (strcat " Yazi Yuksekligini Giriniz : "))) (setq başharfi (getstring (strcat " Başlangıç harfi yazınız : "))) (setq koordinat (getpoint " yazılacak yeri tıklayınız :")) (setq koordinatx (car koordinat)) (setq koordinaty (cadr koordinat)) (setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0)) (command "text" "m" koordinatxy yazıyüksekliği "0" başharfi) (while (> 10000) (if (= başharfi "A") (setq başharfi "B") (if (= başharfi "B") (setq başharfi "C") (if (= başharfi "C") (setq başharfi "D") (if (= başharfi "D") (setq başharfi "E") (if (= başharfi "F") (setq başharfi "G") (if (= başharfi "G") (setq başharfi "H") (if (= başharfi "H") (setq başharfi "I") (if (= başharfi "I") (setq başharfi "İ") (if (= başharfi "İ") (setq başharfi "J") (if (= başharfi "J") (setq başharfi "K") (if (= başharfi "K") (setq başharfi "L") (if (= başharfi "L") (setq başharfi "M") (if (= başharfi "M") (setq başharfi "N") (if (= başharfi "N") (setq başharfi "O") (if (= başharfi "O") (setq başharfi "Ö") (if (= başharfi "Ö") (setq başharfi "P") (if (= başharfi "P") (setq başharfi "R") (if (= başharfi "R") (setq başharfi "S") (if (= başharfi "S") (setq başharfi "Ş") (if (= başharfi "Ş") (setq başharfi "T") (if (= başharfi "T") (setq başharfi "U") (if (= başharfi "U") (setq başharfi "Ü") (if (= başharfi "Ü") (setq başharfi "V") (if (= başharfi "V") (setq başharfi "Y") (if (= başharfi "Y") (setq başharfi "Z") ))))))))))))))))))))))))) (setq koordinat (getpoint " yazılacak yeri tıklayınız :")) (setq koordinatx (car koordinat)) (setq koordinaty (cadr koordinat)) (setq koordinatxy (list koordinatx (+ (/ yazıyüksekliği 2) koordinaty) 0)) (command "text" "m" koordinatxy yazıyüksekliği "0" başharfi)) ) )
Bu site çok faydalı bir site. Tüm arkadaşlarıma tavsiye ediyorum. Böyle bir sitenin olması iş ortamındaki yardımlaşmanın en güzel yolu. site sahibine ne kadar teşekkür etsek azdır.alt yapı inş. konularında yardım isteyen arkadaşlara yardımcı olabilirim. |
|
|
SnipeTR
konu,
11 ileti |
#734 03.10.2005 17:29 GMT |
|
merhaba arkadaşlar forumda aradım ama bulamadım
derya kılıç ın hazırlamış olduğu bir lisp vardı iki yazıyı seçiyorduk (yazılarda rakamlar yazıyordu) iki yazıyı seçip başka bir yazıya tıkladığımızda ikisini toplamını veriyordu ismini tam olarak hatırlayamıyorum ama komutu "yt" benim sizlerden istediğim acaba bu lisp e multiple seçeneği ekleyebiliyormuz??? yardımcı olursanız sevinirim
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#736 04.10.2005 09:28 GMT |
|
;;;; çoklu seçimlisini daha önceden yazmıştım... Kodlarını yazıyorum.
Kod: (defun c:yt ()
(setvar "modemacro" "Archme Design 2005 ©") (princ " Toplamı alınacak yazıları seçiniz:") (setq yy_sec (ssget (list (cons 0 "TEXT")))) (if (= yy_sec nil) (progn) (progn (setq yy_topla 0) (setq yy_c 0) (setq yy_say (sslength yy_sec)) (while (< yy_c yy_say) (setq e_yy_sec (ssname yy_sec yy_c)) (setq tan_e_yy_sec (cdr (assoc 1 (entget e_yy_sec)))) (setq yy_num (numberp (atof tan_e_yy_sec))) (if (= yy_num nil) (progn) (progn (setq yy_topla (+ yy_topla (atof tan_e_yy_sec))) (setq yy_c (+ yy_c 1))))) (setq yy_sec (entsel " Değişecek yazıyı seçin:")) (command "change" yy_sec "" "" "" "" "" (rtos yy_topla 2 2)) )) (princ))
|
|
|
erolkahveci
konu,
7 ileti |
#746 06.10.2005 08:58 GMT |
|
Merabalar... Bana Şöyle Bir lisp lazım: Ayrı ayrı çizilmiş pline lerin alanlarını seçerek toplayacak ve bu toplamı istediğim veya daha önce belirlediğim bir yere benim belirleyeceğim bir açıklamayla yazabilecek... Böyle bir lisp yazan biri olursa çok sevinirim..
_________________________________ |
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#755 09.10.2005 00:52 GMT |
|
İstediğin lispi yöneticiye gönderdim. En kısa zamanda siteye ekler.
Kullanımda hata bulursanız, mutlaka bildirin. En kısa zamanda düzeltirim. Lisp kodu aşağıdadır... [Admin] Kod: (defun m2_br_sec ()
(if (= cizim_birim nil) (progn (initget 1 "Metre Cm") (setq cizim_birim (getkword " Çizim Birimini seçiniz [Metre / Cm]:"))))) (defun m2_stil () (setq m2_stil_ara (tblsearch "style" "m2")) (if (= m2_stil_ara nil) (progn (setq m2_yaz_yuk 12) (setq m2_yaz_y (getdist (strcat " Yazı Yüksekliği:< " (rtos m2_yaz_yuk) ">:"))) (if (= m2_yaz_y nil) (setq m2_yaz_y m2_yaz_yuk)) (setq m2_yaz_yuk m2_yaz_y) (command "style" "m2" "arial.ttf" m2_yaz_yuk "0.8" "" "" "")))) (defun c:m2 () (setvar "modemacro" "Archme Design 2005 ©") (setvar "cmdecho" 0) (m2_br_sec) (if (= cizim_birim "Metre") (setq m2_bol 100) (setq m2_bol 10000)) (setq m2_secim (ssget '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "POLYLINE") (0 . "CIRCLE") (0 . "ELLIPSE") (0 . "SPLINE") (0 . "REGION") (0 . "3DSOLID") (-4 . "OR>")))) (if (= m2_secim nil) (progn (princ)) (progn (setq m2_secim_say (sslength m2_secim)) (setq m2_c 0) (setq m2_toplam 0) (while (< m2_c m2_secim_say) (setq m2_secim_tek (ssname m2_secim m2_c)) (command "area" "e" m2_secim_tek) (setq m2_tek_alan (/ (getvar "area") m2_bol)) (setq m2_toplam (+ m2_toplam m2_tek_alan)) (setq m2_c (+ m2_c 1))) (m2_stil) (setq m2_aciklama (getstring t " Yazılacak metni yazınız:")) (setq m2_yer (getpoint " Yer Gösterin:")) (if (= m2_yer nil) (progn (princ " Yer gösterilmediği için komut bitirildi !!!...")) (progn (setvar "textstyle" "m2") (command "text" m2_yer "0" m2_aciklama) (command "text" "" (strcat (rtos m2_toplam 2 2) " m2")) ))))(princ))
|
|
|
fausto
konu,
4 ileti |
#766 13.10.2005 17:16 GMT |
|
merhaba arkadaşlar ..
benim çok ihtiyacım olan bir lisp var. ne yazıkki kendim yazamıyorum. bana yardımcı olursanız sevinirim. vaziyet planlarında koordinatlı çalışıyorum. fakat bir noktanın koordinatını yazmak için ya ordinate komutunu kullanıp x ve y yi ayrı ayrı yazmam gerekiyor yada bir point koyup onun x ve y lerini okuyup normal bir şekilde yazıyorum. benim isteğim: herhangi bir noktanın koordinatlarını x=........ alt çizgi ve onun altında y=......... olarak alabilmek. şimdiden teşekkür ederim..
|
|
|
hceven99 [5] Müdavim
konu,
13 ileti |
#767 13.10.2005 23:02 GMT |
|
Merhaba, lisp kodunu aşağıya yazıyorum;
Umarım işine yarar. İyi günler. Kod: (defun c:kn (/ nokta x y nokta_y yazi aciklama)
(prompt " 10/2005 © Ver 1.0 Koordinat yazımı.") (setvar "CMDECHO" 0) (while (= nokta nil) (setq nokta (getpoint " Koordinatı alınacak noktayı girin: ")) (if (= nokta nil) (princ "Bir nokta girmelisiniz...")) ) (setq x (car nokta) y (cadr nokta)) (setq aciklama (strcat "x:" (rtos x) " _ y:" (rtos y))) (princ aciklama) (setq nokta_y (getpoint ( strcat " Yazının başlangıç noktasını girin /<Koordinat noktası>: "))) (if (= nokta_y nil) (setq nokta_y nokta)) (command "text" nokta_y "" "" aciklama) (princ) )
|
|
|
fausto
konu,
4 ileti |
#769 14.10.2005 11:43 GMT |
|
lisp için teşekkür ederim ,ama maalesef çalışmıyor. komut satırını aşağıya kopyaladım. birde x ve y yi yanyana değilde altalta yazma gibi bir şansımız varmı
? Command: kmn 10/2005 © Ver 1.0 Koordinat yazımı. Koordinatı alınacak noktayı girin: x:10395.156 _ y:-1631.806 Yazının başlangıç noktasını girin /<Koordinat noktası>: Unknown command "X:10395.156 _ Y:-1631.806". Press F1 for help. Command: *Cancel*
|
|
|
Sibay
konu,
457 ileti |
#770 14.10.2005 12:23 GMT |
|
Yukarıdaki lisp düzenlenerek aşağıya yazılmıştır. Kendinize göre düzenleyebileceğiniz yerler kırmızı ile gösterilmiştir. Fareyi bu kırmızı alanların üstüne getirerek ilgili açıklamayı okuyabilirsiniz.
(defun c:kn (/ nokta x y nokta_y yazi aciklama) (prompt " 10/2005 © Ver 1.0 Koordinat yazımı.") (setvar "CMDECHO" 1) (while (= nokta nil) (setq nokta (getpoint " Koordinatı alınacak noktayı girin: ")) (if (= nokta nil) (princ "Bir nokta girmelisiniz...")) ) (setq x (car nokta) y (cadr nokta)) (setq aciklama (strcat "x:" (rtos x) " _ y:" (rtos y))) (princ aciklama) (setq nokta_y (getpoint ( strcat " Yazının başlangıç noktasını girin /<Koordinat noktası>: "))) (if (= nokta_y nil) (setq nokta_y nokta)) (command "text" "S" "STANDARD" nokta_y "3" "0" aciklama) (princ) )
|
|
|
hceven99 [5] Müdavim
konu,
13 ileti |
#773 14.10.2005 23:28 GMT |
|
Merhaba, kodun düzenlenmiş yeni hali aşağıdadır.
AutoCad 2004 ve üzeri versiyonlarda yazım hatası vermemesi gerekiyor. Yinede Koordinatı yazım esnasında hata oluşursa ( ;************** değiştirilebilir bölüm ) alanı içerisinde bulunan satırların başlarında bulunan noktalı virgülleri (;) silip, üstlerinde bulunan satırların başına koymalısın. iyi günler. Kod: (defun c:kn (/ gec_stil gec_yuk nokta_yakala aralik bilgi nokta x y nokta_y nokta_2 nok_y x_koor y_koor x_1 y_1 yazi aciklama)
(prompt " 10/2005 © Ver 2.0 Koordinat yazımı.") (setvar "CMDECHO" 0) (setq gec_stil (getvar "TEXTSTYLE")) (setq gec_yuk ( getvar "TEXTSIZE")) (setq nokta_yakala (getvar "OSMODE")) (setq aralik (* gec_yuk 1.618)) (setq bilgi (strcat " Aktif yazı stili <" gec_stil "> / yüksekliği <" (rtos gec_yuk) "> dir.")) (princ bilgi) (while (= nokta nil) (setq nokta (getpoint " Koordinatı alınacak noktayı giriniz: ")) (if (= nokta nil) (princ "Bir nokta girmelisiniz...")) ) (setq x (car nokta) y (cadr nokta)) (setq x_koor (strcat "x:" (rtos x) "_" )) (setq y_koor (strcat "y:" (rtos y))) (princ x_koor) (princ y_koor) (setq nokta_y (getpoint ( strcat " Yazının başlangıç noktasını giriniz /<Koordinat noktası>: "))) (if (= nokta_y nil) (setq nokta_y nokta)) (setq x_1 (car nokta_y) y_1 (cadr nokta_y)) (setq nok_y (- y_1 aralik)) (setq nokta_2 (list x_1 nok_y)) (setvar "OSMODE" 0) ;;;******************************** değiştirilebilir bölüm (command "text" nokta_y "" "" x_koor) ;(command "text" "S" "STANDARD" nokta_y "" "0" x_koor) (command "text" nokta_2 "" "" y_koor) ;(command "text" "S" "STANDARD" nokta_2 "" "0" y_koor) ;;;********************************* (setvar "OSMODE" nokta_yakala) (princ) )
|
|
|
fausto
konu,
4 ileti |
#785 17.10.2005 10:12 GMT |
|
teşekkürler arkadaşlar,sayenizde sorun çözümlendi...
artık bende lisp yazmak için çalışmaya başlayacağım,umarım bi şeyler yapabilirim..
|
|
|
erolkahveci
konu,
7 ileti |
#815 25.10.2005 08:56 GMT |
|
ÖNCELİKLE SİTE İÇİN TEŞEKKÜRLER....Benim daha önce siteden bir arkaştan aldığım bir lispim var... bu lisp ayrı ayrı çizilmiş plyline ların alanlarını toplayıp daha önceden belirlediğim bir yere yine benim yanına eklediğim açıklamayla toplayıp yazıyor... bu lispte şu şekilde bir düzeltme yapabilir miyiz?.. bu lispin başına yine ayarlarını benim yapabileceğim bir "-hatch" komutu eklenebilir mi? Enson alanı hesaplanacak yeri seçtiğimde hem alanı toplayıp yazacak hemde bu çizgilerin içini dolduracak... Biraz acilde yardımcı olursanız sevirim... herşey için şimdiden teşekkürler....lisp şu şekilde ;
Kod: defun c:alanc (/ yuksek a1b nokta deger yaz akyuk ciz_bir yaz_bir yazi_1 yazi_1_gir alan alan_t)
(prompt " 12/1998 © Ver 2.1 Alan hesabı ve yazımı.") (setvar "cmdecho" 0) (setq akyuk (getvar "TEXTSIZE")) (setq akstl (getvar "TEXTSTYLE")) (setq yazi_1 (getstring T " Alan bölümü için yazıyı girin <Alan: >: ")) (if (= yazi_1 "")(setq yazi_1 "Alan: ")) (while (and (/= ciz_bir "MM")(/= ciz_bir "CM")(/= ciz_bir "M")) (setq ciz_bir (strcase (getstring " Çizilen birim <mm>/cm/m :"))) (if (= ciz_bir "")(setq ciz_bir "MM")) (if (and (/= ciz_bir "MM")(/= ciz_bir "CM")(/= ciz_bir "M")) (princ " *Geçersiz klavye girişi...") ) ) (setq y_d 0) (cond ((= ciz_bir "MM")(setq ciz_d 1000)) ((= ciz_bir "CM")(setq ciz_d 10)) ((= ciz_bir "M")(setq ciz_d 0.001)) ) (yaz_bir_bol) (princ) ) (defun yaz_bir_bol () (while (and (/= yaz_bir "MM")(/= yaz_bir "CM")(/= yaz_bir "M")) (setq yaz_bir (strcase (getstring " Yazılması istenen birim kare mm/cm/<m> :"))) (if (= yaz_bir "")(setq yaz_bir "M")) (if (and (/= yaz_bir "MM")(/= yaz_bir "CM")(/= yaz_bir "M")) (princ " *Geçersiz klavye girişi...") ) ) (cond ((= yaz_bir "MM")(progn (setq yaz_d 1000)(setq br "mm"))) ((= yaz_bir "CM")(progn (setq yaz_d 10)(setq br "cm"))) ((= yaz_bir "M")(progn (setq yaz_d 0.001)(setq br "m"))) ) (yaz_bil_gir) ) (defun yaz_bil_gir () (setq crp_d (rtos (/ ciz_d yaz_d) 2 7)) (setq yuksek (getdist (strcat " Aktif yazi stili<" akstl ">/Yazinin yuksekligini giriniz <" (rtos akyuk) ">: "))) (if (= yuksek nil) (setq yuksek akyuk) ) (princ (strcat "Belirlenen yukseklik <" (rtos yuksek) "> dir.")) (yaz_bol) ) (defun yaz_bol () (setq a1b 0) (setq alan 0) (setq alan_t 0) (while (/= a1b nil) (setq a1b (car (entsel " Objeyi seçiniz: "))) (if (/= a1b nil) (progn (setq ayar (entget a1b)) (setq oz (cdr (assoc 0 ayar))) (if (or (= oz "LWPOLYLINE") (= oz "CIRCLE") (= oz "ARC")) (progn (redraw a1b 3) (command "area" "o" a1b) (setq alan_t (getvar "area")) (setq alan (+ alan alan_t)) (princ "Toplam alan: ")(princ alan) ) ;(if (/= a1b nil) (redraw a1b 4)) (princ (strcat " Seçilen obje Lwpolyline değil, " oz " dir.")) ) ) ) ) (if (= y_d 0) (setq crp_d (atof crp_d)) ) (setq deger (/ alan crp_d)) (princ (strcat " Alan: " (rtos deger)" " br "2 dir.")) (while (= nokta nil) (setq nokta (getpoint " Yazının başlangıç noktasını giriniz : ")) (if (= nokta nil)(princ " Birnokta girmelisiniz...")) ) (command "regen") (setq yazi (strcat yazi_1 (rtos deger) " " br "2")) (princ " Yazi: ")(princ yazi) (command "text" nokta yuksek "" yazi) (setq nokta nil) (setq y_d 1) (princ " İşlem bitti.") (princ) )
_________________________________ |
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#816 25.10.2005 09:33 GMT |
|
Eklenmesine eklenir ama, bu tarama türü ve ölçeği konusunda bi bilgi verilmemiş. Bu konuda bilgi verirsen sevinirim.
|
|
|
hceven99 [5] Müdavim
konu,
13 ileti |
#817 25.10.2005 10:35 GMT |
|
Merhaba Erol, umarım iyisindir.
Tarama işini yaptırabilirsin. Ama daha kolay olması için lisp i çalıştırmadan bir defa istedğin tarama şeklini ve ölçeğini ayarlayıp boş bir şekli tarat. Bunun sayesinde komutu girişinde tarama ayarları yapmana gerek kalmaz. (command "area" "o" a1b) (command "bhatch" "s" a1b "" "") (setq alan_t (getvar "area")) üst kısımda yazdığım üst ve altdaki iki satırın arasına ortada yazdığım bölümü ekle. aksilik olursa arayabilirsin. msn adresimi biliyorsun. kolay gelsin
|
|
|
erolkahveci
konu,
7 ileti |
#822 25.10.2005 18:14 GMT |
|
teşekkürler şimdilik problemim çözüldü.. bizde öğrenebilsek.. ne güzel olur...
_________________________________ |
|
|
ecetinkol [1] Yeni üye
konu,
2 ileti |
#878 07.11.2005 15:39 GMT |
|
arkadaşlar merhaba daha önceden "nodegis" diye bir lisp vardı. burada numaralar istediğimiz sayıdan başlayıp birer artarak devam ediyordu. kullanıyorum ve çok işime yarıyor. yapan arkadaşlara teşekkür ederim. Benim bir ricam olacak bu lisp'i yine birer artarak ve bizim belirleyeceğimiz bir harfle yani
örnek: A1 A2 A3 gibi yapabilir misiniz. Teşekkür ederim.
|
|
|
Sibay
konu,
457 ileti |
#882 08.11.2005 11:35 GMT |
|
1,2,3, ... diye rakamları sıraladıktan sonra başına veya sonuna istediğiniz yazıyı ekleyebilirsiniz...
Aşağıdaki lisp Derya KILIÇ tarafından kodlanmıştır. Kod: (defun c:tekle(/ ekyazi i obj elist ename)
(princ " İşlenecek yazıları seçiniz :") (if (setq obj (ssget '((0 . "TEXT")))) (if (/= "" (setq ekyazi (getstring " Eklenecek Yazı :"))) (progn (initget "Bas Son") (setq tercih (getkword "Başına mı Sonuna mı? [Bas/Son] <B> :")) (if (null tercih) (setq tercih "B")) (command "undo" "begin") (setq i 0) (while (setq ename (ssname obj i)) (setq elist (entget ename) i (1+ i) ) (if (= tercih "B") (setq elist (subst (cons 1 (strcat ekyazi (cdr (assoc 1 elist)))) (assoc 1 elist) elist)) (setq elist (subst (cons 1 (strcat (cdr (assoc 1 elist)) ekyazi)) (assoc 1 elist) elist)) ) (entmod elist) );_while (command "undo" "end") );_progn );_if );_if );_tdeg
|
|
|
ecetinkol [1] Yeni üye
konu,
2 ileti |
#887 08.11.2005 17:55 GMT |
|
Teşekkür ederim.Yalnız bir sorun var. Her iki şekilde de harfi sonuna ekliyor.
Bu sorunu da giderebilirseniz sevinirim.
|
|
|
istanbul61 [2] Acemi
konu,
4 ileti |
#919 11.11.2005 00:13 GMT |
|
Arkadaşlar kolay gelsin. Ekrandan seçilen birkaç tane yazıyı değiştirecek kodu nasıl yazarım. Mesela Seçtiklerim yazılardaki "Tane" yazılarını "Taze" yapmak. Find / Replace gibi. Şimdiden teşekkürler.
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#921 11.11.2005 09:44 GMT |
|
;;;Bu istediğini bir lisp üzerinde anlatmak sanırım daha iyi olur.
(defun c:yazideg (/ yazi_ne) ;;; komut ismi yazideg (setq yazi_ne (getstring t "Aranacak yazı:")) ;;; ekranda aranacak yazı (setq yazi_ss (getstring t "Yeni Yazı:")) ;;; yeni yazılacak yazı (setq yazi_sec (ssget (list (cons 1 yazi_ne)))) ;;; seçim yaptığın takdirde sadece aradığın yazıların seçilmesini sağlar (if (= yazi_sec nil) (progn (princ " Seçim yok!!!")) (progn (setq c 0) ;;; döngü oluşturacak. bunun için bir tanım yapıldı (setq yazi_adet (sslength yazi_sec)) ;; değişecek yazıının adeti (while (< c yazi_adet) ;; değişecek yazı adetine göre döngü oluşturuldu (setq yazi_tek (ssname yazi_sec c)) ;; seçilen yazılardan bir tanesi seçildi (setq yazi_1a (cdr (assoc 1 (entget yazi_tek)))) ;; seçilen yazının mevcut değeri bulundu (setq yazi_deg (entget yazi_tek)) ;; seçilen yazının database'i açıldı (setq yazi_deg (append yazi_deg (list (cons 1 yazi_ss)))) ;; verilen yeni yazıya göre mevcut yazı değiştirildi (entmod yazi_deg);; işlem uygulandı (redraw) (setq c (+ c 1)) ;; döngü için c değeri +1 arttırıldı )))(princ))
|
|
|
istanbul61 [2] Acemi
konu,
4 ileti |
#925 11.11.2005 12:42 GMT |
|
ehya arkadaşım ilgine ve emeğine çok teşekkür ediyorum. Çok güzel olmuş. Ben ne istediğimi tam anlatamadım. Kelimeyi komle değişmek değil de içinden bir harfi bulup değiştirmek istiyorum. Yani farklı kelimeler seçecek ve bu kelimelerin içindeki bir harfi değiştirecek. Mesela "Teşekkür ederim" kelimesinde "e" harfini "İ" yap deyince "Tİşİkkür İdİrim" yapacak.
|
|
|
ehya [80] Yetkili
konu,
1864 ileti |
#933 12.11.2005 09:58 GMT |
|
;; istediğine göre yeni bir lisp hazırladım. açıklaması yanında. oluşabilecek hatalara karşı kod yazmadım. yazdıkça lisp uzar, malum vakit...
 (defun c:harfdeg () (setq harfdeg_sec (ssget (list (cons 0 "TEXT")))) ;;; sadece yazı seçimi yapıldı (if (= harfdeg_sec nil) (progn (princ " Seçim Yok!!!")) (progn (setq harf_ara (getstring " Aranacak harfi girin:")) ;;; aranacak harf isteniyor (setq deg_harf (getstring " Yeni harfi girin:")) ;;; yeni harf isteniyor (setq harfdeg_say (sslength harfdeg_sec)) ;;; seçilen yazıların adeti (setq c 0) (while (< c harfdeg_say) ;;; seçilen yazı adedine göre döngü oluşturuluyor (setq harfdeg_tek (ssname harfdeg_sec c)) ;; seçilen yazılardan bir tanesi alınıyor (setq harfdeg_ne (cdr (assoc 1 (entget harfdeg_tek)))) ;;;; ilk alınan yazının ne olduğu öğreniliyor (setq harfdeg_yeni "" hc 1) (repeat (strlen harfdeg_ne) ;;; ilk alınan yazının karakter sayısı kadar ikinci bir döngü oluşturuluyor (setq tek_tek (substr harfdeg_ne hc 1)) ;; ilk alınan yazının harfleri tek tek alınıyor (if (= tek_tek harf_ara) (progn ;; seçilen harf aranan harfle karşılaştırılıyor (setq ss_harf deg_harf)) ;; aynı ise yeni harf uygulanıyor (progn (setq ss_harf tek_tek))) ;; değil ise mevcut harf aynı bırakılıyor (setq harfdeg_yeni (strcat harfdeg_yeni ss_harf)) ;; bakılan harf bir dizgi olarak hazırlanıyor (setq hc (+ hc 1)) ) (setq dd_yazi (entget harfdeg_tek)) ;; seçilen yazının database'i açılıyor (setq dd_yazi (append dd_yazi (list (cons 1 harfdeg_yeni)))) ; yeni hazırlanan yazı ile değiştiriliyor (entmod dd_yazi) ;; yeni yazı uygulanıyor (setq c (+ c 1)) ) ))(princ))
|
|
|
istanbul61 [2] Acemi
konu,
4 ileti |
#934 12.11.2005 12:17 GMT |
|
Walla kardeşim denedim süpeeeeerrrrrr. Lisp i ilk duyduğum andan itibaren böyle bişe yapmaya çalışıyordum. Sana nekadar teşekkür edeceğimi bilemiyorum. Ayrıca bu siteyi kuranlarıda tebrik ediyorum ve helal olsun diyorum. Bilgi paylaştıkca çoğalır. İnşallah ilerleyen zamanlarda benim yazdığım lispleride burada göreksiniz diyorum ve saygılar sunuyorummmm.
|
|
|
soner001 [2] Acemi
konu,
3 ileti |
#1107 10.12.2005 17:04 GMT |
|
ehya lisp yazi degişte lips si bende düzgün calışmıyor.. yazıyı buluyor yanına yeni istenen yazıyı ekliyor ..
örnegin aaa yı bbb ile degiş dedigim zaman aaabbb yapıyor nasıl düzelte biliriz bunu ?
|
|
|
istanbul61 [2] Acemi
konu,
4 ileti |
#1256 22.12.2005 13:58 GMT |
|
soner001 arkadaşım bende düzgün çalışıyor. İstersen özelime mail adresini yaz sana lisp dosyasını mail atayım.
|
|
|
sis
konu,
1 ileti |
#1257 23.12.2005 08:44 GMT |
|
arkadaşlar bana niye kimse cevap vermiyor. Benim kesitte kot verebilecek bir lispe ihtiyacım var Yani zeminden başlayarak 0.00 kotundan istediğim her noktaya kot yazabilecek bir lisp.Böyle bir lisp yokmudur ben boşunamı arıyorum acaba
|
|
 |
 |
|
|
 |
| 30.42TL | 33.75TL | 24.96TL | 27.00TL |
33.75TL | 32.25TL |
