21.11.2011 20:39    

Travaci
Alıntı
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.



Yardımcı olduğunuz için teşekkür ederim.

22.11.2011 04:08    

cagrikara
Alıntı
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.




bu sorumun cevabını alabilecekmiyim ?

22.11.2011 09:04    

ProhibiT
Kod:

;| Nokta numaralarının belirli bir Layer'da ve sayısal yada alfasayısal       |
|  Text objeleri oluduğu kabul edilir. Son girilen "...To Point" bir sonraki  |
|  "from point..." için teklif olarak getirilir. Son çizilen Noktadan devam   |
|  etmek için "Enter" girilmelidir. Belirlenen noktalar arasında oluşturulan  |
|  Line objeleri geçerli Layer, CoLor, LineType... öz niteliklerine sahip     |
|  olacaktır. Fonksiyonu sonlandırıp çıkmak için "...to point" sorusuna       |
|  "Enter" ile Boş cevap girmek yeterlidir.                                   |
|  Hazırlayan: M. Şahin Güvercin  01.12.2011  www.autocadokulu.com           |;
(write-line "\n Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:kNtR (/ Lyr nNo L n tP aSc fP)
  (setq em "\n M. Şahin Güvercin - www.autocadokulu.com")
  (defun *error* (er) (princ er) (setq *error* nil) (princ em))
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (write-line "\nHerhangi bir Nokta Numarası seçiniz: ")
  (setq Lyr (ssget ":s" (list (cons 0 "Text")))
        Lyr (cdr (assoc 8 (entget (ssname Lyr 0))))
        nNo (ssget "x" (list (cons 0 "Text") (cons 8 Lyr)))
        L   (sslength nNo) n -1 aSc nil tP T)
  (while (< (setq n (1+ n)) L)
    (setq aSc (append aSc
                  (list (cons (cdr (assoc 1 (entget (ssname nNo n))))
                              (cdr (assoc 10 (entget (ssname nNo n)))))))))
  (while (not (assoc (setq fP (getstring T "\n from point...")) aSc))
    (write-line (strcat "\n * "" fP "" Nokta Numarası Bulunamadı!")))
  (while tP (while
      (and (not (assoc (setq tP
                              (getstring T "\n ...to point")) aSc)) (/= tP ""))
       (write-line (strcat "\n * "" tP "" Nokta Numarası Bulunamadı!")))
    (if (= tP "") (exit)
      (entmake (list (cons 0 "Line") (cons 10 (cdr (assoc fP aSc)))
                     (cons 11 (cdr (assoc tP aSc))))))
    (while (and (assoc fP aSc)
           (/= (setq fP
                     (getstring T (strcat "\n from point... <" tP ">: "))) ""))
      (write-line (strcat "\n * "" fP "" Nokta Numarası Bulunamadı!")))
    (if (= fP "") (setq fP tP)))
  (setq *error* nil) (command "_.undo" "e") (princ)
)

ProhibiT (01.12.2011 17:34 GMT)

22.11.2011 12:39    

selkaf
arkadaşlar merhaba ben ahmet sorum şu olacak ... autocad'te imar kordinatlarıyla hazırlanmış bir dosya'yı memleket kordinatlarına çevire bilen bir lisp varmı veya bu anlamda autocad te nasıl bir yol izlemeliyim bilen varsa yardımlarını bekliyorum şimdiden teşekkür ederim...

ProhibiT (25.11.2011 10:08 GMT)

25.11.2011 10:33    

ProhibiT
Merhaba emasi, yaklaşık bir hafta önce yazdığın,

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

deki isteğinle ilgili fonksiyonu aşağıda paylaşıyorum.

Tekrarlanan poz numaralarından hangisini tutup, hangisini değiştireceğini program bilemeyeceğinden, numaraları otomatik olarak düzenleyen fonksiyon yerine, seçilen obje gurubu içindeki poz numaralarını, belirlenen alt ve üst sınırlar arasında artıran veya azaltan bir fonksiyon yazmak daha kullanışlı olur diye düşündüm.

Gönderdiğin örnek drawing'den yola çıkarak yazdım. Fonksiyonun daha genel amaçlı olmasını sağlamak için, Poz numarası Attribute'ünü içinde bulunduran bLock objesini kullanıcının seçimine bıraktım. Seçilen bLock içinde tek bir attribute olduğunu ve bunun da, örnekte P01 olarak Tag'lenen Poz numarası Atrribute'ü olduğunu kabul ettim. Çizimin tamamında işlem yapılabileceği gibi, seçilen bir bölgede, bir seçim setinde, hatta tek bir poz numarası ile bile işlem yapılabilir. Poz numarası Artırma değeri olarak istenen tamsayı (integer) girilebilir. Bu değer negatif (-) olarak girilirse seçilen bölgedeki, belirlenen sınırlar arasındaki poz numaralarına azaltma işlemi uygulanacaktır. Çizim içindeki en küçük ve en büyük poz numaraları bulunarak, alt ve üst sınır değerleri sorulurken ekrana teklif olarak getirilir. Fonksiyon ilk çalıştırıldığında, artış değeri olarak 1 alınır ve ekrana teklif olarak getirilir. Alt ve üst sınır ile artış miktarı değerleri enter girerek geçilirse teklif edilen değerler kabul edilirler.

