20.12.2009 14:10    

ProhibiT
Merhaba arkadaşlar,

Basit bir AutoLisp Program paylaşmak istiyorum sizlerle. Ne zaman yazdığımı hatırlamıyorum,
epeyce eski, şöyle bir gözden geçirip paylaştım.
Mimari Projelerde veya  Elektrik Projelerinde Asma Tavan İzdüşüm Planı (Reflected Ceiling Plan) çizen arkadaşlarımızın işine yarayabilir diye düşündüm.
Bunun yanında, AutoLisp yazan arkadaşlarımız için de ilginç bir örnek olabilir.

İlk dosyamız bir -.dcl (Dialog Conrol Language) dosyası.
Buradan kopyalayıp "KaroLaj.dcl" olarak kaydetmelisiniz.
Kod:

karolaj : dialog {
  label = "**** KaRoLaj ****";
  : boxed_column {
    label = "";
    : boxed_row {
      label = "Karolaj Aralıkları (Units)";
      fixed_width = true;
      : edit_box {
        label = "X Aralığı:";
        key = "krx";
        mnemonic = "X";
        edit_width = 5; }
      spacer;
      : edit_box {
        label = "        Y Aralığı:";
        key = "kry";
        mnemonic = "Y";
        edit_width = 5; }}
    : boxed_radio_column {
      label = "Karolaj Hizalama Seçenekleri";
      : radio_button {
        width = 27;
        label = "İki Yönde Ortala";
        key = "ktp1"; }
      : radio_button {
        width = 27;
        label = "Soldan Hizala, Düşey Ortala";
        key = "ktp2"; }
      : radio_button {
        width = 27;
        label = "Sağdan Hizala, Düşey Ortala";
        key = "ktp3"; }
      : radio_button {
        width = 27;
        label = "Üstten Hizala, Yatay Ortala";
        key = "ktp4"; }
      : radio_button {
        width = 27;
        label = "Alttan Hizala, Yatay Ortala";
        key = "ktp5"; }
      : radio_button {
        width = 27;
        label = "Üstten-Soldan Hizala";
        key = "ktp6"; }
      : radio_button {
        width = 27;
        label = "Üstten-Sağdan Hizala";
        key = "ktp7"; }
      : radio_button {
        width = 27;
        label = "Alttan-Soldan Hizala";
        key = "ktp8"; }
      : radio_button {
        width = 27;
        label = "Alttan-Sağdan Hizala";
        key = "ktp9"; }
      }
      spacer;
      ok_cancel;
      spacer;
      : boxed_column {
        : text {
          alignment = centered;
          key = "cpr";
          is_bold = true; }
        spacer; }}
    spacer;
  }

İkinci dosyamız AutoLisp Code dosyası.
Buradan kopyalayıp, "KaroLaj.lsp" olarak kaydetmelisiniz.
Kod:

