01.12.2011 20:10    

doygun77
Nxyz dosyası hazırlar autocatte noktaladıgınız yerlerin koordinatlarını listeler ceviri yapmanızı saglar
306169-alpnxyz.Rar

doygun77 (05.12.2011 19:26 GMT)

02.12.2011 04:27    

cagrikara
Prohibit çok teşekkür ederim. peki şöyle bir autolisp olabilirmi? autocaddeki tüm text dosyalarını seçsem. başındaki ilk boşlukları silebilirmi otomatik olarak ? yukardada bahsettigim gibi? düzelttiğiniz lisp yine yakalamiyor o noktalari. o sebeple düşünüyorum ki, noktaların numaralarının başındaki boşlukları ilk başta otomatik silsek. sonra da önceden bana verdiğiniz lispi kullansam çok güzel olur. düşüncem sizce nasıl ? böyle birşey mümkün mü ?

02.12.2011 09:53    

ProhibiT
Umarım nokta numaralarınızın başında yer alan karakter boşluk (ascii 32) karakteridir.
Kod:

(defun c:tmz (/ bstr L n pvt str)
  (setvar "cmdecho" 0) (command "_.undo" "group")
  (setq bstr (ssget (list (cons 0 "text") (cons 1 " *")))
        L    (sslength bstr) n -1)
  (while (< (setq n (1+ n)) L)
    (setq pvt (entget (ssname bstr n))
          str (cdr (assoc 1 pvt)))
    (if (= (substr str 1 1) " ") (progn
        (setq pvt (subst (cons 1 (substr str 2)) (assoc 1 pvt) pvt))
        (entmod pvt) (entupd (cdr (assoc -1 pvt))))))
  (command "_.undo" "e") (princ)
)
Fonksiyonunu kullanarak, nokta numaralarınızın başında yer alan boşluk karakterlerini temizleyebilirsiniz. select objet iletisine, all şeklinde karşılık vererek tüm çizim tek seferde seçilip işleme alınabilir. bundan sonra da kntr fonksiyonunu problemsiz kullanabilirsiniz...

kolay gelsin.

02.12.2011 14:00    

ehya
Şahin hocam çeşitlilik olsun diye farklı bir şekilde yazdığım kodu gönderiyorum.
arkadaşlara da örnek olur...


Kod:

(defun c:tmz ()
  (vl-load-com)
(setq ss (ssget (list (cons 0 "TEXT")(cons 1 " *"))))
  (if (= ss nil)
    (progn)
    (progn
      (setq say (sslength ss) c 0)
      (while (< c say)
(setq tek (ssname ss c)
      data (vlax-ename->vla-object tek)
      ic (vla-get-textstring data)
      bb (vl-string-left-trim " " ic))
(vla-put-textstring data bb)
(setq c (+ c 1))
)))(princ))

02.12.2011 15:36    

ProhibiT
Teşekkürler Mehmet hocam :) bu vla-put method kavramlarına elim alışmamış :)
Kod:

(defun c:tmz (/ ss c d)
  (setvar "cmdecho" 0) (command "_.undo" "begin") (vl-load-com)
  (if (setq c -1 ss (ssget (list '(0 . "TexT") '(1 . " *"))))
    (repeat (sslength ss)
      (setq d (ssname ss (setq c (1+ c))))
      (vla-put-textstring
        (vlax-ename->vla-object d)
        (vl-string-left-trim " "
          (vla-get-textstring (vlax-ename->vla-object d))))))
  (command "_.undo" "end") (princ)
)
sonu yok... böyle de yazılabilir :)

02.12.2011 17:04    

kemalizmir3535
Hazırlamış olduğunuz nxyz lispi için çok teşekkürlerimi sunarım. işime çok yaradı. emeğinize sağlık. kemalizmir

02.12.2011 20:41    

