Copyright © 2004-2022 SQL: 0.998 saniye - Sorgu: 71 - Ortalama: 0.01405 saniye
 |
 |
 |
 |
|
|
|
|
18.02.2011 10:22
afffsin 
|
|
Merhaba,
birbiriyle kesişen iki çemberin merkezden kesişime tekrar merkeze giden bir çizgi çizen lisp'e ihtiyacım var. şu şekilde düşünüyorum, komutu girip daha önceden çizmiş olduğum çemberlerin ,çizginin hangi kesişimden geçmesini istiyorsam o kesişimi seçicem lisp o kesişimden merkezlere çizgi çekip çemberleri silecek. sonuç olara elimde iki adet çizgi kalmış olucak. görsel de hazırlamıstım fakat yükliyemedim. Linkleri görebilmek için ÜYE olmalısınız.
|
|
18.02.2011 13:12
 ehya
|
|
Komut ismi csl
Kod: (defun c:csl ()
(vl-load-com) (setq ac-doc (vla-get-activedocument (vlax-get-acad-object))) (setq ent1 (car (entsel "\n1. daire:"))) (if (/= (vla-get-objectname (vlax-ename->vla-object ent1)) "acdbcircle") (progn (princ "\nseçilen nesne cırcle değil...")) (progn (setq ent2 (car (entsel "\n2. daire:"))) (if (/= (vla-get-objectname (vlax-ename->vla-object ent2)) "acdbcircle") (progn (princ "\nseçilen nesne cırcle değil...")) (progn (vl-cmdf "_.Select" ent1 ent2 "") (setq point (getpoint "\nkesişim noktası:")) (if (= point nil) (progn ) (progn (setq c-cen1 (vla-get-center (vlax-ename->vla-object ent1)) c-cen2 (vla-get-center (vlax-ename->vla-object ent2))) (vla-addline (vla-get-modelspace ac-doc)c-cen1 (vlax-3d-point point)) (vla-addline (vla-get-modelspace ac-doc)c-cen2 (vlax-3d-point point)) (entdel ent1) (entdel ent2) ))))))(princ))
|
|
18.02.2011 16:00
 ProhibiT
