04.08.2020 00:56    

BLack|E
Merhaba üstatlarım
Henüz bol satırlı lisp yazamıyorum ve balık yemek yerine tutmayı öğrenme mantığı ile yaklaşarak.
Bu sitedeki yazarlarımızın yazmış olduğu koordinat lisp'ini kendime göre uyarlayıp.
Hem kendimi geliştiriyor, hem yazarlarımızı meşgul etmemiş oluyorum.
Kodu aşağıda paylaştım. Yardımınız beni mutlu edecektir.

Kod:

(defun tablo_ciz()
(setq dik_czg_uz (- (* block_icin_sira_no 36) 36))
(setq 0dik_czg1(polar tablobaslangicnoktasi pi 71))
(setq 0dik_czg2(polar 0dik_czg1 (* pi 1.5) dik_czg_uz))
(setq 1dik_czg2(polar tablobaslangicnoktasi (* pi 1.5) dik_czg_uz))
(setq 2dik_czg1(polar tablobaslangicnoktasi 0 71))
(setq 2dik_czg2(polar 2dik_czg1 (* pi 1.5) dik_czg_uz))
(setq 3dik_czg1(polar tablobaslangicnoktasi 0 142))
(setq 3dik_czg2(polar 3dik_czg1 (* pi 1.5) dik_czg_uz))
(command "line" 0dik_czg1 0dik_czg2 "")
(command "line" tablobaslangicnoktasi 1dik_czg2 "")
(command "line" 2dik_czg1 2dik_czg2 "")
(command "line" 3dik_czg1 3dik_czg2 "")
(command "line" 0dik_czg1 0dik_czg2 "")
)

