Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.687 saniye - Sorgu: 98 - Ortalama: 0.01721 saniye
 |
 |
 |
 |
|
|
|
|
23.02.2012 17:22
 Travaci
|
|
Üst üste geçen iki çizginin kesişen noktasını bulamilirmiyiz ?
|
|
23.02.2012 21:33
 ehya
|
|
seçilen iki nesnenin kesişim koordinatları
Autolisp ile Kod: (setq e1 (car (entsel "\n1. çizgi")) e2 (car (entsel "\n2. çizgi"))) (setq e1-10 (cdr (assoc 10 (entget e1))) e1-11 (cdr (assoc 11 (entget e1))) e2-10 (cdr (assoc 10 (entget e2))) e2-11 (cdr (assoc 11 (entget e2)))) (setq kesisim (inters e1-10 e1-11 e2-10 e2-11)) VisualLisp ile Kod: (vl-load-com)
(setq e1 (vlax-ename->vla-object (car (entsel "\n1.çizgi"))) e2 (vlax-ename->vla-object (car (entsel "\n2.çizgi")))) (setq kesisim (vlax-safearray->list (vlax-variant-value (vla-intersectwith e1 e2 acExtendBoth))))
|
|
24.02.2012 19:23
id
|
|
Ekteki kodları forumdaki kanalizasyon lisplerinden aldım. Lisp yazmayı bilmiyorum ama kotları takip edip bazı kısımlarını işime yaramadığı için sildim. Fakat işlem bittikten sonra bir hata veriyor. Bu hatayı giderebilir misiniz? Fikir vermesi için bir de DWG dosyası ekledim. Şimdiden teşekkürler...
Kod: (DEFUN C:kal ( ) ;;;;;;;;;;;;;;;;;;;;;;;AYARLAR;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq 1_os (getvar "osmode")) (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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (prompt "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 bmerkez (getpoint "\n Bacanın merkezini tıkla")) (setvar "osmode" 0) (setq zeminkot kotyazı1) (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 kotyazı1) (setq B2 (getpoint "\nNo yerini tıklayınız: ")) (setq rad bd) (command "layer" "m" "BACA" "c" "White" "" "") (command "layer" "m" "DAIRE" "c" "White" "" "") (command "circle" B2 rad) (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" kotyazısı "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) (setvar "osmode" 1_os) (princ) )  6141-drawing1.dwg
ehya (25.02.2012 07:06 GMT) |
|
25.02.2012 07:08
ehya
|
|
Bilmediğiniz bir dilde gereksiz kodları nasıl anlayabiliyorsunuz?? :no
Eklediğiniz kod üzerinden hata veren satırı düzelttim. Tekrar alabilirsiniz.
|
|
25.02.2012 10:18
Travaci
|
|
(command "pline" n3 n4 "a" n5 "l" n6 "a" n7 "l" n8 "")
(command "donut" 0 r2 n1 "" ) Yukarıdaki iki satır entmake ile apılabilirmi ? Donut u oluşturduktan sonra yerleştirlecek noktayı nasıl vericem bilmiyorum. Plyline yaparken bır yandanda arc nasıl yapılabılır ? TEŞEKKÜRLER
|
|
25.02.2012 12:15
 ProhibiT
|
|
Kod: (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0) '(100 . "AcDbPolyline") '(90 . 6) '(70 . 0) (cons 10 p1) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 p2) '(40 . 0.0) '(41 . 0.0) (cons 42 buLg1) '(91 . 0) (cons 10 p3) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 p4) '(40 . 0.0) '(41 . 0.0) (cons 42 buLg1) (91 . 0) (cons 10 p5) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 p6) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0))) 90 . 6 -> Polyline objesinin 6 noktası var 70 . 0 -> Polyline kapalı değil (cons 10 p2,p2,p3,p4,p5 veya p6 -> lineer (doğrusal) segmentlerde buLg'ın sıfır olduğuna dikkat. 42 . buLg -> buLg=bombedir. Nasıl hesaplanacağını bana sormayınız... Kod: (entmake (list (0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (100 . "AcDbPolyline") (90 . 2) (70 . 1) (cons 43 width) (10 p1) (40 . 0.25) (41 . width) (42 . buLg) (91 . 0) (10 p2) (40 . 0.25) (41 . width) (42 . buLg) (91 . 0))) Doughnut (donut) objesi temelde Lwpolyline objesidir. Donut objesinin yerleştirildiği nokta p1 ve p2'nin orta noktasıdır. 90 . 2 -> 2 noktalı tek segmentli Lwpolyline. 70 . 1 -> kapalı bir polyline 43 . width -> width=lineweight (Outer Diameter - Inner Diameter / 2) Yani Dış Çap eksi İç Çap bölü 2... Neden bilin bakalım! 10 p1 -> birinci nokta 42 . buLg -> gene buLg=Bombe? burada buLg 1.0'dır! Neden? 10 p2 -> ikinci nokta. Hadi bir ipucu daha vereyim; Donut objesinin yerleşeceği noktadan (Dış Çap + İç Çap) / 4 kadar pi yönünde gidin p1 noktasını. Aynı miktar kadar 0 yönünde gidin p2 noktasını bulursunuz. Kolay gelsin.
|
|
27.02.2012 10:23
Travaci
|
 Çalışma şekli baştaki ve sondaki donut u seçiyorum ters u şeklinde bir polyline çiziyor daha sonrada ortada kalan donutları seçtiğimde orta noktasından yukarı dogru lineları çiziyor fakat ortadaki donutları teker teker seçtiriyor bana ben ise ortadaki donutları seçtiğimde otomatik kendi hepsinin ortasından line ları çizsin istiyorum, aynı zamanda da circle dada çalışacak, yapamadım yardımcı olurmusunuz Kod: (defun c:ett1 ()
(SETQ OL (GETVAR "DIMSCALE")) (setq pt1 (getpoint "\n 1.Yerleştirilecek Nokta.....:")) (setq pt2 (getpoint "\n 2.Yerleştirilecek Nokta.....:")) (setq ent1 (ssget '((-4 . "<or")(0 . "circle")(0 . "LWPOLYLINE")(-4 . "or>")))) (setq L 0) (setq aci (angle pt1 pt2)) (setq n1 (polar pt1 (+ aci (* pi 0.5)) (* ol 80 ))) (setq n2 (polar pt2 (+ aci (* pi 0.5)) (* ol 80 ))) (setq n3 (polar n2 (* pi 0.5) (* ol 12.5 ))) (setq n4 (polar n1 (* pi 0.5) (* ol 12.5 ))) (command "pline" pt1 n1 n2 pt2 "") (setq N (SSLENGTH ent1)) (while (< l n) (setq ent (car (entsel "ent1"))) (vl-load-com) (setq liste (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget ent) ) ) ) (setq mes (distance (car liste)(cadr liste)) mes1 (/ mes 2) ortanokta (polar (car liste)(angle (car liste) (cadr liste)) mes1)) (setq nn1 (polar ortanokta (+ aci (/ pi 2)) (* ol 80 ))) (command "line" ortanokta nn1 "") (setq l (+ l 1))(princ)) (princ) ) Travaci (27.02.2012 12:45 GMT) |
|
27.02.2012 14:48
htgurel
|
|
Öncelikle bu siteye katkıda bulunan bütün arkadaşlara teşekkür ederim. Arkadaşlar, Donatı Yerleşimi ve Metrajı hakkında yardımcı olabilecek Lisp'lere ihtiyacım var. Yardımcı olursanız memnun olurum... Herkese iyi çalışmalar.
ProhibiT (27.02.2012 15:51 GMT) |
|
27.02.2012 16:50
mayyaq61
|
|
sec2 değişkeninde bir çizgi
1sec1 değişkeninde bir çizgi Hangisi küçük ise o silinsin. Not:Sürekli değişiyor.
|
|
27.02.2012 17:32
ProhibiT
|
|
Kod: (setq sec1 (vlax-ename->vla-object sec1)
sec2 (vlax-ename->vla-object sec2)) ;;; Değişkenlerinizin değeri ename ise, ;;; önce object name'e dönmelisiniz. ;;; Değişkenleriniz zaten objet name ise, ;;; yukarıdaki 2 satırı yazmaya gerek yok. (if (< (vlax-get-property sec1 'length) (vlax-get-property sec2 'length)) (vla-delete sec1) (vla-delete sec2))
|
|
27.02.2012 20:28
mayyaq61
|
|
Hocam çok sağolun.
Bu vla foksiyonuyla sık karşılaşıyorum.Ne dir acaba?Açıklarmısınız?
|
|
28.02.2012 03:05
ProhibiT
|
|
Linkleri görebilmek için ÜYE olmalısınız. Linkinde gerekli bilgi var. Sizler için tercüme edivereyim. ___________________________________________________________ Visual LISP Visual LISP® teknolojisi AutoCAD® uygulamasında kod oluşturmak için bir araçtır. AutoCAD komutları çağırmak için kullanabileceğiniz tam özellikli, interpretive (anında çevrilip çalıştırılabilir) bir programlama dilidir. Visual LISP® sistem değişkenleri ve diyalog kutuları dahil olmak üzere, komple bir geliştirme ortamı sunar. Entegre geliştirme ortamı (Integrated Development Environment, IDE) kullanmak geliştirme süresini azaltır, kullanıcılar ve geliştiriciler için daha kolay ve daha hızlı kullanım ve hata ayıklama özellikleri sağlar. AutoLISP® tabanlı uygulamalar ActiveX® nesneleri ve Action Reactor'lere erişim sağlar. Çalınma ve değiştirilmeye karşı Kaynak kodu koruması, İşletim sistemi dosya çalışma fonksiyonları, Nesne Listesi işleme için LISP işlevi uzantıları sağlar. (Bunlar kendi iddiaları, benim gibi bazıları aynı fikirde olmama özgürlüğümüzü kullanıyoruz) ___________________________________________________________ 1. Geliştiriciler hangi belgeleri kullanılabilir? Dokümantasyon ve Visual LISP® örnekleri AutoCAD® 2012 medya ürünü üzerinde yer almaktadır. Eğitim ve danışmanlık gibi geliştirici bilgi tabanına (örnek kod ve sık sorulan sorulara yanıtlar için,) erişim Autodesk Geliştirici Ağı (Autodesk Developer Network ADN) üzerinden sağlanır. ___________________________________________________________ Söz konusu ADN üyeliği için (sınırlı erişim) yıllık en az $1500 ücret alıyorlar. Yani, profesyonel isen, bu işten para kazanıyorsan, bedelini ödersin. Amatörsen, fazla kurcalama, git kumda oyna! demek istiyorlar :) Şimdi hemen soracaksınız; - interpretive nedir? - Integrated Development Environment (IDE) nedir? - ActiveX® nesneleri nedir? - Action Reactor nedir? - AutoLISP® nedir? - Autodesk Developer Network (ADN) nedir? - VisualBasic® for Application (Vba) nedir? - Microsoft® artık Vba değeteğine devam etmiyormuş öylemiii? - .NET Framework nedir? - ... Defteri var kitabı var, okuyacaksınız! Bahsedilen, ciddi maddi değeri olan kavramları, burada Hilal-i Ahmer yararına anlatıp duruyoruz. Sizlerden beklentimiz; - Sorularınızı sorarken insaflı olunuz. - Aklınıza ilk geleni burada sormayınız, önce üzerinde kafa yorup emek vermelisiniz. - Takıldığınız bir konuda, öncelikle sitemizde araştırma yapıp örnekleri inceleyiniz. - Burada yerimiz ve zamanımız çok değerlidir, ve üzerinde tüm katılımcıların hakkı vardır. - Çağımızın hastalığı, "bilgi sahibi olmadan fikir sahibi olmak"'tan muzdarip mesajlar yazmayınız. - Şehir efsaneleri veya kafanın şimalinden ilk eseni burada yazıp, kimseye haksızlık etmeyiniz. - Sorduğunuz bir soruya cevap verilirken, bir konuda yanlış yaptığınız anlatılıyorsa, "canım öyle istedi" diye cevap yazmayınız. - Sorularınızı sorarken kavramları doğru yazınız, doğru yerinde kullanınız. Şeyin şeyini ş'apmayınız! - Bilmediğiniz kavramlardan bahsedip dolgu maddesi yapmayınız. - Bilgiye, tecrübeye ve emeğe göstereceğiniz saygı, kendinize olan saygınızın gereğidir. Herkese kolay gelsin...
|
|
28.02.2012 08:48
Travaci
|
Alıntı Arkadaşlar dün paylaşmıştım fakat bi cevap alamadım, ben uğraştım devamını getirdim. Sorucağım soru, yazdığım kodlar sadece şuan donut da düzgün çalışıyor, buna ekliyeceğim kısım "eğer circle ise" şu programı çalıştır olucak, sanırım if komutunu kulllanıcam ama seçilen objeyi nasıl tanımlıyıcam bilmiyorum.Yani circle veya donut ise ikisini birbirinden ayıran kod ne olmalıdır ? Kod: (defun c:ett1 ()
(SETQ OL (GETVAR "Dimscale")) (setq dnt1 (entget (car (entsel "\n 1.Donatiyi secin...")))) (setq dnt2 (entget (car (entsel "\n 2.Donatiyi secin...")))) (setq obje (ssget '((-4 . "<or")(0 . "circle")(0 . "LWPOLYLINE")(-4 . "or>")))) (setq L 0) (setq yc1 (cdr (assoc 40 dnt1))) (setq bn1 (cdr (assoc 10 dnt1))) (setq yc2 (cdr (assoc 40 dnt2))) (setq bn2 (cdr (assoc 10 dnt2))) (setq nk1 (polar bn1 0 ( / yc1 2))) (setq nk4 (polar bn2 0 ( / yc2 2))) (setq aci (angle nk1 nk4)) (setq nk2 (polar nk1 (+ aci (* pi 0.5)) (* ol 80 ))) (setq nk3 (polar nk4 (+ aci (* pi 0.5)) (* ol 80 ))) (command "pline" nk1 nk2 nk3 nk4 "") (setq N (SSLENGTH obje)) (while (< l n) (setq eleman (ENTGET (SSNAME obje L))) (setq yc3 (cdr (assoc 40 eleman))) (setq bn3 (cdr (assoc 10 eleman))) (setq nk5 (polar bn3 0 ( / yc3 2))) (setq nk6 (polar nk5 (+ aci (/ pi 2)) (* ol 80 ))) (command "line" nk5 nk6 "") (setq l (+ l 1))(princ) ) (princ) )
|
|
28.02.2012 08:57
ehya
|
|
Kod: (setq ent (car (entsel "\nNesneyi seç:"))) (setq tanim (cdr (assoc 0 (entget ent)))) (if (= tanim "CIRCLE") (progn..... ....... ....... ....... ) ; progn sonu (progn ....... ....... ....... tanim sonucu CIRCLE ise ilk progn altında işlemini yap. Yok eğer değil ise ikinci progn altında işlemini yap.
|
|
28.02.2012 09:07
Travaci
|
|
Çok Teşekkür
|
|
28.02.2012 16:49
ProhibiT
|
Alıntı Yazdıklarınız Donut için de düzgün çalışmaz. Neden Donut için düzgün çalışmaz? Çünki, genel anlamda Lwpolyline seçiyorsunuz. Öncelikle algoritmayı gerçekten iyi kurmak lazım. Ancak bundan sonra kodlamanın detaylarıyla uğraşılabilir. Doughnut, 2 vertex'i '(90 . 2) olan kapalı '(70 . 1) bir Polyline '(0 . "LWPOLYLINE") dır. Bu konuyu gene bu başlık altında açıklamıştım. Donut ve Circle için seçim filtresi; (ssget ":s" (list '(-4 . "<OR") '(-4 . "<AND") '(0 . "LWPOLYLINE") '(90 . 2) '(70 . 1) '(-4 . "AND>") '(0 . "CircLe") '(-4 . "OR>"))) şeklinde yazılabilir... Bu da yetmez! Circle objelerinde '(10 x y z) şeklinde merkez noktasını bulabilirken, donut (Lwpolyline) objesinden alacağınız '(10 x y z) değerlerinden hiç biri objenin merkezi değildir. Donut objelerinin merkezini bulmadan, (ssget "F" (point list)... ile aradaki objeleri seçtirmek çok uzun ve eziyetli bir işlemdir. Öncelikle şu viedoyu bir izleyin; Açıklayıcı Örnek Video Yukarıda açıkaldığım problemlerin ve pek çok detayın çözümüyle ilgili şu örnek kodu dikkatle incelemenizi tavsiye ederim. Kod: ;|===========================================================================| | Betonarme Projelerde Donatı Etiketleme | | Hazırlayan: M. Şahin Güvercin 28.02.2012 www.autocadokulu.com | |___________________________________________________________________________|; (defun cpt (obj / n00) (setq n00 (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object obj) 'coordinates))) n00 (list (/ (+ (nth 0 n00) (nth 2 n00)) 2.0) (/ (+ (nth 1 n00) (nth 3 n00)) 2.0) (getvar "Elevation")))) ;|___________________________________________________________________________|; (defun c:DY (/ *error* n01 n02 n03 n04 n05 n06 n07 fob kuk sob Ang obs n nks dob trv vec PvT Ti1 m) (command "_.undo" "group") (setq ocmd (getvar "cmdecho"))(setvar "cmdecho" 0) (defun *error* (msg) (if (not (vl-string-search "cancel" msg)) (princ msg)) (if dob (progn (setq m (sslength dob)) (while (not(minusp (setq m (1- m)))) (entdel (ssname dob m))))) (if dtx (entdel dtx)) (if trv (entdel trv)) (setvar "cmdecho" ocmd) (command "_.undo" "e") (prin1)) (vl-load-com) (setq TxH (* (getvar "dimtxt") (getvar "dimscale")) dny (getstring T "\nDonatı Yazısı: ") n01 (cdr (assoc 10 (entget (setq fob (ssname (ssget ":s" (list '(-4 . "<OR") '(-4 . "<AND") '(0 . "LWPOLYLINE") '(90 . 2) '(70 . 1) '(-4 . "AND>") '(0 . "CircLe") '(-4 . "OR>"))) 0))))) kuk (redraw fob 3) n01 (if (= (cdr (assoc 0 (entget fob))) "CIRCLE") n01 (cpt fob)) n02 (cdr (assoc 10 (entget (setq sob (ssname (ssget ":s" (list '(-4 . "<OR") '(-4 . "<AND") '(0 . "LWPOLYLINE") '(90 . 2) '(70 . 1) '(-4 . "AND>") '(0 . "CircLe") '(-4 . "OR>"))) 0))))) kuk (redraw fob 4) n02 (if (= (cdr (assoc 0 (entget sob))) "CIRCLE") n02 (cpt sob)) Ang (angle n01 n02) obs (ssget "_F" (list n01 n02) (list '(-4 . "<OR") '(-4 . "<AND") '(0 . "LWPOLYLINE") '(90 . 2) '(70 . 1) '(-4 . "AND>") '(0 . "CircLe") '(-4 . "OR>"))) n (sslength obs) nks (if (= (cdr (assoc 0 (entget (ssname obs (setq n (1- n)))))) "CIRCLE") (list (cdr (assoc 10 (entget (ssname obs n))))) (list (cpt (ssname obs n))))) (if (> Ang pi) (setq Ang (- Ang pi))) (if (> (setq Ang (+ Ang (/ pi 2.0))) pi) (setq Ang (- Ang pi))) (while (not (minusp (setq n (1- n)))) (if (= (cdr (assoc 0 (entget (ssname obs n)))) "CIRCLE") (setq nks (append nks (list (cdr (assoc 10 (entget (ssname obs n))))))) (setq nks (append nks (list (cpt (ssname obs n))))))) (setq n (length nks) dob (ssadd)) (while (not (minusp (setq n (1- n)))) (entmake (list (cons 0 "Line") (cons 10 (nth n nks)) (cons 11 (polar (nth n nks) Ang 1.0)))) (ssadd (entlast) dob)) (setq n03 (polar n01 Ang 1.0) n04 (polar n02 Ang 1.0) n05 (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) n03 n04)) (entmake (list '(0 . "Line")(cons 10 n03)(cons 11 n04))) (setq trv (entlast)) (entmake (list '(0 . "Text")(cons 10 (setq Ti1 (polar n05 Ang (/ TxH 2.0)))) (cons 40 TxH) (cons 1 dny) (cons 50 (- Ang (/ pi 2.0))) '(72 . 1) (cons 11 Ti1))) (setq dtx (entlast)) (while (/= 3 (car (setq n06 (grread T 4 1)))) (setq n07 (cadr n06) vec (list (- (car n07) (car n05)) (- (cadr n07) (cadr n05)) (- (caddr n07) (caddr n05))) n (sslength dob)) (while (not (minusp (setq n (1- n)))) (setq PvT (entget (ssname dob n)) PvT (subst (cons 11 (mapcar '(lambda (p1 p2) (+ p1 p2)) (cdr (assoc 11 PvT)) vec)) (assoc 11 PvT) PvT) PvT (entmod PvT) PvT (entupd (cdr (assoc -1 PvT))))) (setq PvT (entget trv) PvT (subst (cons 10 (mapcar '(lambda (p1 p2) (+ p1 p2)) (cdr (assoc 10 PvT)) vec)) (assoc 10 PvT) PvT) PvT (subst (cons 11 (mapcar '(lambda (p1 p2) (+ p1 p2)) (cdr (assoc 11 PvT)) vec)) (assoc 11 PvT) PvT) PvT (entmod PvT) PvT (entupd (cdr (assoc -1 PvT))) n05 (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) (cdr (assoc 10 (entget PvT))) (cdr (assoc 11 (entget PvT))))) (if (not (inters n05 (polar n05 Ang (* 3 TxH)) n01 n02 T)) (setq PvT (entget dtx) PvT (subst (cons 10 (setq Ti1 (polar n05 Ang (/ TxH 2.0)))) (assoc 10 PvT) PvT) PvT (subst (cons 11 Ti1) (assoc 11 PvT) PvT) PvT (entmod PvT) PvT (entupd (cdr (assoc -1 PvT)))) (setq PvT (entget dtx) PvT (subst (cons 10 (setq Ti1 (polar n05 (+ Ang pi) (* TxH 1.5)))) (assoc 10 PvT) PvT) PvT (subst (cons 11 Ti1) (assoc 11 PvT) PvT) PvT (entmod PvT) PvT (entupd (cdr (assoc -1 PvT))))) (setq n05 n07)) (setvar "cmdecho" ocmd) (command "_.undo" "e") (prin1)) ;|___________________________________________________________________________|; Herkese Kolay gelsin... ProhibiT (28.02.2012 17:03 GMT) |
|
28.02.2012 17:46
tyenier
|
Alıntı Merhaba, ekranda yer alan rakamlari tikladigimda birer artiracak bir lisp yazilabilir mi? tolga
|
|
28.02.2012 18:11
ProhibiT
|
|
Linkleri görebilmek için ÜYE olmalısınız. linkinde paylaştığım INCDEC fonksiyonu tam olarak bahsettiğiniz işlem için yazılmış olmasa da, işinize yarayabilir. Tek tek obje seçmek yerine gurup halinde objeler seçilip, istenilen sayı kadar artırılıyor. Rakam diye bahsettiğiniz için Tamsayı anlaşılıyor... Reel sayıda olsa şu fonksiyonu bir deneyin. Kod: (defun c:incr (/) Reel sayı seçerseniz, ondalık noktasından sonra anlamlı (sıfırdan farklı) bir sayı yoksa, bunu ta tamsayı olarak yazar.
(command "_.undo" "group") (princ "\n Artırılacak Rakamı seçiniz: ") (while (setq rKm (ssget ":s" (list (cons 0 "*text")))) (setq rKm (entget (ssname rKm 0))) (if (numberp (setq icrk (atof (cdr (assoc 1 rKm))))) (setq rKm (if (= icrk (fix (* (/ icrk 2) 2))) (subst (cons 1 (itoa (fix (1+ icrk)))) (assoc 1 rKm) rKm) (subst (cons 1 (rtos (1+ icrk))) (assoc 1 rKm) rKm)) rKm (entmod rKm) rKm (entupd (cdr (assoc -1 rKm))))) (princ "\n ... Rakam seçiniz: ")) (command "_.undo" "e") (prin1) ) ProhibiT (28.02.2012 18:37 GMT) |
|
28.02.2012 21:29
Travaci
|
prohobit Walla abi 1 ay oldu olmadı uğraşalı,senin şu lispleri gördükçe öğrenme şewkim kırılıyor : D Kod: (defun c:ett2 ( / ) (SETQ OL (GETVAR "DIMSCALE")) (lay_ekle "OK_MAVİ" "continuous" 11);; başka bi lisp e bağlı (setq dnt1 (entget (car (entsel "\n 1.Donatiyi secin...")))) (setq dnt2 (entget (car (entsel "\n 2.Donatiyi secin...")))) (setq obje (ssget '((-4 . "<or")(0 . "circle")(0 . "LWPOLYLINE")(-4 . "or>")))) (setq tanim (cdr (assoc 0 dnt1))) (if (= tanim "LWPOLYLINE") (progn (setq yc1 (cdr (assoc 40 dnt1))) (setq bn1 (cdr (assoc 10 dnt1))) (setq yc2 (cdr (assoc 40 dnt2))) (setq bn2 (cdr (assoc 10 dnt2))) (setq nk1 (polar bn1 0 ( / yc1 2))) (setq nk4 (polar bn2 0 ( / yc2 2))) ) (progn (setq nk1 (cdr (assoc 10 dnt1))) (setq nk4 (cdr (assoc 10 dnt2))) ) ) (setq L 0) (setq aci (angle nk1 nk4)) (setq nk2 (polar nk1 (+ aci (* pi 0.5)) (* ol 80 ))) (setq nk3 (polar nk4 (+ aci (* pi 0.5)) (* ol 80 ))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 4) (cons 8 "OK_MAVİ") (cons 10 nk1) (cons 10 nk2) (cons 10 nk3) (cons 10 nk4) ) ) (setq N (SSLENGTH obje)) (while (< l n) (if (= tanim "LWPOLYLINE") (progn (setq eleman (ENTGET (SSNAME obje L))) (setq yc3 (cdr (assoc 40 eleman))) (setq bn3 (cdr (assoc 10 eleman))) (setq nk5 (polar bn3 0 ( / yc3 2))) ) (progn (setq eleman (ENTGET (SSNAME obje L))) (setq nk5 (cdr (assoc 10 eleman))) ) ) (setq nk6 (polar nk5 (+ aci (/ pi 2 )) (* ol 80 ))) (entmake (list (cons 0 "line") (cons 100 "AcDbEntity") (cons 8 "OK_MAVİ") (cons 100 "AcDbLine") (cons 10 nk5) (cons 11 nk6) ) ) (setq l (+ l 1)) (princ) ) (princ) ) Ben ordan bişi topladım şurdan bişi topladım birleştirdim bitirdim bunu yapabildim dediğin gibi sorun da vermedi nie vermedi onuda bilmiorum, içinde eksik veya fazla kod olabilir belki sol kulagımı sag elımle gosterdım ama tamda istediğim gibi oldu calıstı : D Abi birde şu komutu hemen hemen her lispinde görüyorum (command "_.undo" "group") bunun açıklaması nedir ?
|
|
ProhibiT
|
|
Kod: (defun c:ett2 (/ *error* oL dnt1 tanim dnt2 obje yc1 bn1 yc2 bn2 yc3 bn3 Gereksiz olanlar ayıklanıp gerekenler eklenince fonksiyon bu hale geliyor. Neleri kaldırıp neleri eklediğim konusunu iyi inceleyip düşünmenizi tavsiye ederim.nk1 nk2 nk3 nk4 nk5 nk6 eleman) (command "_.undo" "group") (defun *error* (msg) (princ msg) (command "_.undo" "e")) (if (not (tblsearch "Layer" "Ok_Mavi")) (entmake (list '(0 . "Layer") '(2 . "Ok_Mavi") '(62 . 11) '(6 . "Continuous")))) (setq oL (getvar "dimscale") dnt1 (entget (car (entsel "\n 1.Donatiyi secin..."))) tanim (cdr (assoc 0 dnt1)) dnt2 (entget (car (entsel "\n 2.Donatiyi secin..."))) obje (ssget '((-4 . "<or") (0 . "circle") (0 . "Lwpolyline") (-4 . "or>")))) (if (= tanim "LWPOLYLINE") (setq yc1 (cdr (assoc 40 dnt1)) bn1 (cdr (assoc 10 dnt1)) yc2 (cdr (assoc 40 dnt2)) bn2 (cdr (assoc 10 dnt2)) nk1 (polar bn1 0 (/ yc1 2)) nk4 (polar bn2 0 (/ yc2 2))) (setq nk1 (cdr (assoc 10 dnt1)) nk4 (cdr (assoc 10 dnt2)))) (setq aci (angle nk1 nk4) nk2 (polar nk1 (+ aci (* pi 0.5)) (* oL 80 )) nk3 (polar nk4 (+ aci (* pi 0.5)) (* oL 80 )) L (sslength obje)) (entmake (list'(0 . "Lwpolyline")'(100 . "AcDbEntity")'(100 . "AcDbPolyline") '(90 . 4)'(43 . 0) '(70 . 0) '(8 . "Ok_Mavi") (cons 10 nk1) (cons 10 nk2) (cons 10 nk3) (cons 10 nk4))) (while (not (minusp (setq L (1- L)))) (setq eleman (entget (ssname obje L))) (if (= tanim "LWPOLYLINE") (setq yc3 (cdr (assoc 40 eleman)) bn3 (cdr (assoc 10 eleman)) nk5 (polar bn3 0 (/ yc3 2))) (setq nk5 (cdr (assoc 10 eleman)))) (setq nk6 (polar nk5 (+ aci (/ pi 2 )) (* oL 80 ))) (entmake (list '(0 . "line")'(8 . "Ok_Mavi")(cons 10 nk5)(cons 11 nk6)))) (command "_.undo" "e") (princ) ) (command "_.undo" "group") ve (command "_.undo" "end") kullanılmadığında, vaz geçilip geri dönmek istendiğinde, her Lisp fonksiyonu için bir defa olmak üzere bir sürü U<┘ girmek gerekecek. Guruplandırdığımızda tek adımda geri dönülebilir. Fonksiyondan normal olmayan yollarla çıkış durumunda ise, "group" "end" kapatılmalıdır. Aksi halde gene problem çıkacaktır. Fonksiyon ele aldığınız örneğin özel hali için çalışır gibi oluyor. Yukarıda verdiğim videoya dikkatli bakın. Her durumda her açıda ve her obje sayısı ve konumunda çalışmalıdır. Sizin yazdığınız şekliyle, kazara donut objesi seçilirse, ve kazara donut'ın iki kutbu arasındaki açı sıfır olursa merkezini bulabilir. Kullanıcı bu, canı öyle ister donut'ları kopyalar, canı ister rotate eder, canı ister mirror uygular. Fonksiyon her durumda hedeflenen işlemi yapabilmelidir. Yeri gelmişken bir konuya daha dikkat çekmek isterim. Teknik resimde bazı kurallar var, bunlara uyulması şart olmamakla birlikte, dünyanın her yerinde resmin kolay okunabilmesi için (sarahat için, for clear understanding) uyulması resmin kalitesini artırır. Örnek olarak, ölçülerde mimari projelerde dot kullanılabilir (bu da tartışılır) ama betonarme projelerde dot kullandığınızda yeterince karışık çizim içinde donatı enkesitleri ile dimesion dot'ları biribirine karışır. Bu nedenle, mekanik çizimlerde ok (arrow), inşaat mühendisliği çizimlerinde de kesme (thick) kullanılması çok daha doğrudur. Benzer şekilde, her türlü çizimde, ışın çıkarıp (kılçık veya Leader) bir açıklama yazısı ya da etiket koyarken, asla bu ışınları ortogonal (x ve y eksenlerine paralel) yapmayınız. Genelde çizim objelerimiz ortogonal olduklarından gereksiz yere bunlarla karışır, resmin anlaşılmasını zorlaştırırlar. Son zamanlarda kerameti kendinden menkul bazı ilkel programlar bunu ortogonal yapabiliyor diye, genel geçer kural gibi algılanmamalıdır. Doğrusu, güzeli ve iyisi ortogonal olmamasıdır. Bir ara fırsat bulduğumda, Betonarme kalıp planlarına "alttan bakmak" gibi aptalca bir ifadenin aslının ne olduğundan, döşeme planının (slab plan) ve kalıp planının (formwork plan) ne olduğundan, benzerlikleri, farkları ve nedenlerinden bahsederim umarım. Kolay gelsin.
|