ProhibiT
İstek üzerine yazıp paylaştığım fonksiyonda msermus arkadaşımızın istediği değişiklikleri ekleyip yeniden paylaşıyorum. Başlangıç ve Bitiş kotları verilen poLyLine üzerine verilen mesafe(ler)de ara kot yazan fonksiyonda kotun yazıldığı yerde birde point oluşturması isteniyor.
Kod:

;|============================================================================|
| Seçilen Objenin başlangıç ve bitiş kotları girildikten sonra, yeni          |
| mesafeler girilmeye devam edildikçe, başlangıca mesafesi verilen nokta      |
| ara kotu yazılır. Bitiş noktasından mesafe girmek için, mesafe değeri       |
| negatif (-) girilmelidir. İsteğe bağlı olarak Başlangıç ve Bitiş            |
| Kotları da yazdırılabilir.                                                  |
| M. Şahin Güvercin - www.autocadokulu.com - 16.10.2011                       |
|============================================================================|;
(write-line "\n M. Şahin Güvercin - www.autocadokulu.com")
(defun c:LpLkoT (/ sKoT eKoT RefO Leng KK SeK sPnT ePnT deLt LstO bmsf noK KoT)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (setq sKoT (getreal "\n Başlangıç Kot değeri: ")
        eKoT (getreal "\n Bitiş Kot değeri: ")
        RefO (car (entsel "\n Refrerans Obje seçiniz: "))
        Leng (vlax-curve-getDistAtParam
               (vlax-ename->vla-object RefO)
               (vlax-curve-getEndParam (vlax-ename->vla-object RefO)))
        KK   (initget 1 "Evet Hayir") TxH (getvar "textsize")
        SeK  (getkword "\Başlangıç ve bitiş kotları yazılsın mı? (E/H): "))
  (if (= SeK "Evet") (progn
      (setq sPnT (vlax-curve-getStartPoint (vlax-ename->vla-object RefO))
            ePnT (vlax-curve-getEndPoint (vlax-ename->vla-object RefO)))
      (entmake (list (cons 0 "text") (cons 10 sPnT) (cons 40 TxH)
                     (cons 1 (rtos sKoT 2 2))))
      (entmake (list (cons 0 "Point") (cons 10 sPnT)))
      (entmake (list (cons 0 "text") (cons 10 ePnT) (cons 40 TxH)
                     (cons 1 (rtos eKoT 2 2))))
      (entmake (list (cons 0 "Point") (cons 10 ePnT)))))
  (setq deLt (- eKoT sKoT) LstO (entlast))
  (princ "\n Başlangıca mesafe: ")
  (while (setq bmsf (getreal "\r Başlangıca mesafe: "))
    (if (> bmsf Leng)
      (princ "\r Mesafe Toplam Boydan büyük olamaz!\n") (progn
        (if (< bmsf 0) (setq bmsf (- Leng bmsf)))
        (command "_.measure" RefO bmsf)
        (setq noK (assoc 10 (entget (entnext LstO)))
              KoT (+ sKoT (* (/ bmsf Leng) deLt)) LstO (entnext LstO))
        (while (setq LstO (entnext LstO)) (entdel LstO))
        (entmake (list (cons 0 "text") noK (cons 40 TxH)
                       (cons 1 (rtos koT 2 2))))
             (setq LstO (entlast)))))
  (command "_.undo" "e") (princ)
)

03.12.2011 17:58    

msermus
Tekrar tesekkur etmek ıstıyorum her fırsatta destegınızı esırgemedıgınız ıcın.

05.12.2011 19:32    

doygun77
Alıntı
kemalizmir3535 :
Hazırlamış olduğunuz nxyz lispi için çok teşekkürlerimi sunarım. işime çok yaradı. emeğinize sağlık. kemalizmir

İnşallah faydam dokunmuştur ben lisp yazamıyorum bunu hazır almıştım cok güzel bir
lisp ama biraz daha geliştirilirse cok daha faydalı olacagı kanaatındeyim :)

