Nokta kordinatlarını listeleme | Forumlar

AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim

aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A

Forumlar > AutoLISP Kodları > Nokta kordinatlarını listeleme

47799

30.03.2009 10:01

yazgunesi

Kod:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Nokta Koordinatlarını Listeleme Programı - NKT_KOOR.lsp
; www.autocadokulu.com (c) 2008 - Sinan COŞKUN
; "NOKTA" katmanında olan nokta objelerini X koordinatına göre sıralayıp listeler !
;
(defun tablo_ciz()
(setq dik_czg_uz (* kbs(* yzy 1.75)))
(setq 0dik_czg1(polar tbn 3.14159265(* yzy 2.5)))
(setq 0dik_czg2(polar 0dik_czg1 4.71238898 dik_czg_uz))
(setq 1dik_czg2(polar tbn 4.71238898 dik_czg_uz))
(setq 2dik_czg1(polar tbn 0 (* yzy 12.5)))
(setq 2dik_czg2(polar 2dik_czg1 4.71238898 dik_czg_uz))
(setq 3dik_czg1(polar tbn 0 (* yzy 25)))
(setq 3dik_czg2(polar 3dik_czg1 4.71238898 dik_czg_uz))

(command "line" 0dik_czg1 0dik_czg2 "")
(command "line" tbn 1dik_czg2 "")
(command "line" 2dik_czg1 2dik_czg2 "")
(command "line" 3dik_czg1 3dik_czg2 "")
(command "line" 0dik_czg1 0dik_czg2 "")
)

