15.12.2012 07:02    

volkan_25
elerinize sağlılk teşekkür ederim hocam

15.12.2012 07:34    

ProhibiT
Bu işlemi yapmak için tren gibi kod yazıp sürüyle değişken tutmaya, object snap'i kapatıp açarken kaybetme riskine girmeye gerek yok ki.
Kod:

(defun C:sp  (/ p1 p2)
  (setq p1 (getpoint "\nFirst point: "))
  (if (not (setq p2 (getcorner p1 "\nOther point: "))) (exit))
  (entmake (list (cons 0 "Solid") (cons 100 "AcDbEntity")
    (cons 100 "AcDbTrace") (cons 10 p1) (cons 11 (list (car p2) (cadr p1)))
    (cons 12 (list (car p1) (cadr p2))) (cons 13 p2) (cons 39 0.0))) (prin1))

15.12.2012 08:56    

ehya
şahin hocam arkadaşın gönderdiği lisp pencere içine solid nesnesi yapmasından ziyade, hava boşluğu ifadesinde çapraz solid atıyor.
Yanlış anladınız sanırım..

15.12.2012 10:20    

ProhibiT
Mehmet hocam, yanlış anlamak ne kelime :) hiç anlamadan doğrudan cep telefonumdan yazıvermiştim :) Ama hala aynı fikirdeyim, daha sağlam yazılabilir. Bilgisayar başına geçince bakarım.

15.12.2012 10:33    

ehya
:) hocam siz öyle dedikten sonra bize söz söylemek düşmez :)

15.12.2012 11:56    

ProhibiT
Kod:

(defun c:sp  (/ p1 p2 x y d)
  (setq p1 (getpoint "\nFirst point: "))
  (if (not (setq p2 (getcorner p1 "\nOther point: "))) (exit))
  (setq x(vl-sort(list(car p1)(car p2))'<) y(vl-sort(list(cadr p1)(cadr p2))'<)
        d (if (< (- (nth 1 x) (nth 0 x)) (- (nth 1 y) (nth 0 y)))
          (- (nth 1 x) (nth 0 x)) (- (nth 1 y) (nth 0 y)))
        p1 (list (+ (nth 0 x) (/ d 20)) (+ (nth 0 y) (/ d 20)))
        p2 (list (- (nth 1 x) (/ d 20)) (- (nth 1 y) (/ d 20))))
  (entmake (list(cons 0 "Solid")(cons 10 p1)(cons 11 (list (car p1)(cadr p2)))
    (cons 12(list(+(car p1)(/ d 5))(-(cadr p2)(/ d 5))))(cons 13 p2)))(prin1))

18.12.2012 09:13    

alfaoz
arkadaşlar merhaba;

konuyu autocad başlığında da açmıştım aslında ama şimdi doğru yerinde yazdığıma inanıyorum. ben lisp uzmanlarından ricam list komutuyla nesnelerin çevre ve alan değerlerini bulmak nesne sayısı arttığında tam bir işkenceye dönüşüyor. bunu nesneleri seçtiğimde bana bir tablo olarak dökmesi mümkün müdür? mesela excele aktarsa süper olur. bir arkadaşın çalışması vardı polyline larla ilgili güzel bir çalışma olmuştu ancak polyline çizgileri dışında çalışmıyor malesef. nesneleri toplu veya tek tek seçme imkanımız da olsa harika olur. bunu list komutu yapıyor aslında ama ben orda görmek istemediğim verileri saklayamıyor ve nesne sayısı artıkça da list komutu tam bir işkenceye dönüşüyor. umarım sorunumu yeterince açık yazabildim ve umarım yardımcı olursunuz. (forumu biraz araştırınce cevap almak için bence şimdi en doğru yere yazdım.)

bunula ilgili başka bir arkadaşımın güzel bir çalışması vardı. ancak benim için bazı eksikleri. sırf bunları giderseniz bile müteşekkir olurum.
58803-polyline.txt

