Copyright © 2004-2022 SQL: 0.652 saniye - Sorgu: 45 - Ortalama: 0.01448 saniye
 |
 |
 |
 |
|
|
|
|
24.03.2011 20:38
yunushanilce 
|
|
Kod: ;;; bu program m.Ş. güvercin tarafından ;;; mehmet yangın için hazırlanmıştır. ;;; 08.12.2009 22:10 (defun c:kk () (command "undo" "group") (setvar "cmdecho" 0) (setq oosm (getvar "osmode") ts (getvar "textsize") eksen (car (entsel "\neksen çizgisini seçiniz...")) ) (while (/= (strcase "line") (cdr (assoc 0 (entget eksen)))) (setq eksen (car (entsel "\neksen çizgisini seçiniz..."))) ) (setq mesor (cadr (assoc 10 (entget eksen))) kotor (cadr (getpoint "\nreferans kot noktasını seçiniz...")) refko (getreal "\nreferans kot değerini giriniz: ") nokta (getpoint "\yeni nokta seçiniz...") ) (while nokta (setq nokx (car nokta) noky (cadr nokta) mesa (rtos (abs (- mesor nokx)) 2 3) kot (rtos (+ refko (- noky kotor)) 2 3) dogrultu (getpoint "\nyazıların yerini seçiniz...") ) (if (= (atof kot) 0) (setq kot (strcat "%%p" kot))) (setq uz (strlen kot) sr 1) (while (and (< sr uz) (/= (substr kot sr 1) ".")) (setq sr (1+ sr))) (setq yer (- uz sr) frk (- 3 yer)) (if (= yer 0) (setq kot (strcat kot "."))) (while (> frk 0) (setq kot (strcat kot "0") frk (1- frk))) (setq uz (strlen mesa) sr 1) (while (and (< sr uz) (/= (substr mesa sr 1) ".")) (setq sr (1+ sr))) (setq yer (- uz sr) frk (- 3 yer)) (if (= yer 0) (setq mesa (strcat mesa "."))) (while (> frk 0) (setq mesa (strcat mesa "0") frk (1- frk))) (if (> (cadr dogrultu) noky) (setq n1 (polar nokta (* pi 0.25) ts) n2 (polar nokta (* pi 0.75) ts) n3 (polar nokta (* pi 0.50) (* 1.00 ts)) n4 (polar nokta (* pi 0.50) (* 2.50 ts)) ) (setq n1 (polar nokta (* pi 1.25) ts) n2 (polar nokta (* pi 1.75) ts) n3 (polar nokta (* pi 1.50) (* 2.00 ts)) n4 (polar nokta (* pi 1.50) (* 2.50 ts)) ) ) (setvar "osmode" 0) (command "pline" nokta n1 n2 "c") (command "change" "l" "" "p" "c" "1" "") (command "text" "c" n3 ts 0 kot) (if (> (cadr dogrultu) noky) (command "text" "ml" n4 ts 90 mesa) (command "text" "mr" n4 ts 90 mesa) ) (command "change" "l" "" "p" "c" "1" "") (setvar "osmode" oosm) (setq nokta (getpoint "\yeni nokta seçiniz...")) ) (command "undo" "e") (prin1) ) arkadaşlar bu lispte yazı boyutunu ben kendim ayarlamak istiyorum biraz kurcaladım ama yapamadım yardımlarınızı bekliyorum ProhibiT (24.03.2011 22:00 GMT) |
 ProhibiT
|
|
Fonksiyonda hiç bir değişiklik yapmadan, istediğiniz yükseklikte yazı yazdırabilirsiniz. bunun için, önce text ya da dtext ile istediğiniz yüksekliğine sahip bir yazı yazın, sonra bu yazdığınız yazıyı silin. son yazdığınız yazının yüksekliğini fonksiyon hatırlayacak ve yazıları aynı yükseklikte yazacaktır.
Bu size zor geliyorsa, yazı yüksekliğini sorarak işlem yapacak hali; Kod: ; bu program M.Ş. Güvercin tarafından ;;; mehmet yangın için hazırlanmıştır. ;;; 08.12.2009 22:10 (defun c:kk () (command "undo" "group") (setvar "cmdecho" 0) (setq oosm (getvar "osmode") eksen (car (entsel "\neksen çizgisini seçiniz..."))) (if (not (setq ts (getreal "\n yazı yüksekliği: "))) (setq ts (getvar "textsize"))) (while (/= "LINE" (cdr (assoc 0 (entget eksen)))) (setq eksen (car (entsel "\neksen çizgisini seçiniz...")))) (setq mesor (cadr (assoc 10 (entget eksen))) kotor (cadr (getpoint "\nreferans kot noktasını seçiniz...")) refko (getreal "\nreferans kot değerini giriniz: ") nokta (getpoint "\yeni nokta seçiniz...")) (while nokta (setq nokx (car nokta) noky (cadr nokta) mesa (rtos (abs (- mesor nokx)) 2 3) kot (rtos (+ refko (- noky kotor)) 2 3) dogrultu (getpoint "\nyazıların yerini seçiniz...")) (if (= (atof kot) 0) (setq kot (strcat "%%p" kot))) (setq uz (strlen kot) sr 1) (while (and (< sr uz) (/= (substr kot sr 1) ".")) (setq sr (1+ sr))) (setq yer (- uz sr) frk (- 3 yer)) (if (= yer 0) (setq kot (strcat kot "."))) (while (> frk 0) (setq kot (strcat kot "0") frk (1- frk))) (setq uz (strlen mesa) sr 1) (while (and (< sr uz) (/= (substr mesa sr 1) ".")) (setq sr (1+ sr))) (setq yer (- uz sr) frk (- 3 yer)) (if (= yer 0) (setq mesa (strcat mesa "."))) (while (> frk 0) (setq mesa (strcat mesa "0") frk (1- frk))) (if (> (cadr dogrultu) noky) (setq n1 (polar nokta (* pi 0.25) ts) n2 (polar nokta (* pi 0.75) ts) n3 (polar nokta (* pi 0.50) (* 1.00 ts)) n4 (polar nokta (* pi 0.50) (* 2.50 ts))) (setq n1 (polar nokta (* pi 1.25) ts) n2 (polar nokta (* pi 1.75) ts) n3 (polar nokta (* pi 1.50) (* 2.00 ts)) n4 (polar nokta (* pi 1.50) (* 2.50 ts)))) (setvar "osmode" 0) (command "pline" nokta n1 n2 "c") (command "change" "l" "" "p" "c" "1" "") (command "text" "c" n3 ts 0 kot) (if (> (cadr dogrultu) noky) (command "text" "ml" n4 ts 90 mesa) (command "text" "mr" n4 ts 90 mesa)) (command "change" "l" "" "p" "c" "1" "") (setvar "osmode" oosm) (setq nokta (getpoint "\yeni nokta seçiniz..."))) (command "undo" "e") (prin1) ) Kolay gelsin.
|