Copyright © 2004-2022 SQL: 1.336 saniye - Sorgu: 69 - Ortalama: 0.01936 saniye
 |
 |
 |
 |
|
|
|
|
27.05.2012 17:37
 ProhibiT
|
|
Havalandırma Kanallarına Dirsek Çizen Lisp / Lisp function for drawing Elbow to the Air Ducts
· Fonksiyon çalıştırıldığında, aralarına dirsek çizilecek 2 havalandırma kanalını tanımlayan 4 Line seçmeniz istenir. · Line objelerini seçmenizi isteyen "select objects:" mesajına Enter (veya Sağ tuş) girerek cevap verdiğinizde, minimum iç yarıçap (minimum radius) seçimi yapabilirsiniz. Radius belirlenirken doğrudan değer girebileceğiniz gibi, 2 nokta belirleyerek te girebilirsiniz. Radius belirlenmediğinde fonksiyon kendiliğinden 10 değerini kullanacaktır. Belirlenen Radius değeri drawing dosyası kapatılıncaya kadar unutulmaz, açıklanan şekilde istenen anda değiştirilebilir. · Seçilen Line objeleri 4 tane olmalıdır, 3 veya 5 gibi 4'ten farklı sayıda seçilirse kabul edilmez. · Seçilen Line objeleri ikişer ikişer kendi aralarında paralel olmalıdır. Seçilen Line'lar arasında diğerlerinden hiç birine paralel olmayan Line varsa fonksiyondan çıkılır. · 4 Line ile belirlenen 2 kanal biribirine paralel ya da aynı doğrultuda olduklarında fonksiyondan çıkılır. · Kanalları tanımlayan Line objelerinden herhangi birinde aykırılık durumunda (mesela z koordinatının farklı olması gibi) fonksiyondan çıkılır. Seçilen 4 Line objesi de aynı düzlemde (coplaner) olmalıdır. · Fonksiyon, bunların dışında seçilecek Line'ların Layer, Color, LineType, LineWeight,... gibi özellikleriyle ilgilenmez. · Kanallar herhangi bir açıyla (0, 180 ve 360 derece hariç) birleşebilir. · Kanalların genişlikleri biribirinden farklı olabilir. · Çizilen dirsek Arc elemanları, o anda geçerli olan Layer, Color, LineType, LineWeight,... kullanılarak oluşturulurlar. Örnek videoyu izlemek için tıklayınız / click here for waching sample video Kullanıma hazır Lisp dosyasını indirmek için tıklayınız. Click here to download ready to use Lisp File.  174410-elbw.rarKod: ;|===========================================================================|; ;| eLbw: Draws an ELbow between selected two Air Ducts |; ;| Author: M. Şahin Güvercin - www.autocadokulu.com - 27.05.2012 |; ;|---------------------------------------------------------------------------|; (defun c:eLbw (/ *err* LnS eR minR n LnL AnG An0 Ln1 Ln2 Ds1 Ds2 p0 maxR m iPt PvT EnP DsT DsE DsS pT1 pRm ucL Ar1 Ar2 sTp sP eP) (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com) (defun *error* (er) (setvar "FiLLetRad" oFr) (setvar "cmdecho" 1) (princ er) (command "_.undo" "group")) (setq oFr (getvar "FiLLetRad") eR (if eR eR (setq eR 10)) minR eR n -1 tLr 1.0E-08 sP "StartPoint" eP "EndPoint") (princ "\nSelect Lines to be represented Ducts <Enter: Specify Radius>: ") (while (or (not LnS) (if LnS (/= 4 (sslength LnS)))) (if (not (setq LnS (ssget (list (cons 0 "Line"))))) (if (setq MinR (getdist (strcat "\nMinimum Inner Radius <" (rtos eR) ">: "))) (setq eR minR) (setq minR eR)) (if (/= (sslength LnS) 4)(princ "\n4 lines must be selected.")))) (while (< (setq n (1+ n)) 4) (setq LnL (append LnL (list (vlax-ename->vla-object (ssname LnS n)))))) (setq AnG (mapcar '(lambda (p) (if (>= (setq An0 (vlax-get-property p 'AngLe)) pi) (- An0 pi) An0)) LnL)) (cond((and(equal(nth 0 AnG)(nth 1 AnG) tLr)(equal(nth 2 AnG)(nth 3 AnG) tLr)) (setq Ln1(list(nth 0 LnL)(nth 1 LnL)) Ln2(list(nth 2 LnL)(nth 3 LnL)))) ((and(equal(nth 0 AnG)(nth 2 AnG) tLr)(equal(nth 1 AnG)(nth 3 AnG) tLr)) (setq Ln1(list(nth 0 LnL)(nth 2 LnL)) Ln2(list(nth 1 LnL)(nth 3 LnL)))) ((and(equal(nth 0 AnG)(nth 3 AnG) tLr)(equal(nth 1 AnG)(nth 2 AnG) tLr)) (setq Ln1(list(nth 0 LnL)(nth 3 LnL))Ln2(list(nth 1 LnL)(nth 2 LnL))))) (if(not Ln1)(progn(princ"\nSome Edges not Parallel to other Edge.\n")(exit))) (setq AnG (append (list (nth 0 AnG)) (vl-remove (nth 0 AnG) Ang)) AnG (if (= (length AnG) 1) (progn (princ "\nDucts mustn't be Parallel or Same Direction...")(exit)) (append (vl-remove (nth 1 AnG) AnG) (list (nth 1 AnG))))) (if (< (setq Ds1 (distance (setq p0 (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 0 Ln1) sP)))) (vlax-curve-getClosestPointTo (nth 1 Ln1) p0 T))) (setq Ds2 (distance (setq p0 (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 0 Ln2) sP)))) (vlax-curve-getClosestPointTo (nth 1 Ln2) p0 T)))) (setq maxR (+ minR Ds1)) (setq maxR (+ minR Ds2))) (while (> (setq n (1- n) m n) 0) (while (>= (setq m (1- m)) 0) (if (not (minusp (vlax-safearray-get-u-bound (setq o (vlax-variant-value (vla-intersectwith (nth n LnL) (nth m LnL) AcExtendBoth))) 1))) (setq iPt (append iPt (vlax-safearray->list o)))))) (if (< (length iPt) 12) (progn (princ "\nLines must be Coplaner.\n") (exit))) (setq iPt (mapcar '(lambda (p) (list (nth p iPt) (nth (1+ p) iPt) (nth (+ p 2) iPt))) (list 0 3 6 9)) n -1) (while (< (setq n (1+ n)) 4) (setq PvT (nth n LnL) m -1 DsT nil) (while (< (setq m (1+ m)) 4) (if (equal (distance (nth m iPt) (vlax-curve-getClosestPointTo PvT (nth m iPt) T)) 0.0 tLr) (if (< (setq DsE (distance (vlax-safearray->list (vlax-variant-value (vlax-get-property PvT 'EndPoint))) (vlax-curve-getClosestPointTo PvT(nth m iPt))))(setq DsS(distance (vlax-safearray->list(vlax-variant-value(vlax-get-property PvT sP))) (vlax-curve-getClosestPointTo PvT (nth m iPt))))) (if (not DsT)(setq DsT DsE EnP "EpT" pT1 (nth m iPt))(setq DsT DsE)) (if(not DsT)(setq DsT DsS EnP "SpT" pT1(nth m iPt))(setq DsT DsS))))) (vlax-put-property PvT (if (= EnP "SpT") sP eP) (vlax-3d-point pT1))) (cond ((not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-intersectwith (nth 0 Ln1) (nth 0 Ln2) AcExtendNone)) 1))) (setq pRm (mapcar '(lambda (p1 p2) (nth p1 (eval (read (strcat "Ln" (itoa p2)))))) (list 0 0 1 1) (list 1 2 1 2)))) ((not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-intersectwith (nth 0 Ln1) (nth 1 Ln2) AcExtendNone)) 1))) (setq pRm (mapcar '(lambda (p1 p2) (nth p1 (eval (read (strcat "Ln" (itoa p2)))))) (list 0 1 1 0) (list 1 2 1 2)))) ((not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-intersectwith (nth 1 Ln1) (nth 0 Ln2) AcExtendNone)) 1))) (setq pRm (mapcar '(lambda (p1 p2) (nth p1 (eval (read (strcat "Ln" (itoa p2)))))) (list 1 0 0 1) (list 1 2 1 2)))) ((not (minusp (vlax-safearray-get-u-bound (vlax-variant-value (vla-intersectwith (nth 1 Ln1) (nth 1 Ln2) AcExtendNone)) 1))) (setq pRm (mapcar '(lambda (p1 p2) (nth p1 (eval (read (strcat "Ln" (itoa p2)))))) (list 1 1 0 0) (list 1 2 1 2))))) (setvar"FiLLetRad"minR)(vl-cmdf"_.FiLLet"(vlax-vla-object->ename(nth 0 pRm)) (vlax-vla-object->ename(nth 1 pRm)))(setq Ar1(vlax-ename->vla-object(entlast))) (setvar"FiLLetRad"maxR)(vl-cmdf"_.FiLLet"(vlax-vla-object->ename(nth 2 pRm)) (vlax-vla-object->ename(nth 3 pRm)))(setq Ar2(vlax-ename->vla-object(entlast))) (setq ucL (mapcar '(lambda (p1 p2) (if (equal (distance (vlax-safearray->list (vlax-variant-value (vlax-get-property p1 'EndPoint)))(vlax-safearray->list (vlax-variant-value (vla-intersectwith p1 (eval (read (strcat "Ar" (itoa p2)))) AcExtendNone)))) 0.0 tLr) "EPt" "SPt")) pRm(list 1 1 2 2))) (if(<=(distance(vlax-curve-getClosestPointTo(nth 2 pRm)(vlax-safearray->list (vlax-variant-value(vlax-get-property(nth 0 pRm)(if(=(nth 0 ucL)"SPt") sP eP))))T)(vlax-safearray->list(vlax-variant-value(vlax-get-property (nth 2 pRm) (if (= (nth 2 ucL) "SPt") sP eP))))) (vlax-get-property (nth 2 pRm) 'Length)) (setq sTp (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 0 pRm) (if (= (nth 0 ucL) "SPt") sP eP)))) EnP (vlax-curve-getClosestPointTo (nth 2 pRm) sTp)) (setq sTp (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 2 pRm) (if (= (nth 2 ucL) "SPt") sP eP)))) EnP (vlax-curve-getClosestPointTo (nth 0 pRm) sTp))) (entmake (list (cons 0 "Line") (cons 10 StP) (cons 11 EnP))) (if(<=(distance(vlax-curve-getClosestPointTo(nth 3 pRm)(vlax-safearray->list (vlax-variant-value(vlax-get-property(nth 1 pRm)(if(=(nth 1 ucL)"SPt") sP eP))))T)(vlax-safearray->list(vlax-variant-value(vlax-get-property (nth 3 pRm) (if (= (nth 3 ucL) "SPt") eP sP))))) (vlax-get-property (nth 3 pRm) 'Length)) (setq sTp (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 1 pRm) (if (= (nth 1 ucL) "SPt") sP eP)))) EnP (vlax-curve-getClosestPointTo (nth 3 pRm) sTp)) (setq sTp (vlax-safearray->list (vlax-variant-value (vlax-get-property (nth 3 pRm) (if (= (nth 3 ucL) "SPt") sP eP)))) EnP (vlax-curve-getClosestPointTo (nth 1 pRm) sTp))) (entmake (list (cons 0 "Line") (cons 10 StP) (cons 11 EnP))) (setvar "FiLLetRad" oFr)(setvar "cmdecho" 1)(command "_.undo" "end")(prin1)) İlgi duyan yazar arkadaşlarımız ve fonksiyonun tanımlanmış (sınırsız değil) çalışma mantığını ve algoritmasını ana hatlarıyla anlatmak isterim. · Yukarıda verilen kriterlere uygun 4 tane Line Figur-1 deki gibi seçildiğinde  · Kendi içinde biribirine paralel ikişerli 2 gurup çizginin Figur-2 de görüldüğü gibi uzantılarının 4 tane kesişim noktası bulunur.  · Her bir çizgi bu intersection noktalarından, kendi doğrultusu üzerinde ve en yakın olanına kadar Figur-3 te görüldüğü gibi uzatılır.  · Uzatılmış (ya da kısaltılmış) Line'lardan ortak noktası (intersection) olan iki tanesi dirseğin içini, ortak noktası olmayan diğer 2 tanesi de, dirseğin dışını belirlerler.  · Dirsek içini belirleyen Line objeleri Minimum Radius kullanılarak Fillet edilir. · Dirsek dışını belirleyen Line objeleri de (Minimum Radius + Kanallardan dar olanın Eni) kadar bir radius ilse Fillet edilir.  · Her iki kanal ucuda, dirseğin başladığı yerde, dirseği kesmeyecek şekilde, paralel olan kanal kenarlarına dik Line objeleri oluşturulur.  · İşlem bu şekilde tamamlanmıştır. Fonksiyonun burada anlatılandan öte bir amacı ve kapsamı yoktur. Yazar arkadaşlarımız için; Bir Doğru parçasına (ya da uzantısına) bir Nokta'dan inilecek Dik'in ayağını bulmak için, ve bir Nokta'nın herhangibir Doğru'nun (veya uzantısının) üzerinde olup olmadığını kontrol etmek için, vlax-curve-getClosestPointTo fonksiyonu kullanılmıştır. ProhibiT (01.06.2012 06:57 GMT) 
|
|
28.05.2012 06:34
earthworm 
|
|
elinize sağlık hocam
|
|
28.05.2012 06:51
lordofstorm
|
|
ellerinize sağlık üstat
|
|
28.05.2012 07:45
 halilozcakir
|
|
elinize sağlık Hocam. tıkır tıkır çalışıyor. çoklu fillet illetinide çözmüş oldunuz çaktırmadan. ikili çizgide sınırlı kalsada buda bize ısıtma -soğutmada yeter..imalat açısından kanalda 90º ,45º üretiliyor genelde, iç radiusuna paralel dış (dirseğin sırtı) çizgi yapılıyor. rediksüyonlu dirseklerde ise iç radius aynen dıştakide pratikçe ağzı büzülüyor .elinize sağlık tekrar.
|
|
28.05.2012 08:05
ProhibiT
|
|
Evet, teşhis doğru, prensip olarak çoklu fillet (buradaki ikili) algoritması var bu fonksiyonda. Çoklu fillet fonksiyonu genel halini fırsat bulduğumda yazmayı umuyorum...
Yazıldı. Linkleri görebilmek için ÜYE olmalısınız. ProhibiT (22.03.2024 05:09 GMT)
|
|
07.06.2012 07:36
ufuk19
|
|
Hocam işlerin yoğunluğundan dolayı yeni gördüm mesajınızı
ellerinize sağlık harika olmuş
|
|
01.10.2014 05:35
 alirizasahin
|
Alıntı Bende olan lisp de kanala dirsek çizen lisptir. (defun c:DD(/ *error* oldOsnap oldOffset oldEcho oldFillet ind1 ind2 outd1 outd2 ename1 ename2 ename3 ename4 obj1 obj2 obj3 obj4 strpt1 strpt2 strpt3 strpt4 endpt1 endpt2 endpt3 endpt4 dspt1 dspt2 raddst rads smarcc cls1 cls2 endl1 endl2 clst1 clst2 enda1 enda2 ) (vl-load-com) (setq oldOsnap (getvar "osmode")) (setq oldOffset (getvar "offsetdist")) (setq oldEcho (getvar "cmdecho")) (setq oldFillet (getvar "filletrad")) (defun *error*(msg) (setvar "osmode" oldOsnap) (setvar "offsetdist" oldOffset) (setvar "cmdecho" oldEcho) (setvar "filletrad" oldFillet) (princ) ) (setvar "osmode" 0) (setvar "cmdecho" 0) (setq ind1 (entsel "\nILK KANAL ICINI SEC")) (setq outd1 (entsel "\nILK KANAL DISINI SEC")) (setq ind2 (entsel "\nIKINCI KANALIN ICINI SEC")) (setq outd2 (entsel "\nIKINCI KANALIN DISINI SEC")) (setq ename1 (car ind1)) (setq obj1 (vlax-ename->vla-object ename1)) (setq strpt1 (vlax-get obj1 'StartPoint) endpt1 (vlax-get obj1 'EndPoint)) (setq ename2 (car outd1)) (setq obj2 (vlax-ename->vla-object ename2)) (setq strpt2 (vlax-get obj2 'StartPoint) endpt2 (vlax-get obj2 'EndPoint)) (if (inters strpt1 endpt1 strpt2 endpt2) (setq result "The first two lines are not parallel") (setq d1 (distance strpt1 (vlax-curve-getClosestPointTo obj2 strpt1)) d2 (distance endpt1 (vlax-curve-getClosestPointTo obj2 endpt1)) d3 (distance strpt2 (vlax-curve-getClosestPointTo obj1 strpt2)) d4 (distance endpt2 (vlax-curve-getClosestPointTo obj1 endpt2)))) (setq dspt1 (min d1 d2 d3 d4)) (setq ename3 (car ind2)) (setq obj3 (vlax-ename->vla-object ename3)) (setq strpt3 (vlax-get obj3 'StartPoint) endpt3 (vlax-get obj3 'EndPoint)) (setq ename4 (car outd2)) (setq obj4 (vlax-ename->vla-object ename4)) (setq strpt4 (vlax-get obj4 'StartPoint) endpt4 (vlax-get obj4 'EndPoint)) (if (inters strpt3 endpt3 strpt4 endpt4) (setq result "The second two lines are not parallel") (setq d5 (distance strpt3 (vlax-curve-getClosestPointTo obj4 strpt3)) d6 (distance endpt3 (vlax-curve-getClosestPointTo obj4 endpt3)) d7 (distance strpt4 (vlax-curve-getClosestPointTo obj3 strpt4)) d8 (distance endpt4 (vlax-curve-getClosestPointTo obj3 endpt4)))) (setq dspt2 (min d5 d6 d6 d8)) (if (<= dspt2 dspt1) (setq raddst dspt2) (setq raddst dspt1)) (cond ((< raddst 20.9) (setq rads 5)) ((< raddst 50.9) (setq rads 10)) ((< raddst 70.9) (setq rads 15)) ((< raddst 90.9) (setq rads 20)) ((< raddst 110.9) (setq rads 25)) ((< raddst 130.9) (setq rads 30)) ((< raddst 150.9) (setq rads 35)) ((< raddst 170.9) (setq rads 40)) ((< raddst 190.9) (setq rads 45)) ((< raddst 210.9) (setq rads 50)) ) (setvar "FILLETRAD" rads) (command "FILLET" ind1 ind2) (setq smarcc (cdr (assoc 10 (entget (entlast))))) (setvar "FILLETRAD" (+ rads raddst)) (command "FILLET" outd1 outd2)
|
|
alirizasahin
|
|
defun c'den sonra : konmalı
|