burdaki çalışmaya ek benim sizden ricam pencere açarak toplu seçim yapabilmek polyline dışındaki çizgileri de seçebilmek bir de hangi çizgileri seçtiğimi görebilmek için seçtiğimde aktif olması. mümkünse quick select özelliği gibi seçimi layer olarak renk olarak çizgi kalınlığı olarak vs. seçebilmek ve verileri excel ortamında görüntülemek. belki çok şey istedim ancak bazen bir şey istersiniz saatler sürer bazen on şey istersiniz dakikalarınızı bile almaz. o yüzden iş yükü olarak kestiremediğim isteklerim çok fazlaysa affola lütfen. yardımlarınız için şimdiden teşekkürler.

kod paylaşımını yapamadım sanırım özür dilerim ancak ekli dosyayı açarak görüntüleyebilirsiniz. kusuruma bakmayın lütfen...

19.12.2012 15:42    

ProhibiT
Yazar arkadaşlarımızla bazı Algoritmik teknikleri paylaşmak, ipuçları vermek amacıyla yazılmıştır.
Bu nedenle, değişiklik veya ekleme isteklerine cevap vermeyeceğimi üzülerek belirtmek isterim. :)

Seçilen (biribirine Paralel) İki Doğru arasında 12 m.'lik Donatı Çeliği boyunu esas alarak alt ve Üst donatı işlenir.
Verilen Donatı Çapı, Aralığı ve Hesaplanan Donatı boyu çubukların üstüne yazılır.
Seçilen doğrular herhangi bir yön ya da doğrultuda olabilirler. Prensip olarak seçilen ilk doğrunun başlangıç noktası (Start Point) ndan, seçilen ikinci doğruya dik inilerek bulunan açıklık, Çubuk boyları 12 m'yi geçmeyecek şekilde düzenlenir.
Kod:

;|***************************************************************************|
| DD: Betonarme Plaklara Pliyesiz, Gönyesiz ve Şaşırtmasız Donatı İşleme    |
|                      M. Şahin Güvercin  www.cizimokulu.com  19.12.2012    |
|---------------------------------------------------------------------------|;
(defun sdr0  (p0 p1 p2 p3 p4 p5 p6 p7 p8 /)
  (sdr1 p1 p2 p0 p4 p3 p6 p7 p8)
  (setq p1 (list (+ (car p1) (* p5 (cos p3))) (+ (cadr p1) (* p5 (sin p3))))
        p2 (list (+ (car p2) (* p5 (cos p3))) (+ (cadr p2) (* p5 (sin p3))))
        p4 (list (+ (car p4) (* p5 (cos p3))) (+ (cadr p4) (* p5 (sin p3)))))
  (sdr1 p1 p2 p0 p4 p3 p6 p7 p8))
;|---------------------------------------------------------------------------|;
(defun sdr1  (p10 p11 p12 p13 p14 p15 p16 p17 /)
  (entmake(list(cons 0 "Line")(cons 10 p10)(cons 11 p11)))(ssadd(entlast) p12)
  (entmake(list(cons 0 "Text")(cons 10 p13)(cons 11 p13)(cons 72 1)
          (cons 50 (- p14 (/ pi 2))) (cons 40 (getvar "TextSize"))
          (cons 1 (strcat "%%c" (itoa p15) "/" (rtos p16 2 0) "  L="
     (itoa(fix p17)))))) (ssadd (entlast) p12))
