Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.3 saniye - Sorgu: 103 - Ortalama: 0.01262 saniye
 |
 |
 |
 |
|
|
|
|
12.10.2011 07:21
 özkan-wien
|
|
Kod: (defun c:lys () (setq lys_ent (entsel "\nnesneyi seçiniz:")) (if (= lys_ent nil) (progn) (progn (setq lys_tan (cdr (assoc 8 (entget (car lys_ent))))) (setq lys_sec (ssget "x" (list (cons 8 lys_tan)))) (sssetfirst nil lys_sec) ;(princ "\nseçilen nesneleri prevıous alt komutuyla çagirin:") ) ) (princ) ) arkadaslar günaydin. layersec lispinin coklusu var mi acaba. yani yukaridaki gibi tek secim degilde istedigin kadar layer 2,3,4,5. ProhibiT (12.10.2011 08:02 GMT) |
|
12.10.2011 08:33
 ProhibiT
|
|
Kod: (defun c:sLyr (/ sSeT sSt sOb L n)
(setvar "cmdecho" 0) (command "_.undo" "group") (setq sSeT (ssadd)) (while (setq sOb (car (entsel "\r İlgili Layer'da bir obje seçiniz."))) (setq sSt (ssget "x" (list (assoc 8 (entget sOb)))) L (sslength sSt) n -1) (while (< (setq n (1+ n)) L) (ssadd (ssname sSt n) sSeT)) (sssetfirst nil sSeT)) (command "_.undo" "e") (prin1) ) ProhibiT (12.10.2011 09:24 GMT) |
|
12.10.2011 10:06
özkan-wien
|
|
Üstad eline saglik. tesekkürler.
|
|
12.10.2011 23:11
borakemal
|
|
Sayın prohibit hocam senden bir istek istemiştim ama iyi kötü senin verdiğin kodlarla oynayarak bir şeyler yapmaya çalıştım
belki benim gibi ihtiyacı olan biri olabilir diye veriyorum kotlar çok iyi olmayabilir ama bende acemiyim yinede çalışıyor en azından :d birinci kod sadece sadece z değerinin kare içinde yazılmasını sağlıyor : kodlar prohibit arkadaşımızdan alınmıştır. Kod: (defun c:kot (/ tsty odz espas dp txh mirtxo nokta n1 yz1 yz2 ti1 ti2 t1 t2 p1x p2x n2 n3 n4 aci) (command "_.undo" "group") (setvar "cmdecho" 0) (setq tsty (getvar "TEXTSTYLE") odz (getvar "dimzin") espas 0.7071) (setvar "dimzin" 0) (if (not odp) (setq odp 3)) (setq mirtxo (getvar "mirrtext")) (setvar "mirrtext" 0) (if (setq dp (getint (strcat "\nOndalık Basamak Sayısı <" (itoa odp) ">: "))) (setq odp dp) (setq dp odp)) (if (not oth) (setq oth (getvar "TEXTSIZE"))) (if (setq txh (getreal (strcat "\n Yazı Yüksekliği <" (rtos oth 2 dp) ">: "))) (setq oth txh) (setq txh oth)) (if (tblsearch "LAYER" "Koordinat") (command "LAYER" "c" "1" "Koordinat" "") (command "LAYER" "n" "Koordinat" "c" "1" "Koordinat" "")) (while (setq nokta (getpoint "\Koordinatı Yazılacak Noktayı seciniz : ")) (setq n1 (getpoint nokta "\nKoordinatın Yazılacağı Yeri seciniz : ") yz1 (strcat "") yz2 (strcat "Z : " (rtos (caddr nokta) 2 dp) " m" ) ti1 (list (+ (car n1) (* espas txh)) (+ (cadr n1) (* espas txh)) 0.0) ti2 (list (car ti1) (+ (cadr ti1) txh (* espas txh)) 0.0) aci (angle nokta n1)) (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz1) (cons 50 0) (cons 10 ti2) (cons 7 tsty))) (setq t1 (entget (entlast))) (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz2) (cons 50 0) (cons 10 ti1) (cons 7 tsty))) (setq t2 (entget (entlast)) p1x (caar (textbox t2))) (if (> (caadr (textbox t1)) (caadr (textbox t2))) (setq p2x (caadr (textbox t1))) (setq p2x (caadr (textbox t2)))) (setq lx (+ (- p2x p1x) (* 2 espas txh)) ly (* (+ 1.0 (* 2.0 espas)) txh)) (cond ((and (>= aci 0) (<= aci (/ pi 2.0))) (setq n2 (polar n1 0 lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 pi lx))) ((and (> aci (/ pi 2.0)) (<= aci pi)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 0 lx))) ((and (> aci pi) (<= aci (* 1.50 pi))) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 0 lx))) ((> aci (* pi 1.50)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 0 lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 pi lx)))) (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 8 "Koordinat") (cons 100 "AcDbLine") (cons 10 nokta) (cons 11 n1))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "Koordinat") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3) (cons 10 n4)))) (setvar "mirrtext" mirtxo) (setvar "dimzin" odz) (command "_.undo" "e") (prin1) ) ikinci kod ise koordinatları netcad gibi yazabilmek için : Kod: (defun c:dxy (/ tsty odz espas dp txh mirtxo nokta n1 yz1 yz2 ti1 ti2 t1 t2 p1x p2x n2 n3 n4 aci) (command "_.Undo" "group") (setvar "cmdecho" 0) (setq tsty (getvar "textstyle") odz (getvar "dimzin") espas 0.7071) (setvar "dimzin" 0) (if (not odp) (setq odp 4)) (setq mirtxo (getvar "mirrtext")) (setvar "mirrtext" 0) (if (setq dp (getint (strcat "\nondalık basamak sayısı <" (itoa odp) ">: "))) (setq odp dp) (setq dp odp)) (if (not oth) (setq oth (getvar "textsıze"))) (if (setq txh (getreal (strcat "\n yazı yüksekliği <" (rtos oth 2 dp) ">: "))) (setq oth txh) (setq txh oth)) (if (tblsearch "layer" "koordinat") (command "layer" "c" "1" "koordinat" "") (command "layer" "n" "koordinat" "c" "1" "koordinat" "")) (while (setq nokta (getpoint "\koordinatı yazılacak noktayı seciniz : ")) (setq n1 (getpoint nokta "\nkoordinatın yazılacağı yeri seciniz : ") yz1 (strcat "x : " (rtos (car nokta) 2 dp) " m" ) yz2 (strcat "y : " (rtos (cadr nokta) 2 dp) " m" ) ti1 (list (+ (car n1) (* espas txh)) (+ (cadr n1) (* 0.5 espas txh)) 0.0) ti2 (list (car ti1) (- (cadr ti1) txh (* espas txh)) 0.0) aci (angle nokta n1)) (entmake (list (cons 0 "text") (cons 8 "koordinat") (cons 40 txh) (cons 1 yz1) (cons 50 0) (cons 10 ti2) (cons 7 tsty))) (setq t1 (entget (entlast))) (entmake (list (cons 0 "text") (cons 8 "koordinat") (cons 40 txh) (cons 1 yz2) (cons 50 0) (cons 10 ti1) (cons 7 tsty))) (setq t2 (entget (entlast)) p1x (caar (textbox t2))) (if (> (caadr (textbox t1)) (caadr (textbox t2))) (setq p2x (caadr (textbox t1))) (setq p2x (caadr (textbox t2)))) (setq lx (+ (- p2x p1x) (* 2 espas txh)) ly (* (+ 0 (* 0 espas)) txh)) (cond ((and (>= aci 0) (<= aci (/ pi 2.0))) (setq n2 (polar n1 0 lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 pi lx))) ((and (> aci (/ pi 2.0)) (<= aci pi)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 0 lx))) ((and (> aci pi) (<= aci (* 1.50 pi))) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 0 lx))) ((> aci (* pi 1.50)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 0 lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 pi lx)))) (entmake (list (cons 0 "lıne") (cons 100 "acdbentity") (cons 8 "koordinat") (cons 100 "acdbline") (cons 10 nokta) (cons 11 n1))) (entmake (list (cons 0 "lwpolylıne") (cons 100 "acdbentity") (cons 67 0) (cons 8 "koordinat") (cons 100 "acdbpolyline") (cons 90 4) (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3) (cons 10 n4)))) (setvar "mirrtext" mirtxo) (setvar "dimzin" odz) (command "_.undo" "e") (prin1) ) terkrar kodları veren prohibit arkadaşımıza teşekkür ediyorum
|
|
13.10.2011 09:06
 msermus
