mahal listeleyen lisp | Forumlar

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 457, Üye: 1
ozkul

Detaylar »

Forumlar > AutoLISP > mahal listeleyen lisp

Bu başlığı inceleyenler : 1 ziyaretçi, 0 üye : ---

İleti	Yazar
09.02.2011 15:53 62598	yasmgan Silver üye 2 ileti mimar tripoli
Arkadaşlar selam, Attribute olarak hazırlanmış mahal no,isim ve metrekaresini tablo halinde yazdırmaya yardımcı olan lisp varmı?Şimdiden teşekkürler

09.02.2011 17:03 62599	miyatu Kıdemli Uzman 142 ileti Tekniker ISTANBUL
Attrıbute nin bir örneğini paylaşırsan yardımcı olmaya calısırım. daha önce benzerinin verildiğini hatırlıyorum... lisp sizden örnek bir, attribute içeren block secmenizi ister benzer butun blockları secer, inceler ve sonucu dosyanızın bulundugu klasörün içine, dosyanızla aynı isimde bir dosyaya yazar. prohibit hocamızada katkılarından dolayı tesekkur ederiz. kolay gelsin... Kod: ;************************************************************************************************ ; attribute den bilgi okuma (defun att_oku (#entity) ;burası hakkında bigün açıklama yaparım inş. :):) (setq #key 1;key degeri assoc degeridir... #0 (cdr (assoc 0 (entget #entity))) #66 (cdr (assoc 66 (entget #entity))) #icliste (list) ) (if (and (= #0 (strcase "insert")) (= #66 1)) (progn (setq #entity (entnext #entity) #0 (cdr (assoc 0 (entget #entity))) #66 (cdr (assoc 66 (entget #entity))) ) (while (or (= #0 (strcase "attrib")) (= #66 1)) (setq #1 (list (strcat ";"(cdr (assoc #key (entget #entity))))) #icliste (append #icliste #1) #entity (entnext #entity) #0 (cdr (assoc 0 (entget #entity))) #66 (cdr (assoc 66 (entget #entity))) ) ) ) ) (setq #data #icliste) ) ; ;********************************************************************************************** ;********************************************************************************************** ; dosya yolu ve adı olustur (defun dosya_adi (#uzanti) ;drawing in bulundugu klasörün öğrenilmesi (strcat (getvar "dwgprefix") ;drawing adının öğrenilmesi ve ve dosya uzantısı ile birleştirilmesi (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3) ) #uzanti ) ) ; ;********************************************************************************************** ;********************************************************************************************** ; filtreli tek nesne secimi (defun ssget_ (#tur) ;sartlı nesne seçimi şart:secilen nesnenin attrıbute içeren bir block olması (while (not (setq #prohibit (ssget ":s" (list (cons 0 #tur)(cons 66 1))))) ) ;secim listesinden ilk elemanın alınması (setq #prohibit (ssname #prohibit 0)) ) ; ;********************************************************************************************** ;********************************************************************************************** ; ana fonksiyon (defun c:lst () (setq yazi "") ;dosya adını ve yolunu olusturan fonksiyonun tetiklenmesive dosyanın acılması (setq f (open (dosya_adi "csv") "a")) ;kullanıcıya mesajın gönderilmesi (prompt "\nörnek block u seciniz:") ;kullanıcıya block un sectirilecegi fonksiyonun tetiklenmesi (setq ornek (ssget_ (strcase "insert")) ;seçilen block un adının ögrenilmesi block_adi (cdr (assoc 2 (entget ornek))) ;aynı isimli blockların secilmesi tum_blk (ssget "x" (list (cons 2 block_adi))) ;son seçilen block ların sayısı nesne_sayisi (- (sslength tum_blk) 1) ) ;while dongusu (her block un tektek incelenmesi) (while (> nesne_sayisi 0) ;listedeki nesnelerin sondan basa dogru cagrılması (setq liste (ssname tum_blk nesne_sayisi)) ;attributeden bilgiyi okuyan fonksiyonun tetiklenmesi (setq liman (att_oku liste)) ;att_oku fonksiyonunda olusan listenin eleman sayısının ögrenilmesi (setq eleman (length liman)) ;repeat dongusu (liste elemanlarının yazım için hazırlanması) (repeat eleman (setq eleman (- eleman 1)) ;listeden alınan elemanların birleştirilmesi (setq yazi (strcat yazi (nth eleman liman))) ) ;olusturulan satırın dosyaya yazılması (write-line yazi f) (setq nesne_sayisi (- nesne_sayisi 1)) ;yazı değişkeninin boşaltılması (setq yazi "") ) ;dosyanın kapatılması (close f) ;beni ön plana cıkaran mesajın command satırına yazdırılması :):) (princ "\nmiyatu tool kullanıldı...") ;son degerin tekrarlanmasının önlenmesi (nil vb.) (princ) ) ; ;************************************************************************************************ (princ "attribute içeriğini excel e aktaran lisp yuklendi [lst]...") ProhibiT (17.03.2012 18:12 GMT) Kendini gelistirmeyen insanlar, bildiklerini paylasmaya korkarlar...

07.09.2011 16:16 65684	sagliko Girişimci 4 ileti inşaat müh istanbul
Malesef örnek blok seçiminde hiç bir blogu secemiyorum

17.02.2012 14:59 67953	gzhnrsln Yeni üye 3 ileti mimar eskişehir
evet arkadaşlar bu lispi güncelleyebilecek birisi varmı bende de çalışmıyor. mahal adı : asfasf mahal no : 412343 alan: 523.32 gibi bi attribute olıuşturdum mesela projemdeki tüm attributleri mahal adı mahal no ve alan şeklide listelyen bi lisp varmı ??? şimdiden teşekkürler herkese...

21.02.2012 08:49 68030	gzhnrsln Yeni üye 3 ileti mimar eskişehir
Yardım edecek birileri yokmu kod çalışmıyor bende. Koddamı hata var yoksa AutoCAD sürümüyle alakalı birşey mi... ProhibiT (21.02.2012 11:32 GMT)

21.02.2012 11:29 68031	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Arkadaşlar, lütfen mesajınızın tamamını büyük harfle ya da kalın harflerle yazmayınız. Paylaşılan bir kod ile ilgili soru sorarken de, derdinizi kısa ama yeterince detaylı, net bir şekilde ifade etmelisiniz. "Malesef örnek blok seçiminde hiç bir blogu seçemiyorum" veya "evet arkadaşlar bu lispi güncelleyebilecek birisi varmı bende de çalışmıyor." şeklindeki ifadeler, paylaşımı yapan ya da yardımcı olabilecek arkadaşımıza hiç bir ipucu vermiyor. "kod çalışmıyor!" derken neyi kastediyoruz? Fonksiyon hiç mi yüklenemiyor? Yoksa çalıştırılmak için çağrıldığında mı bir hata veriyor? Verdiği hata mesajı tam olarak nedir? Siz derdinizi net olarak açıklamadıkça, birilerinin yaşadığınız problemin ne olduğunu tahmin ederek çözmeye çalışıp, çözüm yolu göstermesini beklememeliyiz... (strcase "ınsert") -> "ıNSERT", (strcase "attrıb")-> "ATTRıB" dönecektir. Yaşanan hata bundan kaynaklanıyor diye tahmnin ediyorum. Paylaşılan kod içinde, 2 yerdeki "ınsert" ifadesini "insert", 1 yerdeki "attrıb" ifadesini "attrib" olarak değiştirirseniz fonksiyonunuz büyük ihtimalle çalışacaktır. Beğenmek için anlamak lazım...

17.03.2012 10:27 68265	gzhnrsln Yeni üye 3 ileti mimar eskişehir
uyarın için teşekkürler. lispi çalıştırdım blok seçin diyor fakat att blogu veya normal blok başka birşeyi dahi seçemiyorum. sorunum bu.

17.03.2012 18:15 68269	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
miyatu arkadaşımız 401 gün önce son düzenlemeyi yapmış. Önceki mesajımda bahsettiğim kod içindeki ı harfleriyle ilgili düzenlemeyi doğru yapamadığınız için problem yaşadığınızı düşünüyorum. Sizin adınıza düzenlemeyi yapıp miyatu arkadaşımızın kodlarını güncelledim. Kodları buradan tekrar alıp deneyin. Eğer gene olmazsa, aşağıdaki fonksiyonu deneyin. Kod: ;\|===========================================================================\| \| mH2Ex: Seçilen Mahal bLock'u içindeki attribute'lerin değerlerini, \| \| çizim içindeki tüm mahal bLock'ları için listeleyerek Excel dosyasına \| \| Yazar. Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com \| \|___________________________________________________________________________\|; (princ "\nAuthor: M. Şahin Güvercin - www.autocadokulu.com - ") ;\|___________________________________________________________________________\|; (defun C:mH2Ex (/ error f bLck bLckS Atr AtrS TtLs n m sTr PvT) (setvar "cmdecho" 0) (command "undo" "group") (defun error (er) (close f) (princ (strcat "\n" er))(command "_.undo" "e")) (princ "\nMahal Attribute'leri için örnek bir bLock seçiniz: ") (while (not (setq bLck (ssget ":s" (list (cons 0 "INSERT")))))) (setq f (open (getfiled (getvar "dwgprefix") (vl-string-right-trim ".dwg" (getvar "dwgname")) "xLs" 9) "w") bLck (tblobjname "bLock" (cdr (assoc 2 (entget (ssname bLck 0))))) bLckS (ssget "x" (list (cons 0 "INSERT") (assoc 2 (entget bLck)))) Atr bLck AtrS nil TtLs nil n (sslength bLckS)) (while (setq Atr (entnext Atr)) (if (= (cdr (assoc 0 (entget Atr))) "ATTDEF") (setq TtLs (append (list (cdr (assoc 3 (entget Atr)))) TtLs) AtrS (append (list (cdr (assoc 2 (entget Atr)))) AtrS)))) (setq sTr (nth (setq m 0) TtLs)) (while (< (setq m (1+ m)) (length TtLs)) (setq sTr (strcat sTr "\t" (nth m TtLs)))) (write-line sTr f) (while (not (minusp (setq n (1- n)))) (setq PvT (ssname bLckS n) sTr nil) (while (/= (cdr (assoc 0 (entget (setq PvT (entnext PvT))))) "SEQEND") (if (= (cdr (assoc 0 (entget PvT))) "ATTRIB") (if (vl-position (cdr (assoc 2 (entget PvT))) AtrS) (if (not sTr) (setq sTr (cdr (assoc 1 (entget PvT)))) (setq sTr (strcat (cdr (assoc 1 (entget PvT))) "\t" sTr)))))) (write-line sTr f)) (close f) (command "undo" "e") (prin1)) ;\|___________________________________________________________________________\|; Beğenmek için anlamak lazım...

04.12.2013 09:28 75286	asvm44 Girişimci 1 ileti inşaat mühendisi istanbul
Arkadaşlar Merhaba ; birkaç farklı text i aynı anda aratıp bulabileceğimiz bir lisp varmıdır. örneğin ; hol,mutfak,wc,lavabo kelimelerini bir seferde aratıp bulabileceğimiz bir lisp varmı ilginize teşekkürler...

04.12.2013 09:41 75287	ehya Yönetici 3554 ileti Teknik Ressam Ankara
asvm44 lispe ne gerek var. Filter komutu ile bu istediğinizi yapabilirsiniz. ehya (04.12.2013 09:49 GMT)

17.03.2014 22:01 76414	dmzkn Girişimci 4 ileti inş.müh. bursa
merhaba, benim bir ricam olucak.. yukarıda verilen lisp gerçekten çok iyi.. fakat hazır attribute değilde var olan projeden metraj çıkartmak için veya projeye mahal listesi oluşturmak için şu şekilde revize edilebilir mi .. şöyleki ; 1- projedeki tüm mahaller polyline olarak sınırlandırmış iken ( manuel olarak kullanıcı tarafından önceden yapılmış) 2-lisp çalıştırıldığından önce mahal no yu soracak ister command satırına istenirse çizimde yazılı text hedef gösterilerek 3-sonra mahal adını soracak ister command satırına istenirse çizimde yazılı text hedef gösterilerek 4-sonra döşeme kaplamasını soracak ister command satırına istenirse çizimde yazılı text hedef gösterilerek 5-sonra duvar kaplamasını soracak ister command satırına istenirse çizimde yazılı text hedef gösterilerek 6-sonra tavan kaplamasını soracak ister command satırına istenirse çizimde yazılı text hedef gösterilerek 7- son olarakta mahali sınırlandıran polyline'ı seçmemizi isteyecek ( alan ve çevresi için) 8- sonra mahal içerisinde bu bilgileri ( mahal no, mahal adı, döşeme kaplaması,duvar kaplaması, tavan kaplaması, alanı ve çevresi) tablo haline yazacak hedef gösterilecek ve tablo oraya yerleştirilecek 9-lisp kapanmadan diger mahalin aynı şekilde bilgilerini isteyecek.. 10- mahaller tamamlanınca hedef gösterilecek yere tablo halinde mahallerin bu bilgilerini liste halinde tablo yapacak forumda bu anlattıklarımın tamamını yapan ayrı ayrı lisp ler var ama bir türlü biraraya getirip derleyemedim.. derleyecek mükemmel adamlar var burda.. bu şekilde yardım ederlerse mükemmel bir hayratı olur insanlara.. forumda bulunan şu lisp anlattığım şekilde revize edilmeye çok müsait. şöyleki; Kod: ;;;Prepared by: M. Şahin Güvercin 27.04.2011 - Ankara (write-line "\nHazırlayan, M. Şahin Güvercin - www.autocadokulu.com") (defun c:MpLgn (/ PLgns M o aLns cvRs PoLigon alan cevr ln yr noks Xx Yy pLNo n cen Lx Ly L mrk nk0 nk1 nk2 nk3 nk4 nk5 nk6 nk7 nk8 nk9 nk10 nk11 nk12 nk13 Nno uznlk TArea TPeri) (setvar "cmdecho" 0) (command "undo" "group") (setvar "modemacro" "Prepared by: M.S Güvercin") (setq da (* 1.5 pi)) (if (not txh) (setq txh (* (getvar "dimscale") (getvar "dimtxt")))) (if (setq tx (getreal (strcat "\Yazı Yüksekliği'ni giriniz <" (rtos txh) "> : "))) (setq txh tx)) (princ "\nPoligonları seçiniz...") (setq PLgns (ssget (list (cons 0 "LwpoLyLine"))) M (sslength PLgns) o -1 aLns nil cvRs nil) (while (< (setq o (1+ o)) M) (setq PoLigon (entget (ssname PLgns o))) (command "_Area" "e" (cdr (assoc -1 PoLigon))) (setq alan (rtos (getvar "area") 2 2) cevr (rtos (getvar "perimeter") 2 2) ln (strlen alan) yr (vl-string-position 46 alan) alan (cond ((= yr 0) (strcat "0" alan)) ((= yr nil) (strcat alan ".00")) ((= (- ln yr) 2) (strcat alan "0")) (T alan))) (setq ln (strlen cevr) yr (vl-string-position 46 cevr) cevr (cond ((= yr 0) (strcat "0" cevr)) ((= yr nil) (strcat cevr ".00")) ((= (- ln yr) 2) (strcat cevr "0")) (T cevr)) noks nil) (while (assoc 10 PoLigon) (setq Noks (append Noks (list (cdr (assoc 10 PoLigon)))) PoLigon (vl-remove (assoc 10 PoLigon) PoLigon))) (if (> M 1) (progn (if (< o 10) (setq Xx 0 Yy 0 pLNo (strcat "PoLigon-0" (itoa (1+ o))) n -1) (setq Xx 0 Yy 0 pLNo (strcat "PoLigon-" (itoa (1+ o))) n -1)) (while (< (setq n (1+ n)) (length noks)) (setq Xx (+ Xx (car (nth n Noks))) Yy (+ Yy (cadr (nth n Noks))))) (setq cen (list (/ Xx (length noks)) (/ Yy (length noks))) aLns (append aLns (list alan)) cvRs (append cvRs (list cevr))) (entmake (list (cons 0 "TEXT") (cons 10 cen) (cons 40 txh) (cons 1 pLNo) (cons 50 0) (cons 71 0) (cons 72 4) (cons 11 cen))) (setq Lx (* txh 26.25) Ly (* txh (/ (* 3 (+ (length Noks) 4)) 2.0)))) (setq Lx (* txh 26.25) Ly (* txh (/ (* 3 (+ (length Noks) 3)) 2.0)))) (setq L (length Noks) n -1) (command "_.zoom" "o" (cdr (assoc -1 PoLigon)) "") (command "_.zoom" "0.75x") (while (/= 3 (car (setq mrk (grread T 4 1)))) (setq mrk (cadr mrk)) (redraw) (setq nk1 (list (- (car mrk) Lx) (+ (cadr mrk) Ly)) nk2 (list (- (car mrk) Lx) (- (cadr mrk) Ly)) nk3 (list (+ (car mrk) Lx) (- (cadr mrk) Ly)) nk4 (list (+ (car mrk) Lx) (+ (cadr mrk) Ly))) (grdraw nk1 nk2 7) (grdraw nk2 nk3 7) (grdraw nk3 nk4 7) (grdraw nk4 nk1 7)) (redraw) (setq nk5 (polar nk1 0 (* 7.5 txh)) nk6 (polar nk5 0 (* 15.0 txh)) nk7 (polar nk6 0 (* 15.0 txh)) nk8 (polar nk1 0 (* 1.5 txh)) nk9 (polar nk5 0 (* 7.5 txh)) nk10 (polar nk6 0 (* 7.5 txh)) nk11 (polar nk7 0 (* 1.5 txh)) nk12 (polar nk5 0 (* 1.5 txh)) nk13 (polar nk6 0 (* 1.5 txh))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.0) (cons 38 0.0) (cons 39 0.0) (cons 10 nk1) (cons 10 nk2) (cons 10 nk3) (cons 10 nk4))) (if (> M 1) (progn (setq nk0 (polar (list (/ (+ (car nk1) (car nk4)) 2.0) (cadr nk8)) da (* 2 txh))) (entmake (list (cons 0 "TEXT") (cons 10 nk0) (cons 40 txh) (cons 1 pLNo) (cons 50 0) (cons 71 0) (cons 72 1) (cons 11 nk0))) (entmake (list (cons 0 "LINE") (cons 10 (polar nk1 da (* 3 txh))) (cons 11 (polar nk4 da (* 3 txh))))) (setq nk1 (polar nk1 da (* 3 txh)) nk4 (polar nk4 da (* 3 txh)) nk5 (polar nk5 da (* 3 txh)) nk6 (polar nk6 da (* 3 txh)) nk7 (polar nk7 da (* 3 txh)) nk8 (polar nk8 da (* 3 txh)) nk9 (polar nk9 da (* 3 txh)) nk10 (polar nk10 da (* 3 txh)) nk11 (polar nk11 da (* 3 txh)) nk12 (polar nk12 da (* 3 txh)) nk13 (polar nk13 da (* 3 txh))))) (entmake (list (cons 0 "LINE") (cons 10 (polar nk1 da (* 3 txh))) (cons 11 (polar nk4 da (* 3 txh))))) (entmake (list (cons 0 "LINE") (cons 10 nk5) (cons 11 (polar nk5 da (* (+ L 2) 3 txh))))) (entmake (list (cons 0 "LINE") (cons 10 nk6) (cons 11 (polar nk6 da (* (+ L 3) 3 txh))))) (entmake (list (cons 0 "LINE") (cons 10 nk7) (cons 11 (polar nk7 da (* (+ L 2) 3 txh))))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk8 da (* 2 txh))) (cons 40 txh) (cons 1 "NOKTA") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk9 da (* 2 txh))) (cons 40 txh) (cons 1 "X") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk10 da (* 2 txh))) (cons 40 txh) (cons 1 "Y") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk11 da (* 2 txh))) (cons 40 txh) (cons 1 "UZUNLUK") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk8 da (* (+ (* (+ L 2) 3) 2) txh))) (cons 40 txh) (cons 1 (strcat "ALAN: " alan)) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 (polar nk13 da (* (+ (* (+ L 2) 3) 2) txh))) (cons 40 txh) (cons 1 (strcat "T. UZUNLUK: " cevr)) (cons 50 0) (cons 72 0))) (setq nk8 (polar nk8 0 (* 2.0 txh)) n -1) (while (< (setq n (1+ n)) L) (setq Nno (1+ n) nokta (nth n Noks) X (rtos (car nokta) 2 2) Y (rtos (cadr nokta) 2 2) nk14 (polar nk8 da (* (+ (* Nno 3) 2) txh)) nk15 (polar nk14 0 (* 5.5 txh)) nk16 (polar nk15 0 (* 15.0 txh)) nk17 (polar nk11 da (* (+ (+ (* Nno 3) 2) 1.5) txh)) nk18 (polar nk1 da (* (* (+ Nno 1) 3) txh)) nk19 (polar nk7 da (* (* (+ Nno 1) 3) txh)) nk20 (polar nk19 da (* 1.5 txh)) nk21 (polar nk20 0 (* 15 txh))) (entmake (list (cons 0 "TEXT") (cons 10 nokta) (cons 40 txh) (cons 1 (itoa Nno)) (cons 72 4) (cons 11 nokta))) (entmake (list (cons 0 "CIRCLE") (cons 10 nokta) (cons 40 (* 1.15 txh)))) (entmake (list (cons 0 "TEXT") (cons 10 nk14) (cons 40 txh) (cons 1 (itoa nno)) (cons 50 0) (cons 71 0) (cons 72 0))) (setq ln (strlen X) yr (vl-string-position 46 X) X (cond ((= yr 0) (strcat "0" X)) ((= yr nil) (strcat X ".00")) ((= (- ln yr) 2) (setq X (strcat X "0"))) (T X)) ln (strlen Y) yr (vl-string-position 46 Y) Y (cond ((= yr 0) (strcat "0" Y)) ((= yr nil) (strcat Y ".00")) ((= (- ln yr) 2) (strcat Y "0")) (T Y))) (entmake (list (cons 0 "TEXT") (cons 10 nk15) (cons 40 txh) (cons 1 X) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk16) (cons 40 txh) (cons 1 y) (cons 50 0) (cons 71 0) (cons 72 0))) (if (= n (1- L)) (setq uznlk (rtos (distance nokta (nth 0 Noks)) 2 2)) (setq uznlk (rtos (distance nokta (nth (1+ n) Noks)) 2 2))) (setq ln (strlen uznlk) yr (vl-string-position 46 uznlk) uznlk (cond ((= yr 0) (strcat "0" uznlk)) ((= yr nil) (strcat uznlk ".00")) ((= (- ln yr) 2) (strcat uznlk "0")) (T uznlk))) (if (= n (1- L)) (setq uznlk (strcat (itoa Nno) "-" "1=" uznlk)) (setq uznlk (strcat (itoa Nno) "-" (itoa (1+ Nno)) "=" uznlk))) (entmake (list (cons 0 "TEXT") (cons 10 nk17) (cons 40 txh) (cons 1 uznlk) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "LINE") (cons 10 nk18) (cons 11 nk19))) (if (/= n (1- L)) (entmake (list (cons 0 "LINE") (cons 10 nk20) (cons 11 nk21))))) (entmake (list (cons 0 "LINE") (cons 10 (polar nk1 da (* (+ L 2) 3 txh))) (cons 11 (polar nk4 da (* (+ L 2) 3 txh)))))) (if (> M 1) (progn (setq L (length aLns) Lx (* txh 22.50) Ly (* txh (/ (* 3 (+ L 3)) 2.0)) n -1 dy (list 0.0 (* 3 txh))) (while (/= 3 (car (setq mrk (grread T 4 1)))) (setq mrk (cadr mrk)) (redraw) (setq nk1 (list (- (car mrk) Lx) (+ (cadr mrk) Ly)) nk2 (list (- (car mrk) Lx) (- (cadr mrk) Ly)) nk3 (list (+ (car mrk) Lx) (- (cadr mrk) Ly)) nk4 (list (+ (car mrk) Lx) (+ (cadr mrk) Ly))) (grdraw nk1 nk2 7) (grdraw nk2 nk3 7) (grdraw nk3 nk4 7) (grdraw nk4 nk1 7)) (redraw) (setq nk5 (polar nk1 da (* 3 txh)) nk6 (polar nk4 da (* 3 txh)) nk7 (polar nk5 da (* 3 txh)) nk8 (polar nk6 da (* 3 txh)) nk9 (polar nk5 0 (* 15 txh)) nk10 (polar nk9 0 (* 15 txh)) nk11 (polar nk2 0 (* 15 txh)) nk12 (polar nk11 0 (* 15 txh)) nk13 (list (/ (+ (car nk1) (car nk4)) 2.0) (cadr (polar nk4 da (* 2 txh)))) nk14 (list (car (polar nk1 0 (* 2 txh))) (cadr (polar nk13 da (* 3 txh)))) nk15 (polar nk14 0 (* 15 txh)) nk16 (polar nk15 0 (* 15 txh))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.0) (cons 38 0.0) (cons 39 0.0) (cons 10 nk1) (cons 10 nk2) (cons 10 nk3) (cons 10 nk4))) (entmake (list (cons 0 "LINE") (cons 10 nk5) (cons 11 nk6))) (entmake (list (cons 0 "LINE") (cons 10 nk7) (cons 11 nk8))) (entmake (list (cons 0 "LINE") (cons 10 nk9) (cons 11 nk11))) (entmake (list (cons 0 "LINE") (cons 10 nk10) (cons 11 nk12))) (entmake (list (cons 0 "TEXT") (cons 10 nk13) (cons 40 txh) (cons 1 "POLİGON ÖZET TABLOSU") (cons 50 0) (cons 71 0) (cons 72 1) (cons 11 nk13))) (entmake (list (cons 0 "TEXT") (cons 10 nk14) (cons 40 txh) (cons 1 "POLİGON ADI") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk15) (cons 40 txh) (cons 1 "ALAN") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk16) (cons 40 txh) (cons 1 "ÇEVRE") (cons 50 0) (cons 71 0) (cons 72 0))) (setq TArea 0 TPeri 0) (while (< (setq n (1+ n)) L) (setq nk7 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk7 dy) nk8 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk8 dy) nk14 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk14 dy) nk15 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk15 dy) nk16 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk16 dy) TArea (+ TArea (atof (nth n aLns))) TPeri (+ TPeri (atof (nth n cvRs)))) (if (< n 10) (setq pLNo (strcat "PoLigon-0" (itoa (1+ n)))) (setq pLNo (strcat "Poligon-" (itoa (1+ n))))) (entmake (list (cons 0 "TEXT") (cons 10 nk14) (cons 40 txh) (cons 1 pLNo) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk15) (cons 40 txh) (cons 1 (nth n aLns)) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk16) (cons 40 txh) (cons 1 (nth n cvRs)) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "LINE") (cons 10 nk7) (cons 11 nk8)))) (setq nk14 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk14 dy) nk15 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk15 dy) nk16 (mapcar '(lambda (nn1 nn2) (- nn1 nn2)) nk16 dy)) (entmake (list (cons 0 "TEXT") (cons 10 nk14) (cons 40 txh) (cons 1 "TOPLAM") (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk15) (cons 40 txh) (cons 1 (rtos TArea)) (cons 50 0) (cons 71 0) (cons 72 0))) (entmake (list (cons 0 "TEXT") (cons 10 nk16) (cons 40 txh) (cons 1 (rtos TPeri)) (cons 50 0) (cons 71 0) (cons 72 0))))) (setvar "modemacro" "") (command "undo" "e") (prin1) ) inşAllah ilglenen olur.. polyline alan ve çevre konusunda son nokta olur ... teşekkürler iyi çalışmalar, ProhibiT (08.07.2022 17:28 GMT)

17.03.2014 22:06 76416	dmzkn Girişimci 4 ileti inş.müh. bursa
tabi örnek olarak paylaştığım lispteki polyline nın koordinatlarının yazılması satırıda var.. mahaller için bu gereksiz. çıkartılması gerekli..

18.03.2014 07:15 76430	ehya Yönetici 3554 ileti Teknik Ressam Ankara
dmzkn Sipariş usulü madde madde yazmışsınız.. Peki bu istekler için ne kadar ödenek ayırdınız???

18.03.2014 10:01 76440	dmzkn Girişimci 4 ileti inş.müh. bursa
Bu forumda benim yazdığım şeylerin çok daha fazlasını yapabilen bir sürü üst düzey kod var. Ben onlardan o kadar çok faydalandim ki anlatamam .emeği geçenlerden Allah razı olsun. Ve bu kodları özgürce kopyaladım. Kimsede benden para talep etmedi. Onun yüzünden yukaridaki mesajı yazmaya yüz buldum. Eğer yanlış birsey yaptıysam Özür dilerim.

18.03.2014 13:57 76441	ehya Yönetici 3554 ileti Teknik Ressam Ankara
Bu kadar üst düzey bir lisp görmedim. Eğer var ise, daha önceden yazılıp paylaşılan bir lisp olabilir. Eğer bu sitede lisp paylaşılıyorsa tabiki kimse ücret talep etmediği içindir. Açık kod lispleri gönül rahatlığıyla kullanabilirsiniz. Ancak siz liste halinde isteklerinizi yazmışsınız. Haliyle bu lispi kullanarak para kazanacaksınız ve görüldüğü üzere kişisel bir lisp olacaktır. Bu kod yazım işi de öyle kolay bir iş olmadığını düşünerek bunu yazacak kişilerin ücret talep etmesi gayet doğaldır.

20.02.2018 07:36 86057	wildqueen10 Girişimci 1 ileti
komutu vs yokmu birşey anlayamadım

> 1 <