;|---------------------------------------------------------------------------|;
(defun c:DD (/ *error* Adr Ara Ati bSp Cap Dby dn1 n1L dn2 n2L
             Dob L n1 n2 Pas Thc Tip yer)
  (defun *error* (er /)
    (command "Ucs" "z" (- (/ (* Ang 180) pi))) (setvar "OrthoMode" omd)
    (if (= osm 1) (setvar "OsMode" (- (getvar "OsMode") 16384)))
    (command "_.undo" "e") (princ (strcat "\n" err)) (prin1))
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (if (or (/= (setq osm (getvar "OsMode")) 0) (< osm 16384)) (setq osm 1))
  (setq Cap (getint "\n    Donatı Çapı Ø (mm): ")
        Ara (getreal "\n   Donatı Aralığı (cm): ")
        Pas (getreal "\n         Pas Payı (cm): ")
        Thc (- (getreal "\nTabliye Kalınlığı (cm): ") (* 2 Pas))
        Adr (* (getint "\n   Bindirme Boyu (X*Ø): ") Cap 0.1)
        n1  (cdr (assoc 10 (entget(car(entsel "\n     Başlangış Doğrusu: ")))))
        n2  (vlax-curve-getClosestPointTo (vlax-ename->vla-object
              (car (entsel "\n         Bitiş Doğrusu: "))) n1 T)
        bSp (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2)) n1 n2)
        Ang (angle n1 n2)
        Ati (if (and (> Ang (/ pi 2)) (<= Ang (* 1.5 pi)))
              (- Ang (/ pi 2)) (+ Ang (/ pi 2)))
        Dby (- (distance n1 n2) (* 2 Pas))
        dn1 (list (+ (car n1) (* pas (cos Ang)))
                  (+ (cadr n1) (* pas (sin Ang)))) yer 0 Dob  (ssadd) L 1200)
  (while (> Dby 1200) (setq dn2 (list (+ (car dn1) (* 1200 (cos Ang)))
                                      (+ (cadr dn1) (* 1200 (sin Ang)))))
    (if (= yer 1) (setq n1L (list (+ (car dn1) (* 2 pas (cos Ati)))
                                  (+ (cadr dn1) (* 2 pas (sin Ati))))
                        n2L (list (+ (car dn2) (* 2 pas (cos Ati)))
                                  (+ (cadr dn2) (* 2 pas (sin Ati)))) yer 0)
      (setq n1L dn1 n2L dn2 yer  1))
    (setq Tip (list (+ (/ (+ (car n1L) (car n2L)) 2)
                       (* 0.5 (getvar "TextSize") (cos Ati)))
                    (+ (/ (+ (cadr n1L) (cadr n2L)) 2)
                       (* 0.5 (getvar "TextSize") (sin Ati)))))
    (sdr0 Dob n1L n2L Ati Tip Thc Cap Ara L)
    (setq Dby (+ (- Dby 1200) Adr)
          dn1  (list (- (car dn2) (* Adr (cos Ang)))
                     (- (cadr dn2) (* Adr (sin Ang)))))) (setq L Dby)
  (if (not (equal Dby 0 1.0E-16))
    (progn (if (= yer 1)
        (setq n1L (list (- (car dn1) (* 2 Pas (cos Ati)))
                        (- (cadr dn1) (* 2 Pas (sin Ati))))
              n2L (list (+ (car n1L) (* Dby (cos Ang)))
                        (+ (cadr n1L) (* Dby (sin Ang)))))
        (setq n1L dn1 n2L (list (+ (car n1L) (* Dby (cos Ang)))
                                  (+ (cadr n1L) (* Dby (sin Ang))))))
      (setq Tip (list (+ (/ (+ (car n1L) (car n2L)) 2)
                         (* 0.5 (getvar "TextSize") (cos Ati)))
                      (+ (/ (+ (cadr n1L) (cadr n2L)) 2)
                         (* 0.5 (getvar "TextSize") (sin Ati)))))
      (sdr0 Dob n1L n2L Ati Tip Thc Cap Ara L)))
  (if (= osm 1) (setvar "OsMode" (+ (getvar "Osmode") 16384)))
  (if (= (setq omd (getvar "OrthoMode")) 0) (setvar "OrthoMode" 1))
  (command "Ucs" "z" (/ (* Ang 180) pi))
  (command "_.Move" Dob "" (trans bSp 0 1) Pause)
  (command "Ucs" "z" (- (/ (* Ang 180) pi))) (setvar "OrthoMode" omd)
  (if (= osm 1) (setvar "OsMode" (- (getvar "OsMode") 16384)))
  (command "_.undo" "e") (prin1)) (princ "\nAuthor: M. Şahin Güvercin") (prin1)