Kolay gelsin.
Kod:

;|=============================================================================
| Seçilen bLock içindeki Sıralı Poz Numarası içeren Attribute'lerin içeriğini |
| güncelleme ve sıra numaralarını düzenleme işini yapar. Attribute değeri,    |
| tamsayı (integer) olmalıdır. Alt ve Üst sınır ile belirlenen Numaralar      |
| (Alt ve Üst sınır dahil) işleme alınarak istenilen miktarda artırma veya    |
| azaltma yapılır. Çizim içindeki Tüm Poz Attribute'ü içeren bLock'lar        |
| işleme alınabileceği gibi, bir seçim seti ile de işlem yapılabilir.         |
| Hazırlayan: M. Şahin Güvercin  25.11.2011  www.autocadokulu.com             |
============================================================================ |;
(write-line "\n Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:iNdEa (/ iD em reFb bLks Poss aTrs L n PvTA aLtS usTS aLt usT)
  (setvar "cmdecho" 0) (command "_.undo" "group") (if (not iD) (setq iD 1))
  (setq em " M. Şahin Güvercin - www.autocadokulu.com")
  (defun *error* (er) (princ er) (setq *error* nil) (princ em))
  (setq reFb (car (entsel "\n Attribute'leri düzenlenecek Referans bLock: ")))
  (redraw reFb 3) (princ "\r Çizimin tamamı için "aLL" giriniz...")
  (setq bLks (ssget ":s" (list (cons 0 "insert") (assoc 2 (entget reFb))))
        Poss nil aTrs (ssadd) L (sslength bLks) n -1)
  (while (< (setq n (1+ n)) L)
    (if (= (cdr (assoc 0 (entget (setq PvTA (entnext (ssname bLks n))))))
           "ATTRIB")
      (setq Poss (append Poss (list (atoi (cdr (assoc 1 (entget PvTA))))))
            aTrs (ssadd PvTA aTrs))))
  (princ "\n İşleme Alınacak Poz Numaraları için...")
  (setq Poss (vl-sort Poss '<) L (sslength aTrs) n -1
        aLtS (nth 0 Poss) usTS (nth (1- (length Poss)) Poss)
        aLt  (getint (strcat "\n       Alt Sınır <" (itoa aLtS) ">: "))
        usT  (getint (strcat "\r       Üst Sınır <" (itoa usTS) ">: "))
        iNdE (getint (strcat "\r Artırma/Azaltma <" (itoa iD) ">: ")))
  (if (not aLt) (setq aLt aLtS)) (if (not usT) (setq usT usTS))
  (if iNdE (setq iD iNdE) (setq iNdE iD))
  (while (< (setq n (1+ n)) L)
    (setq PvTA (entget (ssname aTrs n)) Poss (atoi (cdr (assoc 1 PvTA))))
    (if (and (>= Poss aLt) (<= Poss usT)) (progn
       (setq PvTA (subst (cons 1 (itoa (+ Poss iNdE))) (assoc 1 PvTA) PvTA))
       (entmod PvTA) (entupd (cdr (assoc -1 PvTA))))))
  (setq *error* nil) (command "_.undo" "e") (princ)
)

ProhibiT (25.11.2011 10:56 GMT)

26.11.2011 06:09    

emasi
Çok teşekkür ederim prohibit abi. ilginiz için teşekkür ederim.
Lispi çalıştırdığımda ve Rference block seçdiyimde şöyle bi şey geliyor Attribute'leri duzenlenecek Referans bLock: bad argument type: FILE nil neden ola bilir?

emasi (26.11.2011 06:14 GMT)

26.11.2011 07:54    

ProhibiT
iNdEa fonksiyonununun dışında başka yerden kaynaklanan bir hata var. Fonksiyonda FILE hiç bir yerde kullanılmıyor ki. Paylaştığınız örnek çizimden yola çıkarak yazdım, test ettim bende problem yok.

26.11.2011 19:09    

ProhibiT
waytooraider arkadaşımızın isteği doğrultusunda yazılan bu fonksiyon, Seçilen Line objelerinin üzerine, kullanıcının belirlediği Çap değerini ve objenin ölçülen uzunluğunu, bLock içinde Attribute olarak yazar.

Fonksiyon çalıştırıldığında;
- Drawing dosyasında EbL isimli bLock tanımı olup olmadığı kontrol edilir
- EbL bLock'u yoksa oluşturulur.
- EbL block'u içinde biri "CAP" Tag'li, "Cap: " prompt'lu, diğeri "BOY" Tag'li, "Boy: " prompt'lu olmak üzere 2 tane attribute bulundurur.
- Cap değerini girmeniz istenir. Söz konusu değer string türünde olduğu için "%%c14" şeklinde girilebilir. Aynen girildiği şekilde ilgili Attribute'e value olarak atanacaktır.
- Line objesi seçmeniz istenir. Tek bir Line objesi seçilebileceği gibi, çoklu obje seçimi de yapılabilir. Window, Crossing gibi yöntemlerle yapılacak seçim tek adımlıdır. AutoCad'in genel object selection mantığında olduğu gibi seçilmeye devam edildikçe "select object(s)..." şeklinde devam etmez. Seçim işleminin sürekliliği fonksiyon içinde döngü ile sağlanmıştır. İstenirse abartıp bu soruya "aLL" şeklinde cevap verilirse drawing dosyasındaki tüm Line objeleri birden işleme alınır.
- Fonksiyondan çıkmadan Çap değerini değiştirmek için "Ölçüsü yazılacak Çizgi(ler) seçiniz: " iletisini enter ile geçmek gerekir.
- Yeni çap değeri bundan sonra seçilen Line objelerine atanarak işleme devam edilir.
- Fonksiyondan tamamen çıkmak için, önce "Ölçüsü yazılacak Çizgi(ler) seçiniz: " iletisini, sonra da "Yeni Çap değeri giriniz: " sorularını enter ile cevaplamak yeterli olacaktır.
Kod:

;|===========================================================================|
| Seçilen çizginin üzerine Çap ve boy bilgilerini Atrribute olarak yazar.   |
| Hazırlayan: M. Şahin Güvercin  26.11.2011  www.autocadokulu.com           |
|===========================================================================|;
(write-line "\n Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:aLd (/ *error* em TsZ scL TxH Cap Czg PvT StP EnP aCi DsT aC0 aC1 MiP
              BiP A1P A2P sOb)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setq em  " M. Şahin Güvercin - www.autocadokulu.com"
        TsZ (getvar "DimTxt") scL (getvar "DimScaLe") TxH (* TsZ scL))
  (defun *error* (er) (princ er) (setq *error* nil) (princ em))
  (if (not (tblsearch "bLock" "EbL")) (progn
      (entmake (list '(0 . "BLOCK") '(8 . "0") '(70 . 2) '(2 . "EbL")
           '(10 0.0 0.0 0.0)))
      (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(8 . "0")
           '(100 . "AcDbText") (cons 10 (list (- 0 Tsz) 0.0 0.0)) (cons 40 TsZ)
           '(1 . "10") '(41 . 1.0) '(72 . 2)
           (cons 11 (list (- 0 TsZ) 0.0 0.0))'(100 . "AcDbAttributeDefinition")
           '(280 . 0) '(3 . "Cap: ") '(2 . "CAP") '(70 . 0) '(280 . 1)))
      (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(8 . "0")
           '(100 . "AcDbText") (cons 40 TsZ) (cons 10 (list TsZ 0.0 0.0))
           '(1 . "1.00")'(41 . 1.0) '(72 . 0) (cons 11 (list Tsz 0.0 0.0))
           '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Boy: ")
           '(2 . "BOY") '(70 . 0) '(280 . 1)))
      (entmake (list '(0 . "ENDBLK")))))
  (setq Cap (getstring "\n Çap değerini giriniz: "))
  (while (/= Cap "") (princ "\r Ölçüsü yazılacak Obje(ler) seçiniz: ")
    (while (setq Czg
               (ssget ":s" (list (cons 0 "Line,*polyline,arc,circle,spline"))))
      (setq L (sslength Czg) n -1)
      (while (< (setq n (1+ n)) L)
        (setq PvT (entget (ssname Czg n)) Tur (cdr (assoc 0 PvT)))
        (cond ((= Tur "LINE")
               (setq StP (cdr (assoc 10 PvT)) EnP (cdr (assoc 11 PvT))
                     aCi (angle StP EnP) DsT (rtos (distance StP EnP)))
               (while (>= aCi pi) (setq aCi (- aCi pi)))
               (if (<= aCi (/ pi 2.0))
                 (setq aC0 aCi aC1 (+ aCi (/ pi 2.0)))
                 (setq aC0 (- aCi pi) aC1 (- aCi (/ pi 2.0))))
               (setq MiP (mapcar '(lambda (pr1 pr2) (/ (+ pr1 pr2) 2.0))
                                 StP EnP)
                     BiP (polar MiP aC1 (* (/ TsZ 2.0) scL))
                     A1P (polar BiP (+ aC0 pi) (* Tsz scL))
                     A2P (polar BiP aC0 (* TsZ scL))))
              ((= Tur "CIRCLE")
               (command "_.Area" "e" (cdr (assoc -1 PvT)))
               (setq DsT (rtos (getvar "perimeter"))
                     Bip (cdr (assoc 10 PvT)) aC0 0
                     A1P (polar BiP (+ aC0 pi) (* TsZ scL))
                     A2P (polar BiP aC0 (* TsZ scL))))
              ((= Tur "POLYLINE")
               (command "_.Area" "e" (cdr (assoc -1 PvT)))
               (setq DsT (rtos (getvar "perimeter")) sOb (entlast))
               (command "_.Divide" (list (cdr (assoc -1 PvT)) (cdr (assoc 10
                                  (entget (entnext (cdr (assoc -1 PvT))))))) 2)
               (setq BiP (cdr (assoc 10 (entget (entlast)))) aC0 0
                     A1P (polar BiP (+ aC0 pi) (* Tsz scL))
                     A2P (polar Bip aC0 (* Tsz scL)))
               (while (setq sOb (entnext sOb)) (entdel sOb)))
              ((= Tur "ARC")
               (setq StP (cdr (assoc 50 PvT)) EnP (cdr (assoc 51 PvT)))
               (if (> StP EnP)
                 (setq aLa (+ (- (* 2 pi) StP) EnP)) (setq aLa (- EnP StP)))
               (setq aLo (+ Stp (/ aLa 2)) Rad (cdr (assoc 40 PvT))
                     DsT (rtos (* (/ aLa (* 2 pi)) (* 2 pi Rad)))
                     BiP (polar (cdr (assoc 10 PvT)) aLo Rad) aC0 0
                     A1P (polar BiP (+ aC0 pi) (* TsZ scL))
                     A2P (polar BiP aC0 (* TsZ scL))))
              ((or (= Tur "LWPOLYLINE") (= Tur "SPLINE"))
               (command "_.Area" "e" (cdr (assoc -1 PvT)))
               (setq DsT (rtos (getvar "perimeter")) sOb (entlast))
               (command "_.Divide" (list (cdr (assoc -1 PvT))
                                         (cdr (assoc 10 PvT))) 2)
               (setq BiP (cdr (assoc 10 (entget (entlast))))
                     A1P (polar BiP pi (* Tsz scL)) aC0 0
                     A2P (polar Bip aC0 (* Tsz scL)))
               (while (setq sOb (entnext sOb)) (entdel sOb))))
        (entmake (list '(0 . "INSERT") '(66 . 1) '(2 . "EbL") (cons 10 BiP)
                      (cons 41 scL) (cons 42 scL) (cons 43 scL) (cons 50 aC0)))
        (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(67 . 0)
                      '(100 . "AcDbText") (cons 10 A1P) (cons 40 TxH)
                      (cons 1 Cap) (cons 50 aC0) (cons 11 A1P) '(72 . 2)
                     '(100 . "AcDbAttribute") '(280 . 0) '(2 . "CAP") '(70 . 0)
                      '(280 . 1)))
        (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(67 . 0)
                      '(100 . "AcDbText")(cons 10 A2P)(cons 40 TxH)(cons 1 DsT)
                    '(72 . 0)(cons 50 aC0)(cons 11 A2P)'(100 . "AcDbAttribute")
                      '(280 . 0) '(2 . "BOY") '(70 . 0) '(280 . 1)))
        (entmake (list '(0 . "SEQEND"))))
      (princ "\r Ölçüsü yazılacak Obje(ler) seçiniz: "))
    (setq Cap (getstring "\r Yeni Çap değeri giriniz: ")))
  (setq *error* nil) (command "_.undo" "e") (princ)
)

- Line objelerinin yanısıra Polyline, Lwpolyline, Spline, Circle ve arc objelerini de işleyecek şekilde düzenlendi.

ProhibiT (24.12.2011 10:09 GMT)

26.11.2011 21:58    

waytooraider
Hocam harika olmuş mest oldum:)
mükemmel süperrrrrrrrrrrrrrrrrr
çocuklar gibi seviniyorum şu anda

27.11.2011 08:04    

kemalizmir3535
Merhaba arkadaşlar. paylaşılan her türlü bilgi için önceden teşekkürlerimi sunuyorum. benim acil istediğim lisp. bina ve temel kolonlerına numaralayarak koordinatlandırdıktan sonra bunu ncn veya gsi olarak alabileceğim lispe ihtiyacım var. şimdiden teşekkürler.

27.11.2011 08:57    

ProhibiT
waytooraider, işinize yaramasına sevindim. Fonksiyon kodunda Parameter List ve Local Variables List'i yazmayı unutmuştum, bunları da ekleyip kodu güncelledim. Önceki hali fonksiyonun çalışmasına engel bir durum olmamakla birlikte, son halini kullanmanızı tavsiye ederim... Kolay gelsin.

27.11.2011 19:03    

waytooraider
Hocam elinize sağlık.Bir soru daha sormak istiyorum attributun text yüksekliğini nasıl ayarlayabilirim. şu an text heighti 2.5 görünüyor.
lispin içinde 2.5 sayısını aradım ama düz mantık çalışmadı:)
saygılarımla hocam.

28.11.2011 00:49    

ProhibiT
Fonksiyon yazı yüksekliği olarak, dimtxt*dimscale değişkenlerini alıyor. yazıların geçerli dimension text'leri ile aynı yükseklikte olması uygun olur diye düşündüm, dimscale ve dimtxt sistem değişkenlerinizi değiştirerek yazı yüksekliğini ayarlayabilirsiniz.

28.11.2011 06:34    

waytooraider
Cok saolun hocam

29.11.2011 10:06    

doygun77
Alıntı
kemalizmir3535 :
Merhaba arkadaşlar. paylaşılan her türlü bilgi için önceden teşekkürlerimi sunuyorum. benim acil istediğim lisp. bina ve temel kolonlerına numaralayarak koordinatlandırdıktan sonra bunu ncn veya gsi olarak alabileceğim lispe ihtiyacım var. şimdiden teşekkürler.

slm banada bu list'ten lazım projedeki gereksiz ve kullnılmayan layerler kapatılarak (kullanıcı tarafından) projedeki bütün kırık, köşe, nokta, daire etrafını numaralandırıp koordinatlandıracak (numara, x ,y ) lisp lazım (.Txt -xls - ncn - xyz) dosya türü fark etmez
ama txt olursa iyi olur.
başlama nosu
numara boyu
kayıt yapılacak dosya
balastro istenip istenmediği ?

bende tek tek nokta olarak attığım bir lisp var onu örnek olarak ekliyorum. bununla tek tektek noktaları belirliyoruz. dosyayı eke yükleyemedim lisp i kopyalayıp göderiyorum.

Kod:

;;; ----------------------------------------------------------------------- ;;;
;;;Program zpisuje do pliku wspó³rzedne wskazanych punktów do pliku
;;;Moliwosc wstawienia znacznika punktu
;;;*** Dariusz Ptaszkiewicz [http://www.dp.cad.pl] ***
;;;*** e-mail:dp@cad.pl ***
(defun c:nxyz (/ NR NP ZN PD B old_cmdecho)
  (setq old_cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (initget (+ 1 2 4))
  (setq NR (getint "\nBaslama Numarası Giriniz :"))
  (setq B (getreal "\Numara Boyunu Giriniz:"))
  (setq NP (getfiled "Kayıt Yapılacak Dosyayı Seçiniz"
                     "" "txt;csv;xls" 1
           )
  )
  (setq ZN (getstring "\Noktaya balastro istermisiniz ? [ e / h ]:"))
  (SETQ PD (open NP "W"))
  (WRITE-line (strcat "Nr" ";" "X" ";" "Y" ";" "Z") PD)
  (while
    (setq WSKAZ_PUNKT (getpoint "\nNokta Sec:"))
     (setq WSPÓ£RZEDNA_X (RTOS (car WSKAZ_PUNKT) 2 4))
     (setq WSPÓ£RZEDNA_Y (RTOS (cadr WSKAZ_PUNKT) 2 4))
     (setq WSPÓ£RZEDNA_Z (RTOS (caDdr WSKAZ_PUNKT) 2 4))
     (setq LINIA
            (strcat (rtos NR) ";" WSPÓ£RZEDNA_X ";" WSPÓ£RZEDNA_Y ";"
                    WSPÓ£RZEDNA_Z
            )
     )
     (WRITE-line LINIA PD)
     (if (or (= ZN "E") (= ZN "e"))
       (progn
         (DRAW_PUNKT)
         (DRAW_TEXT)
       )
       (DRAW_TEXT)
     )
     (setq NR (1+ NR))
  ) ;WHILE
  (close PD)
  (setvar "cmdecho" old_cmdecho)
  (princ "\nKoniec")
  (princ)
) ;defun
;;; ----------------------------------------------------------------------- ;;;
(defun DRAW_TEXT (/)
  (command "_layer" "_m" "nxyz-nno" "_c" "5" "" "")
  (command "_text" WSKAZ_PUNKT B "0" NR)
) ;defun
;;; ----------------------------------------------------------------------- ;;;
(defun DRAW_PUNKT (/ d kat_90 kat_270 p1 p2 p3 p4)
  (command "_layer" "_m" "nxyz-nokta" "_c" "1" "" "")
  (setq d (/ B 20))
  (command "_circle" WSKAZ_PUNKT d)
) ;defun
;;; ----------------------------------------------------------------------- ;;;
(princ
  (strcat
    "NXYZ.Lsp (C) Dariusz Ptaszkiewicz" " [e-mail:dp@cad.pl]" "\nKomut: nxyz "
  )
)

ProhibiT (19.12.2011 04:34 GMT)

30.11.2011 11:08    

pulp fiction
Merhaba arkadaşlar;

divide komutunda nesne seçtirerek nokta atıyor.

iki yere tıklayıp o araya istediğim kadar (örnek:5) tane nokta atacak bi lisp olabiliyor mu?

30.11.2011 13:09    

id
Merhaba arkadaşlar,

bana ekteki dosyada göründüğü gibi numaraları bir dairenin merkez noktasının altına, numarayı da dairenin hemen üstüne kopyalayacak bir lisp lazım. forumda aradım fakat bulamadım. ilgilenecek arkadaşlara şimdiden teşekkürler.

admin (08.01.2013 20:34 GMT)

30.11.2011 22:01    

waytooraider
Alıntı
ProhibiT :
waytooraider arkadaşımızın isteği doğrultusunda yazılan bu fonksiyon, Seçilen Line objelerinin üzerine, kullanıcının belirlediği Çap değerini ve objenin ölçülen uzunluğunu, bLock içinde Attribute olarak yazar.

fonksiyon çalıştırıldığında;
- drawing dosyasında ebl isimli block tanımı olup olmadığı kontrol edilir
- ebl block'u yoksa oluşturulur.
- ebl block'u içinde biri "cap" tag'li, "cap: " prompt'lu, diğeri "boy" tag'li, "boy: " prompt'lu olmak üzere 2 tane attribute bulundurur.
- cap değerini girmeniz istenir. söz konusu değer string türünde olduğu için "%%c14" şeklinde girilebilir. aynen girildiği şekilde ilgili attribute'e value olarak atanacaktır.
- line objesi seçmeniz istenir. tek bir line objesi seçilebileceği gibi, çoklu obje seçimi de yapılabilir. window, crossing gibi yöntemlerle yapılacak seçim tek adımlıdır. autocad'in genel object selection mantığında olduğu gibi seçilmeye devam edildikçe "select object(s)..." şeklinde devam etmez. seçim işleminin sürekliliği fonksiyon içinde döngü ile sağlanmıştır. istenirse abartıp bu soruya "all" şeklinde cevap verilirse drawing dosyasındaki tüm line objeleri birden işleme alınır.
- fonksiyondan çıkmadan çap değerini değiştirmek için "ölçüsü yazılacak çizgi(ler) seçiniz: " iletisini enter ile geçmek gerekir.
- yeni çap değeri bundan sonra seçilen line objelerine atanarak işleme devam edilir.
- fonksiyondan tamamen çıkmak için, önce "ölçüsü yazılacak çizgi(ler) seçiniz: " iletisini, sonra da "yeni çap değeri giriniz: " sorularını enter ile cevaplamak yeterli olacaktır.
Kod:

;|=============================================================================
| Seçilen çizginin üzerine Çap ve boy bilgilerini Atrribute olarak yazar.     |
| Hazırlayan: M. Şahin Güvercin  26.11.2011  www.autocadokulu.com             |
============================================================================ |;
(write-line "\n Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:aLd (/ em TsZ scL TxH Cap Czg PvT StP EnP aCi DsT aC0 aC1
              MiP BiP A1P A2P)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setq em " M. Şahin Güvercin - www.autocadokulu.com"
        TsZ (getvar "DimTxt") scL (getvar "DimScaLe") TxH (* TsZ scL))
  (defun *error* (er) (princ er) (setq *error* nil) (princ em))
  (if (not (tblsearch "bLock" "EbL")) (progn
    (entmake (list '(0 . "BLOCK")'(8 . "0")'(70 . 2)'(2 . "EbL")
                   '(10 0.0 0.0 0.0)))
    (entmake (list '(0 . "ATTDEF")'(100 . "AcDbEntity")'(8 . "0")
                   '(100 . "AcDbText") (cons 10 (list (- 0 Tsz) 0.0 0.0))
                   (cons 40 TsZ)'(1 . "10") '(41 . 1.0)'(72 . 2)
                   (cons 11 (list (- 0 TsZ) 0.0 0.0))
                   '(100 . "AcDbAttributeDefinition")'(280 . 0)'(3 . "Cap: ")
                   '(2 . "CAP")'(70 . 0)'(280 . 1)))
    (entmake (list '(0 . "ATTDEF")'(100 . "AcDbEntity")'(8 . "0")
                   '(100 . "AcDbText")(cons 10 (list TsZ 0.0 0.0))(cons 40 TsZ)
                  '(1 . "1.00")'(41 . 1.0)'(72 . 0)(cons 11 (list Tsz 0.0 0.0))
                   '(100 . "AcDbAttributeDefinition")'(280 . 0)'(3 . "Boy: ")
                   '(2 . "BOY")'(70 . 0)'(280 . 1)))
    (entmake (list '(0 . "ENDBLK")))))
  (setq Cap (getstring "\n Çap değerini giriniz: "))
  (while (/= Cap "")
    (princ "\r Ölçüsü yazılacak Çizgi(ler) seçiniz: ")
    (while (setq Czg (ssget ":s" (list (cons 0 "Line"))))
      (setq L (sslength Czg) n -1)
      (while (< (setq n (1+ n)) L)
        (setq PvT (entget (ssname Czg n))
              StP (cdr (assoc 10 PvT)) EnP (cdr (assoc 11 PvT))
              aCi (angle StP EnP) DsT (rtos (distance StP EnP)))
        (while (>= aCi pi) (setq aCi (- aCi pi)))
        (if (<= aCi (/ pi 2.0)) (setq aC0 aCi aC1 (+ aCi (/ pi 2.0)))
          (setq aC0 (- aCi pi) aC1 (- aCi (/ pi 2.0))))
        (setq MiP (mapcar '(lambda (pr1 pr2) (/ (+ pr1 pr2) 2.0)) StP EnP)
              BiP (polar MiP aC1 (* (/ TsZ 2.0) scL))
              A1P (polar BiP (+ aC0 pi) (* Tsz scL))
              A2P (polar BiP aC0 (* TsZ scL)))
        (entmake (list '(0 . "INSERT") '(66 . 1)'(2 . "EbL")(cons 10 BiP)
                       (cons 41 scL)(cons 42 scL)(cons 43 scL)(cons 50 aC0)))
        (entmake (list '(0 . "ATTRIB")'(100 . "AcDbEntity")'(67 . 0)
                      '(100 . "AcDbText")(cons 10 A1P)(cons 40 TxH)(cons 1 Cap)
                       (cons 50 aC0) (cons 11 A1P)'(72 . 2)
                       '(100 . "AcDbAttribute")'(280 . 0)'(2 . "CAP")'(70 . 0)
                       '(280 . 1)))
        (entmake (list '(0 . "ATTRIB")'(100 . "AcDbEntity")'(67 . 0)
                      '(100 . "AcDbText")(cons 10 A2P)(cons 40 TxH)(cons 1 DsT)
                       '(72 . 0)(cons 50 aC0) (cons 11 A2P)
                       '(100 . "AcDbAttribute")'(280 . 0)'(2 . "BOY")'(70 . 0)
                       '(280 . 1)))
        (entmake (list '(0 . "SEQEND"))))
      (princ "\r Ölçüsü yazılacak Çizgi(ler) seçiniz: "))
    (setq Cap (getstring "\r Yeni Çap değeri giriniz: ")))
  (setq *error* nil) (command "_.undo" "e") (princ)
)




Hocam bu lispin tek eksiği dairesel yüzeyi yani mesela havalandırma kanalında metraj çıkarırkan dirseğin dış dairesinin ölçüsünü vermiyor. eğer lispi daire çizgileri için çalıştırmak mümkün olabilirse metraj konusunda hızlı olmuş olacağız.
ama bir bildiğiniz vardır diyerek hürmet ve saygılarımı sunuyorum hocam.

01.12.2011 14:07    

cagrikara
Alıntı
ProhibiT :
Kod:

;| Nokta numaralarının belirli bir Layer'da ve sayısal yada alfasayısal       
   Text objeleri oluduğu kabul edilir. son girilen "...To point" bir sonraki   
   "from point..." için teklif olarak getirilir. son çizilen noktadan devam   
   etmek için "enter" girilmelidir. belirlenen noktalar arasında oluşturulan   
   line objeleri geçerli layer, color, linetype... öz niteliklerine sahip     
   olacaktır. fonksiyonu sonlandırıp çıkmak için "...To point" sorusuna "enter"
   ile boş cevap girmek yeterlidir.                                           
   hazırlayan: m. şahin güvercin  22.11.2011  www.autocadokulu.com           |;
(write-line "\n hazırlayan: m. şahin güvercin - www.autocadokulu.com")
(defun c:kntr (/ lyr nno l n tp asc fp)
  (setq em "\n m. şahin güvercin - www.autocadokulu.com")
  (defun *error* (er) (princ er) (setq *error* nil) (princ em))
  (setvar "cmdecho" 0) (command "_.Undo" "group")
  (write-line "\nherhangi bir nokta numarası seçiniz: ")
  (setq lyr (ssget ":s" (list (cons 0 "text")))
        lyr (cdr (assoc 8 (entget (ssname lyr 0))))
        nno (ssget "x" (list (cons 0 "text") (cons 8 lyr)))
        l   (sslength nno) n -1 asc nil tp t)
  (while (< (setq n (1+ n)) l)
    (setq asc (append asc
                  (list (cons (cdr (assoc 1 (entget (ssname nno n))))
                              (cdr (assoc 10 (entget (ssname nno n)))))))))
  (while (not (assoc (setq fp (getstring "\n from point...")) asc))
    (write-line (strcat "\n * "" fp "" nokta numarası bulunamadı!")))
  (while tp (while
      (and (not (assoc (setq tp (getstring "\n ...To point")) asc)) (/= tp ""))
       (write-line (strcat "\n * "" tp "" nokta numarası bulunamadı!")))
    (if (= tp "") (exit)
      (entmake (list (cons 0 "line") (cons 10 (cdr (assoc fp asc)))
                     (cons 11 (cdr (assoc tp asc))))))
    (while (and (assoc fp asc)
       (/= (setq fp (getstring (strcat "\n from point... <" tp ">: "))) ""))
      (write-line (strcat "\n * "" fp "" nokta numarası bulunamadı!")))
    (if (= fp "") (setq fp tp)))
  (setq *error* nil) (command "_.undo" "e") (princ)
)






Fakat bu lisp le ilgili bir sorunum var. daha doğrusu şöyle birşey lisp çok güzel çalışıyor. ama bana gelen autocad dosyalarında numaraların başında bir boşluk var. örn. (8927) olması gerekirken ( 8927) yani text dosyasında rakamlardan önce bir boşluk geliyor. bu boşluk oluncada sizin verdiğiniz lispte nokta numarasını yazınca lisp noktamı bulamıyor. denemek için bir kaç numaranın başındaki boşluğu silip sizin lispi deneyince çok güzel çalıştı.


bu durumu göz önüne alarak bana verdiğiniz lispte küçük bir düzenleme yapabilirmisiniz ? tekrar tekrar çok teşekkür ederim.

01.12.2011 17:44    

ProhibiT
Arkadaşlar sizlerden ricam, bir konudan bahsederken, autolisp kodunu aynen alıntı yapmayalım, arama yapan arkadaşlarımızın dolambaçlarda yollarını kaybetmelerine sebep oluyoruz. arama yapan arkadaşlar, alıntılara takılıp kodun orijinalini ıskalayabiliyorlar. bahsedilen fonksiyonla iligi link paste etmek yeterince anlamlı olacaktır.

örnek olarak son mesaja göz atarsak; kod alıntılanırken büyük/küçük harf özellikleri kaybolmuş, satır ve blok düzeni hiç kalmamış. autolisp kodlarda nokta, virgül, büyük/küçük harfler hatta anlamsız görülebilecek boşluklar bile o kadar önemli ki... bütün bunların yanında, paylaştığımız kodları yalnızca kullanıcı arkadaşlarımızın değil, yazar arkadaşlarımızın da kolayca takip edebilmeleri için, formatına da özen gösteriyoruz. kodlarda görülen girinti çıkıntılar, rasgele canımız öyle istediği için yazılıvermiş şeyler değil. bu tür alıntılarda onca özen gösterdiğimiz kodlar deli kız çeyizi gibi dağılıyorlar. yanlışlıkla buradan alıp kullanmaya çalışan arkadaşımız büyük ihtimalle hata ile karşılaşacak.

bunun yerine

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

şeklinde fonksiyonun paylaşıldığı link mesaj numarasıyla birlikte verilirse bahsettiğimiz kargaşa yaşanmayacaktır. cagrikara arkadaşımız da burada örnek olarak verdiğim linke tıkladığında fonksiyonun isteklerini karşılayacak şekilde düzenlemiş haline ulaşabilecektir.

waytooraider, alınmayın lutfen, bu alıntılama konusuna sizin de dikkatinizi çekmeden geçemiyorum :) yazdıklarımın halisane ve pozitif yönde olduğunu göz ardı etmemenizi rica ederek bir kaç noktaya daha dikkatinizi çekmek isterim.

problem çözmenin, özellikle de program yazarken problem çözmenin ilk ve önemli adımı, problemi tanımlamaktır. net olarak tanımlayamadığımız bir problemi çözme şansımız kalmaz. daire bir düzlem şekildir, ve sınırları bir çember ile tanımlıdır. fakir ingilizce'nin "circle" kelimesine takılmayın, muhteşem türkçe'nin gücünün farkında olun. "çember" (circle) kapalı değilse artık bir "yay" (arc) tır.

hoşgörülerinize güvenerek girdiğim bu muhabbeti solandırırsak; burada istenen yay uzunluğunun da aynı çizgilerde olduğu gibi uygun konumda bir attribute ile yazdırılmasıdır diye algılıyorum konuyu. yapılabilir elbette, çizgilerden farklı olarak attribute'lerimizi arc objemizin başlangıç ve bitiş noktalarının ortasına yazdıramayız, alarga düşer, ilgisiz yerlerde kalır. arc'ın ortasını bulup, buraya gene teknik resim kurallarına uygun okunma yönüyle yazdırılması gerekir. yurtdışından yeni döndüm, biriken özel ve forum mesajlarına kısa cevaplar yazmaya çalışıyorum, nefes alıp fırsat bulduğumda yazacağım...

kolay gelsin.

ProhibiT (18.12.2011 03:56 GMT)

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