Copyright © 2004-2022 SQL: 1.576 saniye - Sorgu: 89 - Ortalama: 0.01771 saniye
 |
 |
 |
 |
|
|
|
|
22.11.2013 12:02
 refleksif24
|
|
arkadaşlar bende metraj ve keşif için şöyle bir komut arıyorum.bütün line'ların kesiştiği noktaları bulsun ve kesişimde bölünen line çizgisi o noktadan kırılsın.örneğin bir yangın tesisatı var ve ana boru odalara dağılıyor yani uzun bir line a 5 farklı yerden farklı line larla kesiştirimiş. ben komple bu bu çizimi seçicem ve diyecem ki kesişim noktalarını bul ve sürekli çizgiyi bu noktalardan kır..bu mümkün müdür
|
|
25.11.2013 07:11
 alirizasahin
|
|
Kesişim yerlerinden kıran lisp
Alıntıdır. KOD: Kod: ;Written by: Chris Wade
;2010-02-03 ;Breaks objects at intersections (defun c:BreakInt (/ Ent1 Ent1E EntSS ct IntLst ct2 pt1 pt1a bptlist BDis ct3) (vl-load-com) (if (not (setq BDis (getreal "Enter a gap distance <0.1>: "))) (setq BDis 0.1) ) (if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0)) (setq BDis (/ BDis (getvar "cannoscalevalue"))) ;;(setq BDis 0.1) <--commented out ) (princ "\n") (while (= Ent1 nil) (setq Ent1 (entsel "\rSelect the object to break: ")) ) (setq Ent1E (vlax-ename->vla-object (car Ent1))) (princ "\n") (while (= EntSS nil) (princ "\rSelect the objects to break with: ") (setq EntSS (ssget)) ) (setq ct 0) (while (< ct (sslength EntSS)) (setq intLst (vlax-invoke Ent1E 'intersectWith (vlax-ename->vla-object (ssname EntSS ct)) acExtendNone)) (cond ((/= intLst nil) (setq ct2 0) (while (< ct2 (length intLst)) (setq pt1 (list (nth ct2 intLst) (nth (+ ct2 1) intLst) (nth (+ ct2 2) intLst))) (setq pt1a (vlax-curve-getdistatparam Ent1E (vlax-curve-getparamatpoint Ent1E pt1))) (cond ((= bptlist nil) (setq bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis)))) ) (T (setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis))))) )) (setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (+ pt1a BDis))))) (setq ct2 (+ ct2 3)) ))) (setq ct (+ ct 1)) ) (cond ((/= bptlist nil) (setq ct3 0) (while (< ct3 (length bptlist)) (command "._break" "_non" (trans (nth ct3 bptlist) 0 1) "_non" (trans (nth (+ ct3 1) bptlist) 0 1)) (setq ct3 (+ ct3 2)) )))) (defun C:BI () (c:breakint) ) ehya (25.11.2013 14:01 GMT) |
|
26.11.2013 09:37
refleksif24
|
Alıntı Nasıl kullanacağımı çözemedim. Şöyle ki; breakint yazıyorum. Ardından gap distance 0 yazıyorurum. Obje seçiyorum ardından kırılacak obje ile seçiyorum herhangi bir şey olmuyor. Ne yapmam gerek? ProhibiT (26.11.2013 18:48 GMT) |
|
26.11.2013 11:15
alirizasahin
|
|
Parçaları mausla seçtiğin zaman kesişim yerlerinden kırılmış olduğunu görmeniz lazım.line veya poliline olması farketmiyor...
|
|
26.11.2013 12:33
refleksif24
|
Alıntı fakat şöyle bir sıkıntı yaşıyorum. çizgi yi kesen 4 farklı nokta var. çizgyi seçiyorum ardından diğer 4 kesen çizgileri seçiyorum işe yaramıyor. ama çizgiyi seçip 1 veya 2 kesen çizgiyi seçtiğimde çalışıyor. yine de teşekkürler. iyi günler..
|
|
26.11.2013 18:49
 ProhibiT
|
|
Kod: ;|---------------------------------------------------------------------------|
| BrLn: Breaks selected object to the intersection with same layer objects. | | Author: M. Şahin Güvercin (ProhibiT) www.cizimokulu.com 26.11.2013 | |---------------------------------------------------------------------------|; (defun c:BrLn (/ *error* BLn BrP DsT e int m n NkT TrO) (defun *error* (e /) (command "_.undo" "end") (if e (princ e)) (princ)) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (if (setq BLn (car (entsel "\nSelect Line to be break: "))) (setq TrO (ssdel BLn (ssget "x" (list (assoc 8 (entget BLn))))) BLn (vlax-ename->vla-object BLn) n -1) (exit)) (while (< (setq m -3 n (1+ n)) (sslength TrO)) (if (not (minusp (vlax-safearray-get-u-bound (setq int (vlax-variant-value (vla-intersectwith (vlax-ename->vla-object (ssname TrO n)) BLn 0))) 1))) (progn (setq int (vlax-safearray->list int)) (while (< (setq m (+ m 3)) (- (length int) 2)) (if (and (not (zerop (setq DsT (vlax-curve-getdistatpoint BLn (setq NkT (list (nth m int) (nth (1+ m) int) (nth (+ 2 m) int))))))) (not (equal DsT (vlax-curve-getEndParam BLn)))) (if Brp (setq BrP (append BrP (list (append NkT (list DsT))))) (setq BrP (list (append NkT (list DsT)))))))))) (setq BrP (vl-sort BrP (function (lambda (e1 e2) (<(cadddr e1)(cadddr e2))))) BLn (vlax-vla-object->ename BLn) n -1) (while (< (setq n (1+ n)) (length BrP)) (command "Break" BLn (setq NkT (vl-remove (cadddr (nth n BrP))(nth n BrP))) NkT) (setq BLn (entlast))) (command "_undo" "end") (princ))
|
|
26.11.2013 19:59
 Travaci
|
|
Kod: ;|===========================================================================|
| Seçilen gurup obje gurubu veya tüm çizim içindeki Line objeleri | | alınarak biribiri ile olan intersection noktalarından break edilir. | | Hazırlayan: M. Şahin Güvercin 13/01/2012 www.autocadokulu.com | |___________________________________________________________________________|; (write-line "Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com") (defun c:brk (/ *error* Lines n m Line1 Line2 PnTsL inTsc intPt Line3 Line4) (command "_.undo" "group") (setvar "cmdecho" 0) (vl-load-com) (defun *error* (er) (princ (strcat "\n" er)) (command "_.undo" "e")) (setq Lines (ssget (list (cons 0 "Line"))) n (sslength Lines)) (while (> (setq n (1- n) m n) 0) (while (> (setq m (1- m)) -1) (setq Line1 (vlax-ename->vla-object (ssname Lines n)) Line2 (vlax-ename->vla-object (ssname Lines m)) PnTsL (list (vlax-curve-getStartPoint Line1) (vlax-curve-getEndPoint Line1) (vlax-curve-getStartPoint Line2) (vlax-curve-getEndPoint Line2)) inTsc (vlax-variant-value (vla-intersectwith Line1 Line2 0))) (if (> (vlax-safearray-get-u-bound inTsc 1) -1) (setq intPt (vlax-safearray->list inTsc)) (setq intPt nil)) (if (and intPt (not (equal intPt (nth 0 PnTsL))) (not (equal intPt (nth 1 PnTsL))) (not (equal intPt (nth 2 PnTsL))) (not (equal intPt (nth 3 PnTsL)))) (progn (setq Line1 (entget (vlax-vla-object->ename Line1)) Line2 (entget (vlax-vla-object->ename Line2)) Line3 (subst (cons 10 intPt) (assoc 10 Line1) Line1) Line1 (subst (cons 11 intPt) (assoc 11 Line1) Line1) Line4 (subst (cons 10 intPt) (assoc 10 Line2) Line2) Line2 (subst (cons 11 intPt) (assoc 11 Line2) Line2)) (mapcar '(lambda (p1) (entmod p1) (entupd (cdr (assoc -1 p1)))) (list Line1 Line2)) (mapcar '(lambda (p1) (entmake p1) (ssadd (entlast) Lines)) (list Line3 Line4)) (setq n (sslength Lines) m -1))))) (command "_.undo" "e") (prin1)) ;|___________________________________________________________________________|;
|
|
26.11.2013 23:01
ProhibiT
|
|
Teşekkürler travacı :) ben bunu yazıp unutmuşum.
Hazır gündeme gelmişken; (while (> (setq n (1- n) m n) 0) ... şeklinde iç içe iki döngünün sayaç değişkenini tek ifadede güzel halletmişim :) İlk döngünün sayacı n'yi set edip 0'dan büyük olmasını denetlerken aynı anda ikinci döngünün sayacı m değişkenini de set etmişim. Bu işlev (brk) yalnızca Line nesneleri ile işlem yapar. Başlıkta bahsedilen konuya gelince, alirizasahin arkadaşımızın paylaştığı kod hem gereksiz uzun, hem de mantık kurgusu (algoritmik ve logic) bakımdan kusurları var. BrLn işlevinde, bir şebeke (network) çizilirken, ana hattın ve branşmanların aynı layer'da çizileceğini varsaydım. Çalıştırıldığında yalnızca kırılacak ana hattın seçilmesi yeterli olacaktır. Kırılacak nesne herhangi bir türde AutoCAD nesnesi (Line, Polyline, Lwpolyline, Spline, Arc, Circle, Ellipse) olabilir. Aynı Layer'da yer alan gene herhangi bir türde olan nesnelerle kesişim noktalarından ilk seçilen nesne break edilir. Sonuç olarak biribirini defalarca kesen nesneler için bile doğru çalışır. ProhibiT (27.11.2013 07:07 GMT) |
|
27.11.2013 06:31
refleksif24
|
|
çok teşekkürler..harika..tam istediğim şey de buydu..hazırlayandan paylaşıp yardımcı olana kadar hepinizin ellerine sağlık..
|
|
18.09.2014 07:07
earthworm
|
|
ProhibiT Hocam 50 çizgi ve üstü seçince kitliyo autocadi, bu lisp geliştirilebilirmi acaba...
|
|
05.01.2020 20:44
ergun_342
|
|
Acaba bu lispi paylaşmanız mümkün mü?
|
|
06.01.2020 07:11
 ehya
|
|
ergun_342
Yukarıda lisp zaten paylaşılmış. Daha nasıl paylaşılmasını bekliyorsunuz?
|
|
06.01.2020 09:50
ergun_342
|
|
indirme linki bulamadım. Komutlar var lisp yapmasını bilmiyorum.
|
|
06.01.2020 11:22
ehya
|
Alıntı Yukarıdaki kodları boş bir metin belgesine yapıştırın ve dosyanın uzantısını LSP olarak değiştirin. Aşağıdaki videoyu izleyerek autolisp'in nasıl yüklendiğini öğrenin.. Autolisp Nasıl Yüklenir?
|
|
06.01.2020 13:02
ergun_342
|
|
sağolasın ehya bey
|
|
ProhibiT
|
|
Merhaba arkadaşlar,
2012 yılında yazıp paylaşılmış, 2013'te tekrar paylaşılmış Lisp Fonksiyonun 2020 yılında yani 8 yıl sonra tekrar gündeme gelmesi ne kadar ilginç değil mi? Aslında bu yalnızca bir örnek, cizimokulu.com sitemizin (eski adıyla autocadokulu.com) paylaşımları bu alanda bir klasik, bir ekol oluşturmuş. Bu güzelliklerin yaşanmasını sağlayan başta Aydın Şimşek hocam, Mehmet Şamil Demiryürek (ehya) hocam, Adem Ercan (Alumina) ve Erkan Travacı kardeşlerim olmak üzere, şu anda isimleri aklıma gelmeyen ve katkıda bulunan tüm arkadaşlarımıza teşekkür ederim. Böyle bir ortamın parçası olmaktan her zaman büyük bir mutluluk ve gurur duyuyorum. Selam ve saygılarımla herkese kolaylıklar dilerim :)
|