;|---------------------------------------------------------------------------|;
Kolay gelsin...

21.12.2012 12:49    

CAN123
Alıntı
CAN123 :
Arkadaşlar merhaba,

Birbirine paralel olan üç çizgi var ve bu çizgiler arasındaki mesafeleri seçeceğim texte ekletmek istiyorum. Şöyleki seçeceğim iki çizgi arasındaki mesafe "A" olsun ikinci kez seçeceğim çizgiler arasındaki mesafede "B" olsun. Bu mesafeleri seçeceğim textin içerisine başında "L" olacak ve ardından "A"x"A"x"B" ve devamında üç noktadan sonra seçeceğim herhangi bir çizginin uzunlugunu ekletecek bir lisp. (L60x60x6...1500 şeklinde) Umarım anlatabilmişimdir.

Teşekkur ederim.



Arkadaşlar eğer çok zaman alacak bir lisp değilse bu lispe ihtiyacım var.

yardımcı olabilecek arkadaslara şimdiden çok teşekkur ederim

21.12.2012 22:41    

Travaci
Alıntı
CAN123 :



Birileri daha iyisini yapana kadar idare edicektir. : )
Kod:

(defun c:LbY (/ n dis n1 dis1 ent on bir dat dat wrt)
   (setq n (getpoint "\nBirinci ölçü alınacak noktalar: ")
         dis (rtos (getdist n) 2 0)
         n1 (getpoint "\n İkinci ölçü alınacak noktalar: ")
         dis1 (rtos (getdist n1) 2 0)
         ent (entsel "\n   Ölçüsü alınacak çizgi: ")
         on (cdr (assoc 10 (entget (car ent))))
         bir (cdr (assoc 11 (entget (car ent))))
         cdis (rtos (distance on bir) 2 0)
         dat (strcat  "L" dis "x"dis"x"dis1 "..." cdis)
         data (entget (car (entsel "\n    Yazılacak yazıyı seçiniz: ")))
         wRt (assoc 1 data)
         data (subst (cons 1 dat) wRt data)) (entmod data) (princ))

22.12.2012 08:01    

CAN123
Travaci hocam çok teşekkür ederim. Yazdığınız lisp işimi çok kolaylaştıracak. Eğer vaktinizi çok almayacaksa iki şey isteyeceğim. Birincisi noktalar arası seçim değilde birbirine paralel olan çizgileri seçip bunların ara mesafelerini yazıya aktarabilir miyiz? İkincisi ise yazıya eklettiğimiz çizgi boyunu üste ya da alta yuvarlıyor. Bunu .5'ede yuvarlattırabilir miyiz? örneğin çizgi boyu 1256.3 ise 1256.5, 1256.8 ise 1257'ye yuvarlatmak gibi.

çok teşekkur ederim.

Ellerinize sağlık.

22.12.2012 10:33    

Travaci
Denerim : )

22.12.2012 12:35    

alfaoz
Alıntı
alfaoz :
arkadaşlar merhaba;

konuyu autocad başlığında da açmıştım aslında ama şimdi doğru yerinde yazdığıma inanıyorum. ben lisp uzmanlarından ricam list komutuyla nesnelerin çevre ve alan değerlerini bulmak nesne sayısı arttığında tam bir işkenceye dönüşüyor. bunu nesneleri seçtiğimde bana bir tablo olarak dökmesi mümkün müdür? mesela excele aktarsa süper olur. bir arkadaşın çalışması vardı polyline larla ilgili güzel bir çalışma olmuştu ancak polyline çizgileri dışında çalışmıyor malesef. nesneleri toplu veya tek tek seçme imkanımız da olsa harika olur. bunu list komutu yapıyor aslında ama ben orda görmek istemediğim verileri saklayamıyor ve nesne sayısı artıkça da list komutu tam bir işkenceye dönüşüyor. umarım sorunumu yeterince açık yazabildim ve umarım yardımcı olursunuz. (forumu biraz araştırınce cevap almak için bence şimdi en doğru yere yazdım.)