07.12.2011 09:32    

doygun77
Autocad dosyası üzerinde ki polyline ve line ile yapılan cizim kenarlarını veya çizim köşelerini noktalayıp ,nokta numarasını yazacak ve bunu nokta numarası x y z (nxyz koordinat dosyası olusturacak) lisp yapabilirmiyiz.

yukarıda 66740 nolu iletide lisp örnegi vermiştim (aşağıya yinede kopyalıyorum ) orada noktaları tek tek işaretliyorum benim istediğim projedeki bütün çizim köşe ve kırıklarına nokta atıp numaralandıracak ve aynı nokta dosyasını acacak.
yazı yüksekligi
numaranın kaçtan itibaren başlayacağı
dosyanın nereye kaydedilecegi
balastro istenip istenmediği

kısaca program aynı şekilde çalışacak ama ben bütün layerleri kapatacagım için sadece noktalanmasını istediğim cizimlerin layerleri acık olacak lisp otomatik olarak bütün cizimleri noktalayıp nxyz dosyası oluşturacak

farklı olarak sadece yaylarda ve elisplerde ne kadar uzaklıkta bir nokta atılacagı mesafe sorma ve nokta atma seceneği eklenebiliri
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 (18.12.2011 04:34 GMT)

08.12.2011 07:23    

ehya
id




abes olsa, abes olduğu belirtilirdi hiç merak etmeyin..
Burada lisp yazılırken genelde tüm kullanıcılara hitap eden lispler yazılır. Kişisel lispler ben dikkate alınmaz. Ancak yazacak kişi müsait ise yazar.
Yazılmamasının sebebi, siz bu şekilde istersiniz, başkası bi ekleme ister, diğeri başka türlü v.s. Lisp çorbaya döner..

09.12.2011 21:14    

given
Ehya bey, yiillardir sizleri burada takip etmekteyim. sizinle meslektasiz ama keske ben de insanlara sizin kadar yardimci olabilseydim.Yaptiginiz cok buyuk bir is.Elleriniz dert gormesin.

prohibit hocama da ayrica tesekkurlerimi ve saygilarimi sunarim.

kolay gelsin,

18.12.2011 04:05    

ProhibiT
Bizler de size teşekkür ediyoruz given. Tek mesajınız var o da teşekkür mesajı :) Paylaşımların doğru yerini bulduğunu görmek güzel bir duygu.

Aşağıda içeriğini verdiğim özel mesaj ile bir AutoLisp Fonksiyon istenmişti. Bu tür isteklerde bulunan arkadaşlarımızın nasıl düşünmesi, neyi nasıl istemesi gerektiği konusunda örnek olması için aşağıdaki fonksiyonu paylaşıyorum.
_______________________________________________________________________________
Size bi Lisp hakkında sorum olacaktı. Varsa elinizde gönderebilir misiniz? Ya da yapması zor mudur? Yazılarla ilgili bir lisp. Yazıları yatay ve düşey olarak hizalama yapabiliyorum. Sitede HZ ile çalışan hizalama lispi var onunla yapıyorum. Benim istediğim alt alta yazıların satır aralıklarının birim girilerek aralıklarının eşit olması. Birkaç tane alan var çizimin altına yazıyorum. Onların aralıklarının manuel olarak yapıyorum. Ayrı bir lisp yada hizalama lispine bi ekleme yapılarak olabilirmi böyle bişey acaba?
_______________________________________________________________________________
Kod:

;|===========================================================================|
| Komut adı: LnSpc                                                          |
| Belirlenen seçim setindeki tüm Text objelerinin                           |
| satır aralıklarını istenen şekilde düzenler.                              |
| Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com                      |
|===========================================================================|;
(write-line "\nM. Şahin Güvercin - www.autocadokulu.com")
(defun c:LnSpc (/ *error* TxTs L n ips sTxT PvT m Bi TxH dsvc)
  (setvar "cmdecho" 0) (command "undo" "group") (defun *error* (er) (princ er))
  (princ "\nSatır aralıkları düzenlenecek Text'leri seçiniz...")
  (setq TxTs (ssget (list (cons 0 "Text"))) L (sslength TxTs) n -1) (initget 7)
  (setq Lspc (getreal "\nSatır aralığı: ") ips nil sTxT (ssadd))
  (while (< (setq n (1+ n)) L) (setq PvT (ssname TxTs n))
    (if ips (setq ips (append ips (list (caddr (assoc 10 (entget PvT))))))
      (setq ips (list (caddr (assoc 10 (entget PvT)))))))
  (setq ips (vl-sort ips '>) n -1)
  (while (< (setq n (1+ n)) L) (setq m -1) (while (< (setq m (1+ m)) L)
      (if (= (caddr (assoc 10 (entget (ssname TxTs m)))) (nth n ips))
        (ssadd (ssname TxTs m) sTxT))))
  (setq Bi (caddr (assoc 10 (entget (ssname sTxT 0))))
        TxH (cdr (assoc 40 (entget (ssname sTxT 0)))) n 0)
  (while (< (setq n (1+ n)) L) (setq PvT (entget (ssname sTxT n)))
    (if (not (eq (cdr (assoc 11 PvT)) '(0.0 0.0 0.0)))
      (setq dsvc (mapcar '(lambda (p1 p2) (- p1 p2))
                         (cdr (assoc 11 pvt)) (cdr (assoc 10 PvT)))))
    (setq Pvt (subst (cons 10 (list (cadr (assoc 10 Pvt)) (- Bi (* n TxH Lspc))
                                    (cadddr (assoc 10 PvT)))) (assoc 10 PvT)
                     PvT))
    (if (not (eq (cdr (assoc 11 PvT)) '(0.0 0.0 0.0)))
      (setq PvT (subst (cons 11 (mapcar '(lambda (p1 p2) (+ p1 p2))
                                     (cdr (assoc 10 PvT)) dsvc)) (assoc 11 PvT)
                       PvT))) (entmod Pvt) (entupd (cdr (assoc -1 PvT))))
  (setq *error* nil) (command "_.undo" "e") (prin1)
)
- Yalnızca Text objeleri işleme alınır, Mtext objeleri işleme alınmazlar.
- seçilen text objelerinin yazı yüksekliklerinin aynı olduğu kabul edilir.
- seçilen text'lerin hizalama seçenekleri farklı olabilir.
- satır aralığı mevcut yazı yüksekliğinin katı olarak alınır.
- satır aralığını değerinin negatif sayı veya 0 (sıfır) olarak girmenize izin verilmez.
- normal şartlarda 1.0'dan büyük ondalık sayı girilmelidir.
- 0'dan büyük 1'den küçük bir değer girilirse satırlar biribirinin üstüne bineceklerdir.
- satır aralığı olarak, text'lerin insertion point'leri arasındaki mesafe alınır.
- seçilen text'lerin yatay (açılarının sıfır) olduğu kabul edilir.

biliyorum ki, yukarıda yazdığım sınırlamalar dışında istekler mutlaka olacaktır. bu anlamda hiç bir değişiklik isteğine cevap vermeyeceğimi belirtmek zorundayım. sizin vaktiniz ve emeğinizin benimkinden daha değerli olduğunu düşünüyor olamazsınız. bu durumda, daha farklı işlemler isteyen arkadaşlar verdiğim kodu kendince değiştirip geliştirmeye çalışmalıdır.

herkese kolay gelsin.

ProhibiT (18.12.2011 04:13 GMT)

19.12.2011 06:32    

kemalizmir3535
nxyz Lispi için çok teşekkür ederim. Tek sorun, listelerken nokta adları noktadan sonra 4 rakam yazıyor. Ekrana attığımız nokta adları gibi numaraların küsuratlı yazılması mümkün mü? Teşekkürler.

ProhibiT (19.12.2011 07:03 GMT)

19.12.2011 07:53    

cagrikara
Autocad de point komutu ile verilen noktaları autocad üzerinden otomatik isimlendirip kordinatlarını; x,y,z olarak text ya da autocad ekranı üzerinde boş bir yere listeleyebilecek bir lisp varmıdır? istediğim çok zor birşey mi ?

Yani demek istediğim şu. pointleri otomatik isimlendirdi mesela 1,2,3,4,5,6,7 numaralı noktalar. ve numaralandırdığı noktaların koordinatları. mesela 1 numaralı nokta´* x= 1000,023 y = 3000,456 z= 4,653 gibi tabi alt alta tablo olarak.

19.12.2011 09:48    

ProhibiT
"zor bir şey" değil elbette, forumda araştırırsanız bulabilirsiniz.

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

19.12.2011 10:56    

cagrikara
#66869Bu lisp varmış kusura bakmayın.

Bu lispte bir kaç değişiklik istesem yapabilirmisiniz?

Balastro yerine point atabilirmi? Bir de Kaydettiği dosyada şöyle birşey oluyor kordinatları girince:

Nr;X;Y;Z
1.0000;1951.7738;3108.2135;105.4800

Baştaki 1 Rakamı. 1 numaralı nokta tamam. ondan sonra 4 tane sıfır geliyor. bu 4 sıfır nedir ? bunu iptal edebilirmiyiz?
Bir de Kaydettiği noktalardaki koordinatlardaki ondalık sisteminde 4 rakam değilde 3 rakam olabilirmi ?

1951.7738 değilde 1951.773 olmasını istiyorum.

Yani istediğim 4 madde var.
1-) Blastro yerine Point atılması ( defaultta seçili point şekili ile işaretleme )
2-) Koordinatları kaydettiği textde düzenli olması. noktalı virgülden sonra belirli bir boşluk olması
3-) Koordinatları kaydettiği textde anlam veremediğim Baştaki 4 haneli sıfırların silinmesi.
4-) Koordinatların uzantısının noktadan sonra (ondalık sistemi) 3 hane olması.


İlginiz için şimdiden teşekkür ederim

cagrikara (19.12.2011 11:32 GMT)

19.12.2011 12:12    

ProhibiT


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




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




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



linklerindeki mesajları yazan doygun 77 ve kemalizmir3535, son olarakta cagrikara arkadaşlarımıza toptan cevap yazma gereği gördüm.

Öncelikle aynı mesajları defalarca tekrarlamak yerine sitemizde gerekli araştırmayı yapmanızı tavsiye ediyorum.

Koordinat konusunda o kadar çok fonksiyon paylaşıldı ki, toparlasak xCad diye yeni bir program olur neredeyse. Mevcut fonksiyonları araştırıp incelemeden istenenleri yazdığımızda, şeytan şembeleğine benzer şeyler ortaya çıkıyor.

Yukarıda linkini verdiğim mesajlarda paylaşılan nxyz fonksiyonu kötü yazılmış, sıralı işlemleri yapan macro benzeri basit bir mantıkt işlemleri bile hatalı yapıyor. Bunun yerine,
Kod:

;|---------------------------------------------------------------------------|
| Nokta seçilmeye devam edildiği sürece, seçilen noktalara                  |
| istenilen sayıdan başlamak üzere numaralar verilir, ilgili noktanın       |
| numarası, X, Y ve Z koordinatları belirlenen -.xls dosyasına yazılır.     |
|      Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com  19.12.2011     |
----------------------------------------------------------------------------|;
(write-line "\nHazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:nxyz (/ *error* oDz oLp Nm Yy Dp Kd bL)
  (command "_.undo" "group") (setvar "cmdecho" 0)
  (defun *error* (er) (princ (strcat "\n" er)) (close Kd)
    (setvar "dimzin" oDz) (setvar "Luprec" oLp) (command "_.undo" "e") (prin1))
  (setq oDz (getvar "dimzin") oLp (getvar "Luprec"))
  (if (not (tblsearch "layer" "nxyz-nno"))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord") '(2 . "nxyz-nno") '(70 . 0)
                   '(62 . 5) '(6 . "Continuous"))))
  (if (not (tblsearch "layer" "nxyz-nokta"))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord") '(2 . "nxyz-nokta")
                   '(70 . 0) '(62 . 1) '(6 . "Continuous")))) (initget 7)
  (setq Nm (getint "\n           Başlangıç Numarası: ")
        Yy (getreal "\n              Yazı Yüksekliği: ")
        Dp (getint "\n       Ondalık Basamak Sayısı: ")
        Kd (open (getfiled "Kayıt Dosyası" "" "xls" 1) "w"))
  (setvar "dimzin" 0) (setvar "Luprec" Dp) (initget "Evet Hayır")
  (setq bL (getkword "\nBalastro isteniyor mu? [E/H]: ")) (princ "\n")
  (write-line "Nm\tX\tY\tZ" Kd)
  (while (setq nK (getpoint "\r... Yeni Nokta: "))
    (write-line (strcat (itoa Nm) "\t" (rtos (car nK) 2 Dp) "\t"
                        (rtos (cadr nK) 2 Dp) "\t" (rtos (caddr nK) 2 Dp)) Kd)
    (entmake (list '(0 . "TEXT") (cons 10 nK) (cons 40 Yy) (cons 1 (itoa Nm))
                   '(8 . "nxyz-nno")))
    (if (= bL "Evet") (entmake (list '(0 . "CIRCLE") (cons 10 nK)
                 (cons 40 (/ Yy 20)) '(8 . "nxyz-nokta")))) (setq Nm (1+ Nm)))
  (close Kd) (setvar "dimzin" oDz) (setvar "Luprec" oLp)
  (command "_.undo" "e") (prin1)
)
fonksiyonunu... Balastro yerine point oluşturmak için ise,
Kod:

;|---------------------------------------------------------------------------|
| Nokta seçilmeye devam edildiği sürece, seçilen noktalara                  |
| istenilen sayıdan başlamak üzere numaralar verilir, ilgili noktanın       |
| numarası, X, Y ve Z koordinatları belirlenen -.xls dosyasına yazılır.     |
|      Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com  19.12.2011     |
----------------------------------------------------------------------------|;
(write-line "\nHazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
(defun c:nxyz (/ *error* oDz oLp Nm Yy Dp Kd bL)
  (command "_.undo" "group") (setvar "cmdecho" 0)
  (defun *error* (er) (princ (strcat "\n" er)) (close Kd)
    (setvar "dimzin" oDz) (setvar "Luprec" oLp) (command "_.undo" "e") (prin1))
  (setq oDz (getvar "dimzin") oLp (getvar "Luprec"))
  (if (not (tblsearch "layer" "nxyz-nno"))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord") '(2 . "nxyz-nno") '(70 . 0)
                   '(62 . 5) '(6 . "Continuous"))))
  (if (not (tblsearch "layer" "nxyz-nokta"))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord") '(2 . "nxyz-nokta")
                   '(70 . 0) '(62 . 1) '(6 . "Continuous")))) (initget 7)
  (setq Nm (getint "\n           Başlangıç Numarası: ")
        Yy (getreal "\n              Yazı Yüksekliği: ")
        Dp (getint "\n       Ondalık Basamak Sayısı: ")
        Kd (open (getfiled "Kayıt Dosyası" "" "xls" 1) "w"))
  (setvar "dimzin" 0) (setvar "Luprec" Dp) (initget "Evet Hayır")
  (setq bL (getkword "\nPoint isteniyor mu? [E/H]: ")) (princ "\n")
  (write-line "Nm\tX\tY\tZ" Kd)
  (while (setq nK (getpoint "\r... Yeni Nokta: "))
    (write-line (strcat (itoa Nm) "\t" (rtos (car nK) 2 Dp) "\t"
                        (rtos (cadr nK) 2 Dp) "\t" (rtos (caddr nK) 2 Dp)) Kd)
    (entmake (list '(0 . "TEXT") (cons 10 nK) (cons 40 Yy) (cons 1 (itoa Nm))
                   '(8 . "nxyz-nno")))
    (if (= bL "Evet") (entmake (list '(0 . "POINT") (cons 10 nK)
                                     '(8 . "nxyz-nokta")))) (setq Nm (1+ Nm)))
  (close Kd) (setvar "dimzin" oDz) (setvar "Luprec" oLp)
  (command "_.undo" "e") (prin1)
)
fonksiyonunu kullanabilirsiniz.

Bu fonksiyonlarda,

- Ondalık basamak sayısını kendiniz seçebilirsiniz.

- Nokta numaraları tamsayı (integer) olarak yazılırlar.

- kötü yazılmış dediğim fonksiyon, seperator olarak ; kullandığından, bütün değerleri string olarak yazar.

- Yukarıda paylaştığım fonksiyonlar koordinat değerlerini gerçel sayı (real) olarak yazarlar.

- Oluşturulan -.xls dosyasını notpad ile açarsanız, bütün koordinatların sizin seçtiğiniz ondalık basamak sayısına uygun yazıldığını görürsünüz.

- Bahsettiğimiz -.xls dosyası Excel'de açıldığında, programınızın varsayılan ayarlarından dolayı ondalık basamaklar belirlediğiniz gibi görünmeyebilirler. Koordinat değerlerinin bulunduğu hücreleri (sütunları) seçip sağ tıklayarak, format bölümünden istediğiniz ondalık sayısını ayarlamanız gerekir.

Daha önceki mesajlarda bahsedilen, Line ve PoLyLine objelerinin köşelerinde noktalar oluşturulup, bunlar numaralandıktan sonra, koordinatlarının Excel dosyasına yazdırılması isteği ile ilgili olarak... Yeterince kafa yorulmamış olduğu anlaşılıyor. Diyelim ki, Line ve PolyLine objelerine Ellipse, Circle, Arc gibi objeleri de ekledik, bunların üzerine de belli aralıklarla noktalar oluşturduk. Peki bu noktaları hangi mantığa göre numaralamak gerekiyor?


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

linkinde paylaştığım PcT fonksiyonunu bir inceleyin... orada olduğu gibi noktaları, 2 boyutlu bir matrise yerleştirip, satır veya sütun düzenine göre veya oluşturulma sıralarına göre numaralamak uygun olur mu? Satır veya Sütun düzeninde numaralama yapılırsa, aynı obje (mesela bir arc) üzerindeki numaralar biribirini takip etmeyebilirler.

ProhibiT (19.12.2011 14:36 GMT)

19.12.2011 12:21    

cagrikara
Çok teşekkür ederim tam istediğim gibi oldu. Point oluşturduğuna göre. Rica etsem bu point üzerine olan lispte küçük bir ayrıntı ekleyebilirmisiniz ?

İstediğim şu. Başlangıç nokta numarasında sadece rakamlarla belirtebiliyorum. Onun olasılığı daha da geliştirsek. şöyle yapsak. mesela a1 yazsam a1den başlasa. a1,a2,a3... ya da ne bilim ana mantık böyle. a yerine başka şeylerde olur.

Rica etsem bunuda ekleyebilirmisiniz ?

Balastro yerine point oluşturmak için olan lisp düzeltirmesi gerekli.

19.12.2011 14:37    

ProhibiT
 

Ö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] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.402 saniye - Sorgu: 101 - Ortalama: 0.01388 saniye