;;;;;;;;;;;;;;;
(defun c:koor()
(setvar "cmdecho" 0)
;(setq eski_os(getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "group")
(setq noktalistesi(list))
(setq nths 0)
(prompt "\nKoordinat noktalarini seciniz ! :")
(setq blocksecimi(ssget(list(cons 0 "insert"))))
(if(= blocksecimi nil)
  (alert "\nSeçilen Obje(ler) arasında Block yok !")
  (progn
   (setq nesnesayisi (sslength blocksecimi))
   (setq says 0)
   (while(> nesnesayisi says)
    (setq blockdxf(cdr(assoc 10(entget(ssname blocksecimi says)))))
    (setq noktaXkoordinati(rtos(car blockdxf)))
    (setq noktaYkoordinati(rtos(cadr blockdxf)))
   (setq noktaZkoordinati(rtos(caddr blockdxf)))
    (setq noktalistesi(append noktalistesi(list(strcat noktaXkoordinati"X"noktaYkoordinati"Y"noktaYkoordinati"Z"))))
(setq says(+ says 1)) )
   (setq siraliYnoktalistesi(vl-sort noktalistesi '<))
   (setq yaziyuksekligi 17.5)
   (if(= yaziyuksekligi nil)(setq yaziyuksekligi(getvar "textsize")))
   (setq block_icin_sira_no 1)
   (if(= block_icin_sira_no nil)(setq block_icin_sira_no 1))
   (setq tablobaslangicnoktasi(getpoint"\nTablo Baslangic Noktasi ? :"))
  (setq N_tablobaslangicnoktasi tablobaslangicnoktasi)
   (command "line"(polar N_tablobaslangicnoktasi pi 71)(polar N_tablobaslangicnoktasi 0 142)"")
   (setq nb (polar N_tablobaslangicnoktasi pi 71))
   (setq n1 (polar nb (/ pi 2) 36))
   (setq n2 (polar nb (/ pi 2) 102))
   (setq n3 (polar n2 0 213))
   (setq n4 (polar n3 (* pi 1.5) 66))
   (setq n5 (polar nb 0 213))
   (setq n6 (polar n1 0 71))
   (setq n7 (polar n1 0 142))
   (setq n9 (polar N_tablobaslangicnoktasi 0 71))
   (setq n10 (polar N_tablobaslangicnoktasi 0 35.5))
   (setq n11 (polar N_tablobaslangicnoktasi 0 106.5))
   (setq n12dik (polar n1 (/ pi 2) 33))
   (setq n12yatay (polar n12dik 0 106.5))
   (setq n13 (polar n1 0 106.5))
   (entmake (list (cons 0 "LINE") (cons 10 nb) (cons 11 n2)))
   (entmake (list (cons 0 "LINE") (cons 10 n2) (cons 11 n3)))
   (entmake (list (cons 0 "LINE") (cons 10 n3) (cons 11 n5)))
   (entmake (list (cons 0 "LINE") (cons 10 n1) (cons 11 n4)))
   (entmake (list (cons 0 "LINE") (cons 10 N_tablobaslangicnoktasi) (cons 11 n6)))
   (entmake (list (cons 0 "LINE") (cons 10 n9) (cons 11 n7)))
   (command "_Color" "3")
   (command "_Layer" "S" "Stahlbau -Bemasssung- ölcülendirme" "")
   (command "text" "J" "bc"  n10 yaziyuksekligi "" "X")
   (command "text" "J" "bc"  n11 yaziyuksekligi "" "Y")
   (command "text" "J" "bc"  n12yatay yaziyuksekligi "" "Koordinaten")
   (command "text" "J" "bc"  n13 yaziyuksekligi "" "der Bohrungen")
   (repeat(length siraliYnoktalistesi)
    (setq nkt_al(nth nths siraliYnoktalistesi))
    (setq x_yer(vl-string-search "X" nkt_al))
    (setq y_yer(vl-string-search "Y" nkt_al))
    (setq z_yer(vl-string-search "Z" nkt_al))
    (setq x_nkt(atof(substr nkt_al 1 x_yer)))
    (setq y_nkt(atof(substr nkt_al(+ x_yer 2)(- y_yer x_yer 1))))
    (setq z_nkt(atof(substr nkt_al(+ y_yer 2)(- z_yer y_yer 1))))
(setq kyzn1 (list  x_nkt y_nkt z_nkt))
(setq kyzn  (mapcar '(lambda (X)(+ X 25)) kyzn1))
     
    (setq x_al(rtos x_nkt 2 0))
    (setq y_al(rtos y_nkt 2 0))
    (setq z_al(rtos z_nkt ))
    (setq N_tablobaslangicnoktasi(polar N_tablobaslangicnoktasi (* pi 1.5)36))
(setq X_yzn(polar N_tablobaslangicnoktasi 0 35.5))
(setq Y_yzn(polar N_tablobaslangicnoktasi 0 106.5))
(setq Yki(polar N_tablobaslangicnoktasi 0 142))
(setq noicin(polar N_tablobaslangicnoktasi pi 35.5))
(setvar "osmode" 0)
(command "_Color" "3")
    (command "text" kyzn yaziyuksekligi "" (itoa block_icin_sira_no))
    (command "text" "J" "bc" noicin yaziyuksekligi "" (strcat(itoa block_icin_sira_no)))
    (command "text" "J" "bc" X_yzn yaziyuksekligi "" x_al)
    (command "text" "J" "bc" Y_yzn yaziyuksekligi "" y_al)
    (command "_Color" "bylayer")
    (command "line"(polar N_tablobaslangicnoktasi pi 71)Yki "")
    (setq nths(+ nths 1))
    (setq block_icin_sira_no(+ block_icin_sira_no 1)) )
(tablo_ciz)
))
(setvar "osmode" 15359)
(command "_Color" "Bylayer")
(command "undo" "e")
(princ)
)



Sorularım şöyle
1.sorum :
Bu lisp Y koordinatına göre sıralayıp numara küçükten büyüğe sıralayarak numara vermekte
Kod:

(setq siraliYnoktalistesi(vl-sort noktalistesi '<))

Bunu X koordinatına göre yapamadım.

2.sorum : komut satırını nasıl temizlerim (terpri yöntemini uygulamaya çalıştım başaramadım)


3.sorum : Mesela aşağıdaki satırda yazı style'ni ISO yapmak istiyorum nasıl yapabilirim.
Kod:

(command "text" "J" "bc"  n12yatay yaziyuksekligi "" "Koordinaten")

04.08.2020 11:23    

Travaci
Merhaba Ertan, en iyisini yapiyorsun

Koordinat listesini olustururken strcat ile bunlari birlestirip isini zorlastirmissin, halbuki koordinatlarin tamamini listeye atip gerekli islemleri yaptiktan sonra sirasiyla listeden xyz koordinatlarini alip string e çevirip yazdirabilirsin.

Asagida oldugu gibi

Kod:

(defun c:test (/ ss ls)
  (if (setq ss (ssget (list (cons 0 "insert"))))
    (progn
      (repeat (setq n (sslength ss))
        (setq n  (1- n)
              ls (append ls (list (cdr (assoc 10 (entget (ssname ss n)))))))
      )
      (setq ls (vl-sort ls '(lambda (x1 x2) (> (nth 0 x1) (nth 0 x2)))))
    )
  )
)


Ağaç yaşken eğilir, alt yordam kullanır ve command kullanmazsanız daha pratik ve kısa olur herşey : )

Kod:

(defun wrtxt (point text height layer style /)
  (entmake (list (cons 0 "text") (cons 1 text) (cons 8 layer) (cons 7 style)
    (cons 10 point) (cons 11 point) (cons 40 height) (cons 72 1) (cons 73 1))
  )
)


komut satırını maalesef temizleyemiyoruz.

04.08.2020 13:16    

BLack|E
Travaci


Erkan hocam verdiğiniz cevaplar için teşekkür ederim.
Maalesef benim tembelliğim command kullandığımda daha rahat algoritma yar atabiliyorum.
Entmake ya da vl- gibi kodlara da hakim olmak gerekir, haklısınız. Çalışacağım muhakkak. Kolay gelsin.

06.08.2020 14:26    

ProhibiT
Merhaba,

Güzel ve faydalı bir konuyu güzel geliştirmişsiniz, katılmadan edemedim. Black|E üşenmeden emek verip devam ederseniz mutlaka güzel bir şeyler üreteceğinizden eminim. Travacı'nın yorum ve tavsiyelerine aynen katılıyorum ve kompelksiz yorumları için de tebrik ediyorum. Benzer yollardan yıllar önce geçmiş olduğu belli.

Travacı'nın tavsiyelerine ek olarak:
Peşpeşe gelen setq işlevlerini, her birini ayrı satır olarak yazmayın.
Kod:

(setq 1dik_czg2(polar tablobaslangicnoktasi (* pi 1.5) dik_czg_uz))
(setq 2dik_czg1(polar tablobaslangicnoktasi 0 71))
(setq 2dik_czg2(polar 2dik_czg1 (* pi 1.5) dik_czg_uz))
(setq 3dik_czg1(polar tablobaslangicnoktasi 0 142))
yerine
Kod:

(setq 1dik_czg2(polar tablobaslangicnoktasi (* pi 1.5) dik_czg_uz)
      2dik_czg1(polar tablobaslangicnoktasi 0 71)
      2dik_czg2(polar 2dik_czg1 (* pi 1.5) dik_czg_uz)
      3dik_czg1(polar tablobaslangicnoktasi 0 142))
şeklinde yazmak daha kolay değil mi?

Command yerine entmake kullanırsanız, color, layer, linetype gibi özellikleri ayarlamak için ayrı Command yazmak zorunda kalmazsınız. Current değerleri hiç değiştirmeden bütün bu nesne özelliklerini entmake içinde kolayca tanımlarsınız.

Son olarak ta, gene Travacı'nın dikkat çektiği bir konu var, nokta listelerinin önce koordinatlara (x, y ve z) ayrılması oldukça eziyetli bir iş olduğu gibi, vl-sort komutunun da verimli kullanmanızı engeller. Buradan yola çıkarak, ilk yazınızdaki sıralama konusundaki sorunuza da cevap verebiliriz.
Kod:

(setq XLr (vl-sort (mapcar '(lambda (p1) (car p1)) PnTs) '<)
      YLr (vl-sort (mapcar '(lambda (p1) (cadr p1)) PnTs) '<)
burada da paylaştığım bir örnekten aldığım kod bölümünü incelemenizi tavsiye ederim. Burada, PnTs X ve Y koordinatlarının yer aldığı bir liste. ((3.0 5.0) (12.3 2.25) (8.4 36.01)....) gibi. verdiğim basit yöntemle bu nokta koordinat listesinin, alt listedeki ilk elemanlarına (X) sıralanıp XLr, ikinci elemana (Y) göre sıralanıp YLr sıralanmış listelerinin nasıl kolayca elde edilecekleri görülüyor.

Selam ve saygılarımla herkese kolaylıklar dilerim.

07.08.2020 13:39    

BLack|E
ProhibiT


Tavsiyeleriniz için teşekkür ederim hocam.
Saygılar bizden.

> 1 <
Copyright © 2004-2022 SQL: 1.36 saniye - Sorgu: 54 - Ortalama: 0.02518 saniye