bunula ilgili başka bir arkadaşımın güzel bir çalışması vardı. ancak benim için bazı eksikleri. sırf bunları giderseniz bile müteşekkir olurum.
58803-polyline.txt

burdaki çalışmaya ek benim sizden ricam pencere açarak toplu seçim yapabilmek polyline dışındaki çizgileri de seçebilmek bir de hangi çizgileri seçtiğimi görebilmek için seçtiğimde aktif olması. mümkünse quick select özelliği gibi seçimi layer olarak renk olarak çizgi kalınlığı olarak vs. seçebilmek ve verileri excel ortamında görüntülemek. belki çok şey istedim ancak bazen bir şey istersiniz saatler sürer bazen on şey istersiniz dakikalarınızı bile almaz. o yüzden iş yükü olarak kestiremediğim isteklerim çok fazlaysa affola lütfen. yardımlarınız için şimdiden teşekkürler.

kod paylaşımını yapamadım sanırım özür dilerim ancak ekli dosyayı açarak görüntüleyebilirsiniz. kusuruma bakmayın lütfen...



lütfen bi destek de bana... :(

23.12.2012 20:56    

ProhibiT
Kod:

;|***************************************************************************|
| PnT: Excel dosyasında yazılı koordinatlara göre                           |
|      AutoCAD Drawing dosyasında Nokta dökümü                              |
|      M. Şahin Güvercin  www.cizimokulu.com  23.12.2012                    |
|---------------------------------------------------------------------------|;
(defun c:PnT (/ Txh Nk Pf Xk Yk Zk Zkd)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setq Txh (getvar "TextSize")
        Pf (open (getfiled "Koordinat Dosyası" "" "" 4) "r"))
  (while (setq Nk (read-line Pf))
    (setq Xk (atof (substr Nk 1 (vl-string-position 9 Nk)))
          Nk (substr Nk (+ (vl-string-position 9 Nk) 2))
          Yk (atof (substr Nk 1 (vl-string-position 9 Nk)))
          Zk (atof (substr Nk (+ (vl-string-position 9 Nk) 2))))
    (entmake (list (cons 0 "Point") (cons 10 (list Xk Yk Zk))))
    (if(="."(substr(setq Zkd (rtos Zk)) 1 1))(setq Zkd(strcat "0"Zkd)))
    (entmake(list(cons 0 "Text")(cons 10(mapcar'(lambda(p1 p2)(+ p1 p2))
                                  (list Xk Yk Zk)(list(/ Txh 2)(/ Txh 2)0)))
                 (cons 40 Txh)(cons 1 Zkd)(cons 50 0)(cons 72 0))))
  (close Pf) (command "_.undo" "e") (princ))

- Nokta koordinatlarının bulunduğu Excel dosyasını açıp, Ctrl+A ve Ctrl+C tuş kombinasyonlarını uygulayın.
- NotDefteri ile açacağınız yeni bir dosyaya Ctrl+V uygulayarak paste edin.
- İstediğiniz bir dosya adı ve uzantısıyla, istediğiniz bir konuma kaydedin.
- PnT fonksiyonunu çalıştırıp, açılan diyalog penceresinden oluşturduğunuz dosyayı seçin.

24.12.2012 23:40    

Travaci
Alıntı
CAN123 :



Yapamadım bilginize, çok saçma ve gereksiz şeylerle doldurucaktım sağlıklı çalışmıyacaktı, yapabilirseniz benim içinde iyi olur.

25.12.2012 09:40    

CAN123
Travacı hocam ilginiz için teşekkur ederim. Umarım sayın hocalarımız bu konuda yardımcı olabileceklerdir.

teşekkurler

25.12.2012 12:25    

ProhibiT
Konuyu kimse kişisel algılamasın lütfen, burada sıkça yapılan hataları örneklemekten başka amacım yok.

Öncelikle tüm arkadaşlarımızın "Forum Kuralları" nı mutlaka okumalarını, hatta buradan daha çok verim elde etmek, faydalanmak isteyen arkadaşlarımızın