;============================================================
;  KAROLAJ.LSP İki koşe noktasi ile belirlenen bölgede,      
;  her iki doğrultuda, seçilen kriterlerde ve boyutlarda     
;  karolaj cizer. Karolaj.dcl dosyasini kullanir.            
;  Hazırlayan: M. Şahin Güvercin sahinguvercin@hotmail.com   
;============================================================
(defun C:KAROLAJ ()
  (setvar "cmdecho" 0) (command "undo" "group")
  (if (= boyx nil) (setq boyx 60.00)) (if (= boyy nil) (setq boyy 60.00))
  (if (= ktp nil) (setq ktp 1))
  (if (< (setq dcl_id (load_dialog "karolaj.dcl")) 0) (exit))
  (setq what_next 0)
  (while (< what_next 1)
    (if (not (new_dialog "karolaj" dcl_id)) (exit))
    (set_tile "krx" (rtos boyx 2 2))
    (set_tile "kry" (rtos boyy 2 2))
    (set_tile "cpr" "Hazırlayan: M.Şahin Güvercin")
    (cond ((= ktp 1) (set_tile "ktp1" "1")) ((= ktp 2) (set_tile "ktp2" "1"))
          ((= ktp 3) (set_tile "ktp3" "1")) ((= ktp 4) (set_tile "ktp4" "1"))
          ((= ktp 5) (set_tile "ktp5" "1")) ((= ktp 6) (set_tile "ktp6" "1"))
          ((= ktp 7) (set_tile "ktp7" "1")) ((= ktp 8) (set_tile "ktp8" "1"))
          ((= ktp 9) (set_tile "ktp9" "1"))
    )
    (action_tile "krx" "(setq boyx (atof (get_tile "krx")))")
    (action_tile "kry" "(setq boyy (atof (get_tile "kry")))")
    (action_tile "ktp1" "(setq ktp 1)") (action_tile "ktp2" "(setq ktp 2)")
    (action_tile "ktp3" "(setq ktp 3)") (action_tile "ktp4" "(setq ktp 4)")
    (action_tile "ktp5" "(setq ktp 5)") (action_tile "ktp6" "(setq ktp 6)")
    (action_tile "ktp7" "(setq ktp 7)") (action_tile "ktp8" "(setq ktp 8)")
    (action_tile "ktp9" "(setq ktp 9)")
    (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 2)")
    (setq what_next (start_dialog))
  )
  (if (= what_next 1)
    (progn
      (setq brnc (getpoint "\n-Birinci kose...: ")
            iknc (getpoint "\n-Ikinci kose....: ")
            xx1 (car brnc) yy1 (cadr brnc) xx2 (car iknc) yy2 (cadr iknc))
      (if (< xx1 xx2)
        (if (< yy1 yy2) (setq x1 xx1 y1 yy1 x2 xx2 y2 yy2) (setq x1 xx1 y1 yy2 x2 xx2 y2 yy1))
        (if (< yy1 yy2) (setq x1 xx2 y1 yy1 x2 xx1 y2 yy2) (setq x1 xx2 y1 yy2 x2 xx1 y2 yy1)))
      (setq lmx (- x2 x1) lmy (- y2 y1) xadet (fix (/ lmx boyx)) xreal (/ lmx boyx))
      (if (>= (- xreal xadet) 1) (setq xadet (+ 1 xadet)))
      (setq xartk (- lmx (* xadet boyx)) yadet (fix (/ lmy boyy)) yreal (/ lmy boyy))
      (if (>= (- yreal yadet) 1) (setq yadet (+ 1 yadet)))
      (setq yartk (- lmy (* yadet boyy)))
      (cond ((= ktp 1)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl (+ y1 (/ yartk 2)))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 2)
             (progn (setq xbsl x1 ybsl (+ y1 (/ yartk 2)) xbsl (+ xbsl boyx) xadet (- xadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 3)
             (progn (setq xbsl (+ x1 xartk) ybsl (+ y1 (/ yartk 2)) xadet (- xadet 1))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 2)))))
            ((= ktp 4)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl (+ y1 yartk))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (setq yadet (- yadet 1))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 5)
             (progn (setq xbsl (+ x1 (/ xartk 2)) ybsl y1)
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 2)))
               (setq ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
            ((= ktp 6)
             (progn (setq xbsl x1 ybsl (+ y1 yartk) xbsl (+ xbsl boyx) xadet (- xadet 1) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 7)
             (progn (setq xbsl (+ x1 xartk) ybsl (+ y1 yartk) xadet (- xadet 1) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xbsl (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq ybsl (+ ybsl boyy) yadet (- yadet 1)))))
            ((= ktp 8)
             (progn (setq xbsl x1 ybsl y1 xbsl (+ xbsl boyx) xadet (- xadet 1) ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
            ((= ktp 9)
             (progn (setq xbsl (+ x1 xartk) ybsl y1 xadet (- xadet 1) ybsl (+ ybsl boyy) yadet (- yadet 1))
               (if (< xartk 0.00005) (setq xbsl  (+ xbsl boyx) xadet (- xadet 1)))
               (if (< yartk 0.00005) (setq yadet (- yadet 1)))))
      )
      (entmake (list (cons 0 "LINE") (cons 10 (list x1 ybsl)) (cons 11 (list x2 ybsl))))
      (command "array" "l" "" "r" (+ 1 yadet) "1" boyy)
      (entmake (list (cons 0 "LINE") (cons 10 (list xbsl y1)) (cons 11 (list xbsl y2))))
      (command "array" "l" "" "r" "1" (+ 1 xadet) boyx)
    )
  )
  (command "undo" "e")
  (prin1)
)

Sözkonusu dosyaları "c:\Program Files\AutoCADXXXX\Support" Klasörüne kopyalamanızı tavsiye
ederim. Copy-Paste ile uğraşmak istemeyenler için hazır dosyaların linki; 174410-karolaj.rar
AutoCAD komut satırından (load "karolaj.lsp") komutuyla yükleyebileceğiniz gibi,
AppLoad ile de yükleyebilirsiniz. Komut adı: KaroLaj

Selamlar, Sevgiler, Herkese Kolay Gelsin...

ProhibiT (24.07.2012 17:27 GMT)

20.12.2009 14:56    

Harbi65
Burda ki tırnaklar fazla sanırım...
(action_tile "krx" "(setq boyx (atof (get_tile "krx")))")
(action_tile "kry" "(setq boyy (atof (get_tile "kry")))")

Sonda da Array komutunda hata veriyor.
One-element array, nothing to do.
; error: Function cancelled

20.12.2009 15:52    

ProhibiT
code braketi içinde öyle çıkıyorlar, aslında kırmızı ile işaretlediğiniz " lar \" şeklinde olacaklar. Böyle bir aksaklık başa gelebilir düşüncesiyle, rapid'e yükleyip linkte vermiştim :)
Şimdi çift \ yazarak düzelttim. Array'deki hata da buradan kaynaklanıyor...
Bir daha dener misiniz?

ProhibiT (20.12.2009 15:58 GMT)

23.07.2012 14:37    

poseidoon
Error veriyor komut. Son halini yuklediniz mi?

24.07.2012 14:30    

poseidoon
Bir daha dener misiniz? yazmissiniz ya nerden bir daha deneyecegiz. LISP i yukledim fakat komutu yazip enterlayinca hata veriyor

24.07.2012 17:44    

ProhibiT
"Error veriyor komut" ne demek?
"komutu yazip enterlayinca hata veriyor" ne demek?
O kadar tanımsız tarifsiz sorular soruluyor ki... Mesajı görüyorum, anlam veremediğim için ne cevap yazacağımı bilemiyorum. İnat ve sabırla tanımsız sorularınızı tekrar tekrar yazıyorsunuz. Bu fonksiyonu yaklaşık 20 yıldır kullanıyorum. Hata falan vermez. Hangi sınırlar içinde, hangi mantıkla çalıştığını da zaten yazmışım. "Hata veriyor" diye değil de, "ben nerede yanlış yapıyorum" yaklaşımıyla, sorularınızı daha özenli yazarsanız, yaşadığınız problemi net olarak tanımlarsanız cevapsız kalmayacağından emin olabilirsiniz. 174410-karolaj.rar linkinden AutoLISP ve DCL dosyalarının son halini indirebilirsiniz.

25.07.2012 08:24    

sibelkarali
Kolay gelsin Arkadaşlar;
Ben modülasyon işiyle uğraşıyorum. Plaklar ile cephe döşeme modülasyonu yapıyorum. Modülasyon yaptığım plağın içerisinde en- boy -kalınlık -kullanan malzeme cinsini yazan attribute blok ile plak tanımını yazıyorum.uygulamada okunup montajının doğru yapılması için. Plakla beraber tanımını blok yapıyorum. Yaptığım bloğa gene plağı tanımlayan ölçüleri en-boy-kalınlık-cins şeklinde isimlendiriyorum.Bunu eattext komutu ile saydırıp hazırladığım excel dosyasına atıyorum. burda en boy-kalınlık cins olarak ayrıştırıp metraj çıkarıyorum. Oldukça zor oluyor.Çizilen bir dikdörtgenin boyutlarına göre attribute yapan ve blok içine alınan attributten veri alarak blok ismini otomatik yazan bir lisp varmı.yada seçilen dikdörtgenin boyutlarını okutup liste lahine getirebilirmiyim.

07.07.2015 07:56    

ersintora
Hocam gerçekten işime yarayacak bir lisp ama alçıpan bantlı karolaj olduğunda uğraştırıyor. Bununla ilgili çözüm sunabilir misiniz?

29.07.2015 12:08    

güngör özay
Ellerinize saglik cok guzel olmus...

05.08.2015 15:23    

bud_0782
teşekkürler

> 1 <
Copyright © 2004-2022 SQL: 1.304 saniye - Sorgu: 71 - Ortalama: 0.01837 saniye