|
|
Kot ve nedcad formatı ıcın hazırlanan en son lısp ıcın,
y-x-z duzenınde nokta atıp(degerlerı kendımız gırcek sekılde) ve atılan noktaları ekranda goruntulenebılecek , veya tablo duzenınde ekranda olusacak sekılde duzenlenebılırmı. emegı gecen herkese tesekkur etmek ıstıyorum.
|
|
14.10.2011 12:40
ProhibiT
|
|
Son üç mesaja topluca cevap vermek istiyorum.
bonamir, bundan önce yazdığınız mesaj çok tuhafıma gittiği için, en iyi cevabın hiç cevap vermemek olduğunu düşünmüştüm. iyimser bakınca türkçeniz zayıf herhalde doğru ifade edemiyorsunuz diye düşünüyorum. yoksa, bazı şeyler sizin oradan bakınca farklı mı görünüyor? burada yaptığımız işi ihaleyle almadık, kimseyi de bize sayıyla teslim etmediler. buraya ısrarla mesajlar yazmak için harcadığınız zamanı probleminizin çözümüne ayırsaydınız, çoktan halletmiş olurdunuz. sözün özü, böyle ilginç tondaki isteklere asla cevap vermiyorum, hiç bir şey yazmak ta içimden gelmiyor yüksek müsaadelerinizle. borakemal, öncelikle içtenlikle tebrik ederim. burada illede odunumun parası diye tutturan insanlar gibi davranmayıp, kodları takip edip çözmüşsünüz, ve istediğiniz işlemi yapacak hale getirmişsiniz. son derece takdir edilecek, saygıdeğer bir yaklaşım. mevcut bir fonksiyonu, üstelik başkasının yazdığı kodu düzenlemek kadar zor ve belalı bir iş yoktur. böylesi bulanık suda balıkları nasıl yakaladınız, şaşmamak elde değil. :) ben böyle durumlarda yeniden yazmayı tercih ediyorum, daha kolay geliyor. kot ismini verdiğiniz ilk fonksiyonda kullanılmadığı halde fonksiyon içinde yer alan bir kaç değişkenden başka problem yok. bunlar da önemli değil. dediğiniz gibi fonksiyon istendiği gibi problemsiz çalışıyor. dxy adını verdiğiniz diğer fonksiyona gelince, nasıl bir hata oldu bilmiyorum, bütün büyük ı harfleri ı olduğundan ve buna benzer pek çok karakter değişmesi olduğundan, fonksiyonu bu haliyle değil çalıştırmak yüklemek bile mümkün değil. çalıştırabilmek için baştan sona elden geçirmek gerekiyor. "netcad gibi" diye bahsettiğiniz koordinat verme işi aslında basit. Linkleri görebilmek için ÜYE olmalısınız. linkinde paylaştığım kılçık lispi bunu zaten yapıyordu. bu konuyu incelemenizi tavsiye ederim. Kod: (defun c:xy (/ d t1 t2) Görüldüğü gibi, abatılırsa tek satırda Diesel Expression formatında yazılabilecek bir fonksiyon ile halledilecek bir konu. koordinat lispinde istekler ve hedefler epeyce farklı olduğu için bunca uzun ve karmaşık kod yazmak zorunda kalmıştık.(setq n (getpoint) d (getpoint n) t1 (strcat "X: " (rtos (car n))) t2 (strcat "Y: " (rtos (cadr n)))) (command "leader" n d "" t1 t2 "") ) koordinat yazdırma konusuyla ilgili olarak, her türlü ihtiyaca cevap verebilecek, mümkün olduğunca eksiksiz bir fonksiyon yazmaya başlamıştım. bitirdiğimde download bölümünde paylaşıp, buradan da ilgilenen arkadaşlara duyuracağım. msermus, mesajınız yeterince detaylı olmamakla birlikte, download bölümünde "koordinat tablosu oluşturan lisp" Linkleri görebilmek için ÜYE olmalısınız. konusuna bir göz atmanızı, orada paylaştığımız pct fonksiyonunu denemenizi tavsiye ederim. işinize yarayabilir... herkese kolay gelsin... ProhibiT (14.10.2011 12:46 GMT) |
|
14.10.2011 14:42
borakemal
|
|
Prohibit hocam öncelikle cevap verdiğiniz için teşekkür ederin.
evet daha önce vermiş olduğunuz linkide incelemiştim. ama en son verdiğiniz linkteki basamak sayısı, layer ataması ve textsize belirleme özellikleri açısından gercekten çok güzel bir kod oluşturmussunuz. bende bunu değerlendirmek istedim :d 2. vermiş olduğum kod lar neden anlamadım hatalı olarak oluşmuş düzenlemek istedim ama hata oluştu. bu nedenle kodları altta tekrar veriyorum çalışmalarınızıda özellikle takip ediyorum saygılarımla. nedcad benzeri koordinat yazdıran lisp kodları kodlar prohibit arkadaşımızın verdiği kodlar üzerinde hafif oynamalar yapılarak oluşturulmuştur. kod : Kod: (defun c:dxy (/ tsty odz espas dp txh mirtxo nokta n1 yz1 yz2 ti1 ti2 t1 t2
p1x p2x n2 n3 n4 aci) (command "_.undo" "group") (setvar "cmdecho" 0) (setq tsty (getvar "TEXTSTYLE") odz (getvar "dimzin") espas 0.7071) (setvar "dimzin" 0) (if (not odp) (setq odp 4)) (setq mirtxo (getvar "mirrtext")) (setvar "mirrtext" 0) (if (setq dp (getint (strcat "\nOndalık Basamak Sayısı <" (itoa odp) ">: "))) (setq odp dp) (setq dp odp)) (if (not oth) (setq oth (getvar "TEXTSIZE"))) (if (setq txh (getreal (strcat "\n Yazı Yüksekliği <" (rtos oth 2 dp) ">: "))) (setq oth txh) (setq txh oth)) (if (tblsearch "LAYER" "Koordinat") (command "LAYER" "c" "1" "Koordinat" "") (command "LAYER" "n" "Koordinat" "c" "1" "Koordinat" "")) (while (setq nokta (getpoint "\Koordinatı Yazılacak Noktayı seciniz : ")) (setq n1 (getpoint nokta "\nKoordinatın Yazılacağı Yeri seciniz : ") yz1 (strcat "X : " (rtos (car nokta) 2 dp) " m" ) yz2 (strcat "Y : " (rtos (cadr nokta) 2 dp) " m" ) ti1 (list (+ (car n1) (* espas txh)) (+ (cadr n1) (* 0.5 espas txh)) 0.0) ti2 (list (car ti1) (- (cadr ti1) txh (* espas txh)) 0.0) aci (angle nokta n1)) (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz1) (cons 50 0) (cons 10 ti2) (cons 7 tsty))) (setq t1 (entget (entlast))) (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz2) (cons 50 0) (cons 10 ti1) (cons 7 tsty))) (setq t2 (entget (entlast)) p1x (caar (textbox t2))) (if (> (caadr (textbox t1)) (caadr (textbox t2))) (setq p2x (caadr (textbox t1))) (setq p2x (caadr (textbox t2)))) (setq lx (+ (- p2x p1x) (* 2 espas txh)) ly (* (+ 0 (* 0 espas)) txh)) (cond ((and (>= aci 0) (<= aci (/ pi 2.0))) (setq n2 (polar n1 0 lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 pi lx))) ((and (> aci (/ pi 2.0)) (<= aci pi)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 0 lx))) ((and (> aci pi) (<= aci (* 1.50 pi))) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1) t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 pi lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 0 lx))) ((> aci (* pi 1.50)) (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1) t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2)) (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2))) (setq n2 (polar n1 0 lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 pi lx)))) (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 8 "Koordinat") (cons 100 "AcDbLine") (cons 10 nokta) (cons 11 n1))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "Koordinat") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3) (cons 10 n4)))) (setvar "mirrtext" mirtxo) (setvar "dimzin" odz) (command "_.undo" "e") (prin1) )
|
|
14.10.2011 22:40
borakemal
|
|
Arkadaşlar sizler 2 sorum olacak.
birincisi (command "_.Undo" "group") (command "_.Undo" "e") sanıyorum bu arada geri alınacak nesneler seçiliyor hatam olabilir. burada grupladığımız nesneleri lisp komutu içindeki döngüyü bitirmeden örnrğin en son lispteki noktayı seçin kısmına geri döndüğümüzde standart autocad çizimlerindeki _u komutu gibi bir komut koyabilirmiyiz. ikincisi ise a .. .. b (command "_.-group" "_c" "*" "" a b "") biraz arastırıp group oluşturmak için böyle bir program buldum. yanılmıyorsam bu komut a ve b arasındaki oluşturulan nesneleri grup haline getiriyor.(hatalı olabilirim) sorum ise bu komut doğru ise a ve b aralığını nasıl belirliyebilirim. daha doğrusu a ve b yerine ne koymalıyım ki aralığı belirliye bileyim. şimdiden yardım edebilecek arkadaşlara teşekkür ederim.
|
|
15.10.2011 06:16
 ehya