;;;;;;;;;;;;;;;
(defun c:koor()
(setvar "cmdecho" 0)
(setq eski_os(getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "group")
(setq nkt_lst(list))
(setq nths 0)
(setq bslk " ")
(prompt "\nKoordinat noktalarını seçiniz ! :")
(setq nkt_sec(ssget(list(cons 0 "POINT")(cons 8 "NOKTA"))))
(if(= nkt_sec nil)
(alert "\nSeçilen Obje(ler) arasında Nokta yok !")
(progn
(setq nkt_say (sslength nkt_sec))
(setq says 0)
(while(> nkt_say says)
(setq nkt_oku(cdr(assoc 10(entget(ssname nkt_sec says)))))
(setq nkt_x(rtos(car nkt_oku)))
(setq nkt_y(rtos(cadr nkt_oku)))
(setq nkt_z(rtos(caddr nkt_oku)))
(setq nkt_lst(append nkt_lst(list(strcat nkt_x"X"nkt_y"Y"nkt_z"Z"))))
(setq says(+ says 1))
);while sonu

(setq ynkt_lst(vl-sort nkt_lst '<))

(setq yzy(getreal(strcat"\nYazı yükseklği ? <"(rtos(getvar "textsize")2 2)">:")))
(if(= yzy nil)(setq yzy(getvar "textsize")))

(setq kbs(getint"\nKoordinat başlangıç Sayısı ? <1> :"))
(if(= kbs nil)(setq kbs 1))

(setq tbn(getpoint"\nTablo başlangıç Noktası ? :"))
(setq n_yzn tbn)
(command "line"(polar n_yzn 3.14159265(* yzy 2.5))(polar n_yzn 0(* yzy 25))"")

(repeat(length ynkt_lst)
(setq nkt_al(nth nths ynkt_lst))
(setq x_yer(vl-string-search "X" nkt_al))
(setq y_yer(vl-string-search "Y" nkt_al))
(setq z_yer(vl-string-search "Z" nkt_al))
(setq x_nkt(atof(substr nkt_al 1 x_yer)))
(setq y_nkt(atof(substr nkt_al(+ x_yer 2)(- y_yer x_yer 1))))
(setq z_nkt(atof(substr nkt_al(+ y_yer 2)(- z_yer y_yer 1))))

(setq kyzn(list x_nkt y_nkt z_nkt))

(setq x_al(rtos x_nkt))
(setq y_al(rtos y_nkt))
(setq z_al(rtos z_nkt))

(setq n_yzn(polar n_yzn 4.71238898(* yzy 1.75)))
(setq X_yzn(polar n_yzn 0(* yzy 12.5)))
(setq Y_yzn(polar n_yzn 0(* yzy 25)))
(command "text" kyzn yzy "" (itoa kbs)); nokta üzerinde ki numaralar
(command "text" "J" "R" n_yzn yzy "" (strcat(itoa kbs)))
(command "text" "J" "R" X_yzn yzy "" x_al)
(command "text" "J" "R" Y_yzn yzy "" y_al)
(command "line"(polar n_yzn 3.14159265(* yzy 2.5))Y_yzn "")
(setq nths(+ nths 1))
(setq kbs(+ kbs 1))
);repeat sonu
(tablo_ciz)
); progn sonu
);if sonu

(setvar "osmode" eski_os)
(command "undo" "e")
(princ)
)

Bu lispler ile ilgili detaylı bilgi forum sayfasında mevcuttur:

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

70436

12.11.2012 16:26

memitanli

Öncelikle lispi yazana sonsuz teşekkürler.
arkadaşlar bu lispin kısa yolunu bilen varmı. Varsa bileniniz yazarsanız çok güzel olur

70437

12.11.2012 16:54

Travaci

Koor

78952

30.10.2014 13:15

ademm57

KLS LSİP İ LAZIM ÇOK ACİL OLANLAR VARSA e-mail yasak maile atabilirmi

ProhibiT (31.10.2014 04:34 GMT)

78953

30.10.2014 13:55

özkan-wien

Camasirmi yikiyor napiyo bu Lisp. Yazsan yardimci oluruz. Nedir bu "KLS"?

78955

30.10.2014 14:51

ademm57

lisp buradan aldım bi yıl önce ama bende ki özelliğini kayubetmiş hata veriyor xy listesi vermiyo ekrana yapıştırması lazım

78956

30.10.2014 14:52

ademm57

kls lisp i idi şimdi bakıyorum kimsede bu sayfalarda ve sitede yok

78957

30.10.2014 14:56

ademm57

projeden noktalar ve kordinatlar oluşturmaya yarıyor

78958

30.10.2014 15:02

ademm57

video yu izle yin ne yaptını çok iyi anlarsınız

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

ProhibiT (31.10.2014 04:39 GMT)

78963

30.10.2014 16:22

özkan-wien

Ademcim "KLS" o lispi yazan kisinin o anki ruh haline göre ya da bir sistmatige göre (ben genelde fonksiyonun bas harflerini alirim) olusturulmus olan programi calistiran kisaltmadir. Yani programin ne ise yaradigina dair cok ipucu vermez.
Yani bana "sari cizmeli Mehmet agayi bulun" demek gibi biseydir.
Sen elindeki lispi buraya bi yapistir neresi calismiyomus ona bakalim.

Ya da yukaridaki lispi iyi oku. Noktalarini "nokta" isimli layerda ve "Point" olarak olusturup dene.

78966

31.10.2014 05:58

ademm57

(defun nokkntr ()
(if (= nok_kt nil)
(alert "\nPointstyle ayarınızı kontrol etmeyi unutmayın:"))
(setq nok_kt t))

(defun c:kls ()
(nokkntr)
(setvar "modemacro" "Arcme Design")
(setvar "cmdecho" 0)
(setq kls_basno (getint "\nBaşlangıç numarası:"))
(if (= kls_basno nil)
(progn
)
(progn
(setq kls_yyybsno kls_basno)
(setq kls_os (getvar "osmode"))
(if (= kls_yyuk nil)
(setq kls_yyuk 10))
(setq kls_yy (getreal (strcat "\nYazı Yüksekliği :< " (rtos kls_yyuk 2 1) " >:")))
(if (= kls_yy nil)
(setq kls_yy kls_yyuk))
(setq kls_yyuk kls_yy)
(setq kls_nil nil)
(setq kls_dosyaac (open "C:\\windows\\kls.txt" "w"))
(setq kls_noksay 0)
(setq kls_yazi_ara (tblsearch "style" "kls_yazi"))

(if (= kls_yazi_ara nil)
(progn
(command "style" "kls_yazi" "arial.ttf" "0""""""""")
))
(setq kls_yazi_ara_yuk (cdr (assoc 40 kls_yazi_ara)))
(if (/= kls_yazi_ara_yuk 0.0)
;(setq kls_yazi_ara (subst (cons 40 0)(assoc 40 kls_yazi_ara) kls_yazi_ara))
; (entmod kls_yazi_ara)
(command "style" "kls_yazi" "" "0""""""""")
)
(while (= kls_nil nil)
(setq kls_nok (getpoint "\nNoktayı Gösterin:"))
(if (/= kls_nok nil)
(progn
(setq kls_nokx (car kls_nok)
kls_noky (cadr kls_nok))

(setq kls_yyerx (+ kls_nokx (/ kls_yyuk 2.0))
kls_yyer (list kls_yyerx kls_noky))
(setvar "osmode" 0)
(command "point" kls_nok)
(command "text" "j" "ml" kls_yyer kls_yyuk "0" kls_basno)
(write-line (rtos kls_nokx) kls_dosyaac)
(write-line (rtos kls_noky) kls_dosyaac)
(setq kls_noksay (+ kls_noksay 1))
(setq kls_basno (+ kls_basno 1))
(setq kls_nil nil)
(setvar "osmode" kls_os)
)
(progn
(close kls_dosyaac)
(setq kls_1 nil)
(while (= kls_1 nil)
(setq kls_tablonok (getpoint "\nTablo için referans nokta gösterin:"))
(if (= kls_tablonok nil)
(progn
(setq kls_1 nil))
(progn
(setq kls_tablonokx (car kls_tablonok)
kls_tablonoky (cadr kls_tablonok))
(setvar "osmode" 0)
(command "line" kls_tablonok (strcat "@" (rtos (* 35 kls_yyuk))"<0")
(strcat "@" (rtos (* (* kls_yyuk 2.0) (+ kls_noksay 1))) "<270")
(strcat "@" (rtos (* 35 kls_yyuk))"<180") "c")
(setq kls_tab1x (+ kls_tablonokx (* kls_yyuk 3.0))
kls_tab1 (list kls_tab1x kls_tablonoky)
kls_tab2x (+ kls_tablonokx (* kls_yyuk 19.0))
kls_tab2 (list kls_tab2x kls_tablonoky)
)
(command "line" kls_tab1 (strcat "@" (rtos (* (* kls_yyuk 2.0) (+ kls_noksay 1))) "<270") "")
(command "line" kls_tab2 (strcat "@" (rtos (* (* kls_yyuk 2.0) (+ kls_noksay 1))) "<270") "")

(setq kls_tab3 kls_tablonok)
(repeat kls_noksay
(setq kls_tab3x (car kls_tab3)
kls_tab3y (- (cadr kls_tab3)(* kls_yyuk 2.0))
kls_tab3 (list kls_tab3x kls_tab3y))
(command "line" kls_tab3 (strcat "@" (rtos (* 35 kls_yyuk))"<0") ""))
(setq kls_yaz1 kls_tablonok)
(setq kls_yaz1x (+ (car kls_yaz1)(* 1.5 kls_yyuk))
kls_yaz1y (- (cadr kls_yaz1)(* 3 kls_yyuk))
kls_yaz1 (list kls_yaz1x kls_yaz1y))
(setq kls_yty kls_yyybsno)
(repeat kls_noksay
(command "text" "j" "mc" kls_yaz1 kls_yyuk "0" kls_yty)
(setq kls_yaz1y (- (cadr kls_yaz1) (* 2 kls_yyuk))
kls_yaz1 (list (car kls_yaz1)kls_yaz1y))
(setq kls_yty (+ kls_yty 1)))
(setq kls_x_yaz kls_tablonok)
(setq kls_x_yazx (+ (car kls_tablonok)(* 11 kls_yyuk))
kls_x_yazy (- (cadr kls_tablonok)(* 3 kls_yyuk))
kls_x_yaz (list kls_x_yazx kls_x_yazy))
(setq kls_y_yazx (+ (car kls_tablonok)(* 27 kls_yyuk))
kls_y_yazy (- (cadr kls_tablonok)(* 3 kls_yyuk))
kls_y_yaz (list kls_y_yazx kls_y_yazy))
(setq kls_xx_yazx (+ (car kls_tablonok)(* 11 kls_yyuk))
kls_xx_yazy (- (cadr kls_tablonok) kls_yyuk)
kls_xx_yaz (list kls_xx_yazx kls_xx_yazy))
(setq kls_yy_yazx (+ (car kls_tablonok)(* 27 kls_yyuk))
kls_yy_yazy (- (cadr kls_tablonok)kls_yyuk)
kls_yy_yaz (list kls_yy_yazx kls_yy_yazy))
(command "text" "j" "mc" kls_xx_yaz kls_yyuk "0" "X")
(command "text" "j" "mc" kls_yy_yaz kls_yyuk "0" "Y")
(setq kls_oku_dac (open "c:\\windows\\kls.txt" "r"))
(repeat (* kls_noksay 2)
(setq kls_oku_x (read-line kls_oku_dac))
(command "text" "j" "mc" kls_x_yaz kls_yyuk "0" kls_oku_x)
(setq kls_oku_y (read-line kls_oku_dac))
(command "text" "j" "mc" kls_y_yaz kls_yyuk "0" kls_oku_y)
(setq kls_x_yazy (- (cadr kls_x_yaz) (* 2 kls_yyuk))
kls_x_yaz (list kls_x_yazx kls_x_yazy))
(setq kls_y_yazy (- (cadr kls_y_yaz) (* 2 kls_yyuk))
kls_y_yaz (list kls_y_yazx kls_y_yazy))
)))
(setq kls_1 t)(setq kls_nil t)
))))))
(setvar "osmode" kls_os)
(close kls_oku_dac)
(princ))

78967

31.10.2014 06:00

ademm57

bu hatayı veriyo tabloyu vermesi gerekirken :; error: bad argument type: streamp nil

ademm57 (31.10.2014 06:35 GMT)

78968

31.10.2014 08:42

özkan-wien

senin lisple yukaridaki Lisp ayni isi yapiyor. SAdece noktalarini koyarken "nokta" layerinda "Point" objesi olarak yerlestir tek fark o. Zaten bu lispi de Ehya yazmis galiba.

özkan-wien (31.10.2014 09:19 GMT)

78971

31.10.2014 09:41

Travaci

özkan-wien

Ehya dır ehyadır, bukadar uzun değişken ismi bir sen birde o veriyor : )

ademm57

(setq kls_dosyaac (open "C:\\windows\\kls.txt" "w"))
Windows a text dosyası açıyor, yeterli erişim yetkisi yoksa bundan dolayı hata veriyor olsa gerek ; )

78973

31.10.2014 11:33

ademm57

özkan-wien
(setq kls_dosyaac (open "C:\\windows\\kls.txt" "w"))
Windows a text dosyası açıyor, yeterli erişim yetkisi yoksa bundan dolayı hata veriyor olsa gerek ; )
BUNU NASIL DÜZELTECEĞİM

78974

31.10.2014 12:02

Travaci

ademm57

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

78975

31.10.2014 12:12

ademm57

allah razı olsun çözüldü

> 1 <


	Forum	Download	Galeri	Üye Ol \| Giriş