Linkleri görebilmek için ÜYE olmalısınız.

linkindeki "Doğru Soru Sormak!" konulu yazıyı da okumalarını tavsiye ediyorum.

Arkadaşlarımızın samimiyetinden, kendine, çevresine ve ortama gösterdikleri saygıdan ve nezaketlerinden hiç bir şüphemiz yok. Verdiğim linkteki yazı okununca, Doğru Soru Sorulduğunda cevabın çok daha kolay alınacağı anlaşılacak, Doğru Sorunun nasıl sorulacağı konusunda güzel yöntemler öğrenilecektir.

Kod:

;|***************************************************************************|
| PDL: Profile Dimesions Label                                              |
|      Görünüş çizgileri seçilen Köşebentin boyut etiketi                   |
|      mevcut Text (veya MText) objesine işlenir.                           |
|      M. Şahin Güvercin  www.cizimokulu.com  25.12.2012                    |
|---------------------------------------------------------------------------|;
(defun c:PDL (/ ds1 ds2 ds3 kk ksr Ln1 Ln2 Ln3 PnT)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (setq Ln1 (car (entsel "\nProfil Sırt Çizgisi: ")) Kk  (redraw Ln1 3)
        Ln2 (car (entsel "\n  Profil Uç Çizgisi: ")) Kk  (redraw Ln2 3)
        Ln3 (car (entsel "\n   Flanş İç Çizgisi: ")) Kk  (redraw Ln3 3)
        PnT (vlax-safearray->list (vlax-variant-value
                (vlax-get-property (vlax-ename->vla-object Ln1) 'StartPoint)))
        ds1 (rtos (distance Pnt (vlax-curve-getClosestPointTo
                                  (vlax-ename->vla-object Ln2) PnT T)) 2 0)
        ds2 (rtos (distance PnT (vlax-curve-getClosestPointTo
                                  (vlax-ename->vla-object Ln3) PnT T)) 2 0)
        ds3 (rtos (vlax-get-property (vlax-ename->vla-object Ln1) 'Length) 2 1)
        ksr (atoi (substr ds3 (strlen ds3) 1)))
  (if (wcmatch ds3 "*.*") ;;; Küsüratın simetrik yuvarlanması
    (cond ((< ksr 3) (setq ds3 (substr ds3 1 (- (strlen ds3) 2))))
          ((and (> ksr 2) (< ksr 8))
           (setq ds3 (strcat (substr ds3 1 (1- (strlen ds3))) "5")))
          ((> ksr 7) (setq ds3 (rtos (+ (atof ds3) (- 1 (/ ksr 10.0))) 2 1)))))
  (vlax-put-property (vlax-ename->vla-object (car (entsel "\n Text Objesi: ")))
    'TextString (strcat "L" ds1 "x" ds1 "x" ds2 "..." ds3))
  (redraw Ln1 4) (redraw Ln2 4) (redraw Ln3 4) (command "_.undo" "e") (princ))

Profilin görünüşünü tanımlayan çizgilerin belli bir sıra dahilinde seçildiklerine dikkat ediniz. Yazar arkadaşlarımızın, Küsuratın, Buçuğa Göre Simetrik Yuvarlanması ve Leading/Trailing kavramlarının nasıl çözüldüğüne dikkat edip incelemelerini tavsiye ederim.

26.12.2012 18:58    

kerem1453
yükseklige göre yazı seçen lisp varmı ? yada yazılabilirmi ?

26.12.2012 21:00    

ehya
Kerem1453


Filter komutunda "Text Height" seçeneğini kullanarak yüksekliğe göre yazıları seçebilirsiniz.

27.12.2012 06:33    

kerem1453
tşkler ehya bu fazlasıyla işimi görür sagol...

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] > 35 < [40] [45] [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] [97] Sonraki Sayfa
Copyright © 2004-2022 SQL: 0.455 saniye - Sorgu: 98 - Ortalama: 0.00465 saniye