|
|
Undo komutu ile kodlama, lisp içindeki işlemler için geçerlidir. yaptığı işlem ise, lisp başlamadan önce bir grup oluşturur. lisp kodlaması bitince bu işlemi sonlandırır. yani lisp içinde iken yapılan tüm işlemleri bir grup altında toplar ve kullanıcı undo komutnu çalıştırdığında otomatik olarak tek seferde işlem geri alınır.
sizin bahsettiğiniz işlem ile yapılırsa hata verme olasılığı çok yüksektir. bu kodu ayrı lisp haline getirmek ise zaten mümkün değil. dediğim gibi grup oluşturur ve lisp içinde sonlandırır. ayrı lisp olsa grubu nasıl oluşturacak ve nasıl sonlandıracak??? a ve b aralığını belirmek için nokta tarigi yapmak zorundasınız. buınun için örnek bir kod yazıyorum. Kod: (setq a (getpoint "\n1.nokta:")
b (getcorner a "\n2.nokta:")) (command "_.-group" "_c" "*" "" a b "")
|
|
17.10.2011 18:18
ProhibiT
|
|
Önceki mesajımda bahsettiğim Koordinat Yazma fonksiyonunun güncellenmiş ve geliştirilmiş halini indirmek için tıklayınız. fonksiyonun bu son halinde;
- ondalık basamak sayısını kullanıcı seçer. - x, y ve z koordinatlarından hangisinin, veya hangilerinin, hangi sırada yazılacağı kullanıcı tarafından belirlenir. - seçilen koordinat değerleri o anda aktif olan ucs'de yazılırlar. - nokta seçildikten sonra, koordinat yazıları, çerçeve ve referans çizgisi ekranda belirir, koordinatlar mouse ile sürüklenerek ve görerek yerleştirilir. kolay gelsin.
|
|
02.11.2011 08:19
RidvanKARACA
|
|
Çok basit aslında
kod: Kod: ;;;============================================== ;;; hazırlayan, m. şahin güvercin - 13-04-2011 ;;;============================================== (write-line "\nhazırlayan, m. şahin güvercin - www.autocadokulu.com") (defun c:bbox (/ flo n obj mnp mxp ebat) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq flo (open (getfiled "çıkış kütüğü" "" "csv" 9) "w") n 0) (write-line "parça no;delta x;delta y;delta z" flo) (while (setq obj (car (entsel "\nselect 3dsolid object..."))) (if (= "3dsolıd" (cdr (assoc 0 (entget obj)))) (progn (setq obj (vlax-ename->vla-object obj)) (vla-getboundingbox obj 'mnp 'mxp) (setq mnp (vlax-safearray->list mnp) mxp (vlax-safearray->list mxp) ebat (mapcar '(lambda (p1 p2) (abs (- p1 p2))) mnp mxp)) (write-line (strcat (itoa (setq n (1+ n))) ";" (rtos (nth 0 ebat)) ";" (rtos (nth 1 ebat)) ";" (rtos (nth 2 ebat))) flo)) (write-line "\n*** seçilen obje 3dsolid olmalıdır. ***"))) (write-line (strcat "\n " (itoa n) " tane obje boyutu yazıldı.")) (close flo) (setvar "modemacro" "") (command "undo" "e") (prin1) ) obje seçmeye devam ettiğiniz sürece dosyaya ebat yazmaya devam eder. kolay gelsin. düzenleme: bu fonksiyonu bir de böyle deneyin. dosyayı excel ile açarken, bir hata mesajı alırsanız "evet" seçip devam etmelisiniz. kod: ;;;============================================== ;;; hazırlayan, m. şahin güvercin - 13-04-2011 ;;;============================================== (write-line "\nhazırlayan, m. şahin güvercin - www.autocadokulu.com") (defun c:bbox (/ flo n obj mnp mxp ebat) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq flo (open (getfiled "çıkış kütüğü" "" "xls" 9) "w") n 0) (write-line "parça no;delta x\tdelta y\tdelta z" flo) (while (setq obj (car (entsel "\nselect 3dsolid object..."))) (if (= "3dsolıd" (cdr (assoc 0 (entget obj)))) (progn (setq obj (vlax-ename->vla-object obj)) (vla-getboundingbox obj 'mnp 'mxp) (setq mnp (vlax-safearray->list mnp) mxp (vlax-safearray->list mxp) ebat (mapcar '(lambda (p1 p2) (abs (- p1 p2))) mnp mxp)) (write-line (strcat (itoa (setq n (1+ n))) "\t" (rtos (nth 0 ebat)) "\t" (rtos (nth 1 ebat)) "\t" (rtos (nth 2 ebat))) flo)) (write-line "\n*** seçilen obje 3dsolid olmalıdır. ***"))) (write-line (strcat "\n " (itoa n) " tane obje boyutu yazıldı.")) (close flo) (setvar "modemacro" "") (command "undo" "e") (prin1) ) sayın saygıdeğer prohibit abicim; üstteki lisp -bbox- çok işime yaradı. ayrıca tekrar teşekkür ederim.Abicim sizden ricam oncelikle 3d solid leri tek tek seçmek biraz zahmetli oluyor. bir çizimde bazen 50 ila 100 adet 3dsolid oluyor. bunu tek tek seçmek yerine çerceve ( dikdörtgen ) içine alarak tek seferde seçebilirmiyiz.Yardımlarınız için çok teşekkür ederim. çorumdan sevgi ve saygılarımla.Rıdvan karaca ehya (02.11.2011 08:29 GMT) |
|
02.11.2011 11:42
ProhibiT
|
|
Kod: ;;;===================================================================== Ankara'dan bilmukabele
;;; Hazırlayan, M. Şahin Güvercin - www.autocadokulu.com - 02-11-2011 ;;;===================================================================== (write-line "\nHazırlayan, M. Şahin Güvercin - www.autocadokulu.com") (defun c:BboX (/ fLo objs L n obj mnp mxp ebat) (defun *error* () (command "_.undo" "e") (setq *error* nil)) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq fLo (open (getfiled "Çıkış Kütüğü" "" "xls" 9) "w")) (write-line "PARÇA NO\tDelta X\tDelta Y\tDelta Z" fLo) (princ "\nSelect 3DSoLid Object(s)...") (setq objs (ssget (list (cons 0 "3DSoLid"))) L (sslength objs) n -1) (while (< (setq n (1+ n)) L) (setq obj (vlax-ename->vla-object (ssname objs n))) (vla-getboundingbox obj 'mnp 'mxp) (setq mnp (vlax-safearray->list mnp) mxp (vlax-safearray->list mxp) ebat (mapcar '(lambda (p1 p2) (abs (- p1 p2))) mnp mxp)) (write-line (strcat (itoa (1+ n)) (chr 9) (rtos (nth 0 ebat)) (chr 9) (rtos (nth 1 ebat)) (chr 9) (rtos (nth 2 ebat))) fLo)) (write-line (strcat "\n " (itoa n) " tane obje boyutu yazıldı.")) (close fLo) (setq *error* nil) (command "undo" "e") (prin1) )
|
|
02.11.2011 13:00
RidvanKARACA
|
|
Prohibit abicim; tam da istedigim gibi olmus cok tesekkur ederim cok saolasin ellerin dert gormesin
|
|
16.11.2011 12:21
borakemal
|
|
Biraz geç oldu ama öncelikle soruma verdiği cevap için ehya arkadaşıma çok teşekkür ederim.
ve prohibit hocamada verdiği son kod için teşekkür ederim saygılarımla...
|
|
17.11.2011 10:19
 emasi
|
|
Selamun aleykum
şöyle bir lisp isteyinde bulunacağım: block reference-nin içinde olan atributların deyişdirilmesi için lisp yazıla bilirmi? çizimin içinde çok sayda block içinde olan atribut var.Mesela bu atributların içine numaralandırma yapılıyor.Ve zencirvari numaralandırdıktan sonra yeni bir numara eklemek lazım geliyor ama numara yenisi yok önce kullanılan numara olmalı ve mecburen numaraların rakam sayısı deyişiyor "n+1" "n-1" ardıcıllığı ile. ve bu zaman mövcud numaralar karışıyor. bilmem anlata bildimmi :blush . dil farklılığından dolayı fikrimi iyi anlata bilmediğim için .Dwg dosyasıda ekledim. http://www.boxca.com/op1ov8wfebbk/numaralandirma.dwg.html
|
|
18.11.2011 12:04
cagrikara
|
|
Total station da yapılan ölçümlerde elde ettiğim noktaları autocad ile açıyorum. sonra bu noktaları da elimdeki krokilerle line komutuyla birleştiriyorum. nokta numarasını aramak sonraki numarayı arayıp birleştirmek epey uzun zamanımı alıyor. benim düşündüğüm mantık şu: elimdeki autocad dosyasını açtığımda birleştireceğim noktalardan başlangıç noktasının ismini girip birleşeceği dosyayı seçtiğimde arasında line ile birleşmesini istiyorum. tabi ki bu sürekli olmasını istiyorum. ilk noktayı belirttim 2ci noktayıda ( başlangıçla 2.Ci nokta arasında line ile çizildi) 3cü noktayı seçtim ( sadece 2.Ci nokta ile 3.Cü nokta arası line ile çizildi ) bu şekilde bir lips istiyorum. böyle birşey mümkün mü ?
eğer mümkünse yardımınızı istiyorum. şimdiden çok teşekkür ederim.
|
|
20.11.2011 15:54
 Travaci
|
|
Arkadaşlar iki gündür lisple uğraşıyorum fakat istediğim noktaya ulaşmak için daha çok zamana ihtiyacım var
şöyle bir lisp yaptım devamını sizden rica edicem ------------------------------------------------------------------------------ (defun c:deneme (/ cap1 cap2 nok1 nok2 xnok1 xnok2) (setvar "cmdecho" 0) (setq nok1 (getpoint "\n bir nokta giriniz")) (setq nok2 (getpoint "\n ikinci noktayı giriniz")) (setq xnok1 (car nok1)) (setq cap1 0) (setq cap2 2.5) (setq cap3 0) (setq cap4 2.5) (command "line" nok1 nok2 "") (command "donut" cap1 cap2 nok1 "") (command "donut" cap3 cap4 nok2 "") ) ------------------------------------------------------------------------------ bu işlem sonunda nil yazısı çıkıyor nedeni nedir ? cıkmamasını sağlıyabilirmiyiz ? line komutu çalıştıgında çizgiyi aktif olarak görmek istiyorum tüm işlemin sonundada polyline olmasını istiyorum. iki donut ve line ın işlem olarak mümkün olmadığını düşünüyorum fakat buna benzer bir lisp gördüğüm için yapılabileceğini umuyorum. şimdiden herkeze teşekkür.
|
|
21.11.2011 07:22
ehya
|
|
Kod: (defun c:deneme (/ cap1 cap2 nok1 nok2 xnok1 xnok2) (setvar "cmdecho" 0) (setq nok1 (getpoint "\n bir nokta giriniz")) (setq nok2 (getpoint nok1 "\n ikinci noktayı giriniz")) (setq xnok1 (car nok1)) (setq cap1 0) (setq cap2 2.5) (setq cap3 0) (setq cap4 2.5) (command "line" nok1 nok2 "") (command "donut" cap1 cap2 nok1 "") (command "donut" cap3 cap4 nok2 "") (princ)) - Son satırdaki (princ) kodu işlem bitince nil ifadesini yazdırmaz. - 4ncü satırda getpoint ifadesinden sonra ilk noktanın girdisini yazarsan ilk nokta ile ikinci nokta arasında sanal bir çizgi görünecektir. - tüm nesneler polyline olmaz. yanlış görmüşsün. gördüğüne emin isen bunlar line ve donut değildir. donut nesnesi kapalı bir polyline olduğu için hiçbir çizgi ile birleştirilemez. gördüğün nesneler farklıdır.
|
|
21.11.2011 14:04
cagrikara
|
|
Şimdi bu verdiğiniz kodu bir not defterine kopyaladım ve farklı kaydet olarak uzantısını .Lsp olarak kaydettim. kaydettiğim dosyayı autocadin yüklü olduğu dosyaların içinde bir klasör açıp o klasörün içine kopyaladım. dosyamın ismi nokta.Lsp autocadi açıyorum komut satırına appload yazıp bu lispi tanıtıyorum ve sonra komut satırına nokta ya da nokta.Lsp yazdığımda bu lisp çalışması gerekmiyormu ? ben mi yanlışlık yapıyorum ? bir de şunu sorayım autocad ekranında 2 noktayı seçtiğimde onları kısaca line ile birliştirmemin yolu varmı ? cevaplarınız için şimdiden teşekkür ederim
|
|
ProhibiT
|
|
"appload yazıp lisp'i" tanıtmıyorsunuz... load ediyorsunuz (yüklüyorsunuz). bundan sonra komut satırından komut adı olan "deneme" girmeniz gerekiyor.
|