|
|
Mehmet hocam, affınıza sığınarak, tam suyu çıkarılacak konu dedim :)
Kod: (defun c:ccl () çemberler teğet ise, tek kesişim noktası olduğundan nokta seçmeye gerek kalmadan çizgileri çizer, çemberleri siler. çemberler kesişmiyorsa, hata ile çıkar. çemberler 2 noktada kesişiyorsa, ilgili noktanın seçimini mouse hareketiyle yapar.(vl-load-com) (command "undo" "group") (while (not (setq cr1 (ssget ":s" (list (cons 0 "circle")))))) (while (not (setq cr2 (ssget ":s" (list (cons 0 "circle")))))) (setq cr1 (ssname cr1 0) p1 (cdr (assoc 10 (entget cr1))) cr2 (ssname cr2 0) p2 (cdr (assoc 10 (entget cr2))) pts (vlax-safearray->list (vlax-variant-value (vla-intersectwith (vlax-ename->vla-object cr1) (vlax-ename->vla-object cr2) 0)))) (if (< (length pts) 4) (setq p3 (list (nth 0 pts) (nth 1 pts) (nth 2 pts)) p4 p3) (setq p3 (list (nth 0 pts) (nth 1 pts) (nth 2 pts)) p4 (list (nth 3 pts) (nth 4 pts) (nth 5 pts)))) (if (/= p3 p4) (while (/= 3 (car (setq p5 (grread t 4 0)))) (redraw) (if (< (distance p3 (cadr p5)) (distance p4 (cadr p5))) (progn (setq mp p3) (grvecs (list -1 p1 p3 -1 p3 p2))) (progn (setq mp p4) (grvecs (list -1 p1 p4 -1 p4 p2))))) (setq mp p3)) (redraw) (entmake (list (cons 0 "line") (cons 10 p1) (cons 11 mp))) (entmake (list (cons 0 "line") (cons 10 mp) (cons 11 p2))) (entdel cr1) (entdel cr2) (command "undo" "e") (prin1) ) kolay gelsin.
|
|
18.02.2011 16:32
ehya
|
|
Hocam estf. ne demek :)
ben otomatik kesişim alacaktım ancak 2 tane kesişim olma ihtimali var. ayrıca üye, kendisi istemiş ben tıklayayım diye.. bende hiç uğraşmadım tıklasın dedim :)
|
|
18.02.2011 16:48
afffsin
|
|
Çok teşekkür ederim öncelikle.
ehya'nınkinde seçilen nesne circle değil hatası veriyor ve komuttan çıkıyor. ben beceremedim sanırım. prohibit'inki tam istediğim gibi olmuş, fakat nesneleri seçmeden direk kesişimi seçsem yada toplu seçim ile çemberleri seçebilsem çok daha iyi olucak. tekrar teşekkür ediyorum.
|
|
18.02.2011 17:55
ProhibiT
|
|
Ehya hocamın kodlarında sitemizdeki geçici bir durum nedeniyle, büyük harfler küçük olarak yazılıyor, bunun için de "acdbcircle" eşleşmesi doğrulanamıyor. aynı kodu, özel mesaj içinde yazdığımızda bu problem yok. sonuç olarak fonksiyon doğru çalışıyor :)
afffsin komşum, bahsettiğiniz gibi kesişim noktasını seçince, ilgili noktadan geçen circle objelerini aratmak lazım. bahsettiğiniz diğer konu, toplu seçim ile çemberleri seçince, bir çemberin birden çok başka çemberle kesişimi varsa, iş çetrefilleşiyor. kısacası istedikleriniz, burada paylaşılan fonksiyonların genel amaçlı olması ilkesini de zorluyor. paylaştığımız autolisp ve visuallisp kodlarını örnek olmaları bakımından paylaşıyoruz. takdir edersiniz ki, spesifik ihtiyaçları tam karşılayacak fonksiyonlar yazmamız da pek mümkün değil. konu ilginç ve genel amaçlı olduğunda gördüğünüz gibi, bir isteğe karşılık iki fonksiyon bile yazılabiliyor. anlayışla karşılayacağınızı umuyor kolaylıklar diliyorum :)
|
|
18.02.2011 18:52
afffsin
|
|
Tabiki anlayışla karşılıyorum. şunu söyleyip konuyu kısa tutayımozaman; sadece iki çember ile çalışıldığı için herhangi bir problem çıkacağını sanmıyorum.
|
|
10.06.2021 13:26
NOGA1
|
|
Degerli ilgili, Acil cok rica edecem, carpma lipsinde noktadan sonra 3 hane carpan lips lazim,
adet (boy cm) 13 x 455 = 59.150 gibi Tesekkurler, Alper
|
|
10.06.2021 18:04
 alumina
|
Alıntı Kod: (defun c:qw (/ dz)
(setq dz (getvar 'Dimzin)) (setvar 'Dimzin 0) (print (rtos (* 13.0 4.55) 2 3)) (setvar 'Dimzin dz) (princ) )
|
|
10.06.2021 18:29
NOGA1
|
|
Hocam Tesekkurler,
yanlis anlasildim, yada ben anlatamadim, metraj carpimi yaparken, herhangi bir iki rakam carpip sonucuna noktadan sonra 3 hane olsun istemistim, asagida bir ornek carp lsp, var ama noktadan sonra tek hane carpiyor, ben noktadan sonra 3 hane carpsin istiyorum, tesekkurler, (defun c:crpm () (princ "\n çarpılacak sayıları seçiniz ") (setq crpn (ssget (list (cons 0 "*text"))) l (sslength crpn) n -0 rslt nil) (while (< (setq n (0+ n)) l) (if rslt (setq rslt (* rslt (atof (cdr (assoc 1 (entget (ssname crpn n))))))) (setq rslt (atof (cdr (assoc 1 (entget (ssname crpn n)))))))) (setq crpm (entget (car (entsel "\n çarpımı seçiniz "))) crpm (subst (cons 1 (rtos rslt)) (assoc 1 crpm) crpm)) (entmod crpm) (entupd (cdr (assoc -1 crpm))) (prin1) )
|
|
NOGA1
|
|
rakam 13 yada baska bir rakam olabilir, sonucunda carptiktan sonra, cappim kismi noktadan sora 3 hane olsun, istiyom
Autocad ortaminda herhangi bir sayiyi iki yada uc ,dort basamak sayilari, baska bir iki ,uc,dort basamak sayiyla carpacak, sonucunu noktadan sonra uc hane yapsin
|