11.07.2015 15:07    

mustafa06
arkadaşlar basit olacağını tahmin ediyorum, ama bir türlü beceremedim . Forumda ve net 'te aramama rağmen de uygun bir kod bulamadım. lisp çalışırken getpoint ile çizdirdiğim son line ' ın length bilgisini hafızaya aldırıp; lisp while döngüsünden çıkana kadar her çizdirdiğm line 'ın length bilgilerini sıralı olarak excel ' e atmak istiyorum.

Net ' de bulduğum lisp kodlarının geneli (metraj için) aşağıdaki bulduğum lisp gibi; sonradan line, pline seçerek excel ' e aktarıyor.

(defun c:L2Ex ()
(princ "\nUzunluklarını Excel dosyasına yazmak istediğiniz Line objelerini seçiniz...")
(setq LLer (ssget (list (cons 0 "LINE"))) L (sslength LLer) n -1
fo (open (getfiled "Çıkış Kütüğü" "" "csv" 9) "w"))
(while (< (setq n (1+ n)) L)
(setq Ln (entget (ssname LLer n)) Le (distance (cdr (assoc 10 Ln)) (cdr (assoc 11 Ln))))
(write-line (rtos Le) fo))
(close fo) (prin1)
)

Teşekkürler.

12.07.2015 01:56    

alumina
Alıntı
mustafa06 :

Bu yazin modasi :)

Kod:

(defun c:ld (/ a d e m) (vl-load-com)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))) (if e (close e)) (setq *error* nil)
    (princ))
  (if (setq a (getpoint "\nFirst point:"))
    (if (setq d (getpoint "\nSecond point:"))
      (progn
        (setq e (open (getfiled "" "" "xls" 9) "w") m 0)
        (write-line (strcat "Sira No" "\t" "Uzunluk") e)
        (while (and a d)
          (vla-addline (vla-get-modelspace (vla-get-activedocument
            (vlax-get-acad-object))) (vlax-3d-point a) (vlax-3d-point d))
          (write-line (strcat (rtos (setq m (1+ m)) 2 0) "\t"
            (vl-string-translate "." "," (rtos (vla-get-Length
            (vlax-ename->vla-object (entlast))) 2 2))) e)
          (if (setq a (getpoint "\nFirst point:"))
            (setq d (getpoint "\nSecond point:")))
        ) (close e)
      )
    )
  ) (setq *error* nil) (princ)
)

12.07.2015 09:05    

Travaci
İstirham ediyorum, kendi modanızı kendiniz getirin :D

Kod:

(defun c:c2y (/ n1 n2 n3)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))) (setq *error* nil) (princ))
  (if (setq n1 (getpoint "\nSpecify first point:"))
    (if (setq n2 (getpoint n1 "\nSpecify next point:"))
      (progn
        (entmake (list (cons 0 "line") (cons 10 n1) (cons 11 n2)))   
        (setq n3 (open (strcat (getvar "dwgprefix")
          (vl-filename-base (getvar "dwgname")) ".xls") "a"))
        (write-line (vl-string-translate "." "," (rtos (distance n1 n2) 2 2)) n3)
        (close n3)
      )
    )
  ) (setq *error* nil) (prin1)
)

12.07.2015 10:26    

mustafa06
sayın Alumina,
teşekkürler
ancak kodu (2010' da) çalıştırınca excel dosyasına Sıra No ve Uzunluk olarak başlık açıyor .
uzunluk ölçülerini excel ' e aktarmıyor.

sayın Travaci,
kodu (2010' da) çalıştırınca excel dosyasına uzunlukları sıralı olarak yazıyor.
acadr14 ' de deneyince "null function" hatası veriyor.
kullanmakta olduğum lispler' in çoğu 2010 ve üzeri versiyonlarda hata verince, bir türlü
2010 ve üstüne geçemedim .. Teşekkürler

12.07.2015 13:27    

ehya
Autocad R14 mü??

Arkadaşı mağma'ya gönderin çabuk :)

12.07.2015 13:59    

mustafa06
Sn. Ehya

ne deseniz haklısınız .
20 küsur yıllık alışkanlık işte
:|

12.07.2015 16:14    

Travaci
Karantinaya alın :D

13.07.2015 06:14    

Travaci
Döngü eklenmiş hali;

Kod:

(defun c:c2y2 (/ n1 n2 n3 n4)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg))) (setq *error* nil) (princ))
  (while (= n4 nil)
    (if (setq n1 (getpoint "\nSpecify first point:"))
      (if (setq n2 (getpoint n1 "\nSpecify next point:"))
        (progn
          (entmake (list (cons 0 "line") (cons 10 n1) (cons 11 n2)))   
          (setq n3 (open (strcat (getvar "dwgprefix")
            (vl-filename-base (getvar "dwgname")) ".xls") "a"))
          (write-line (vl-string-translate "." "," (rtos (distance n1 n2) 2 2)) n3)
          (close n3)
        ) 
      )   
    ) (if (or (= nil n1) (= nil n2)) (setq n4 t)) 
  )  (setq *error* nil) (prin1)
)

13.07.2015 09:26    

mustafa06
Sn . Travaci,
karantinadayım :)
kod için teşekkürler...

(setq n3 (open (strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname")) ".xls") "a")) satırlarını

aşağıdaki kodla değiştirince acadr14 ' de verdiği lisp hatası ortadan kalktı çalışır duruma geldi

(setq n3 (strcat (getvar "dwgprefix")
(substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".xls"))
(setq dosya (open n3 "a"))

13.07.2015 09:33    

Travaci
Hatanın sebebini biliyordum, r14 yeni nesil komutları desteklemiyor, kasıtlı olarak düzeltmedim ki belki artık daha kullanmazsınız diye :satisfied

13.07.2015 10:33    

mustafa06
:) olsun teşekkürler yinede

14.07.2015 11:37    

mustafa06
Sn. Travaci,
sizden ricam

(vl-string-translate "." ",") galiba yeni nesil kod
r14 ' te hata vermemesine rağmen excel' e küsuratları noktalayarak atıyor.
İki gündür forumda , nette araştırıyorum. çözümünü bulamadım .
küsuratları virgüllü olarak excel ' e atacak eski nesil kodu biliyormusunuz ?
Teşekkürler...

mustafa06 (14.07.2015 11:42 GMT)

14.07.2015 13:48    

Travaci
vlide ile visual lisp editörünü açın, yeni bir sayfa açıp vl-string-search veya vl-string-position yazın, yazıyı seçili hale getirip " ? " işaretli butona basın help dosyasında bulursa bunu kullanabilirsiniz, bunlarda yoksa birdaha düşünürüz. R14 de visual lisp editörü varmı yaa :dozingoff

14.07.2015 14:32    

mustafa06
bildiğim kadarıyla r14 de visual lisp editör yok.. :(

15.07.2015 05:08    

Travaci
Yapcak birşey yok, ozaman bilgisayarın nokta virgül ayarını değiştirin :)

15.07.2015 07:41    

mustafa06
teşekkürler ,
kodu bulursam burdan paylaşırım :)

15.07.2015 09:02    

Travaci
Lisp yazabiliyorsanız nasıl yapabilceğinizi söyliyim.

15.07.2015 11:23    

mustafa06
Sn. Travaci
çok eskiden iyi kötü yazıyordum. (fii tarihinde :) )
uzun süre ara verince, kodların çoğunu unutmuşum.
text'e çevirdiğim değişkende bir şekilde "." yı aratıp "," ile değiştirip,
text ' i tekrar dizeceğim de..
şu anda kodlar Nanay :)

15.07.2015 11:55    

Travaci
Wcmatch ile çıkan sonucun içinde nokta varmı diye kontrol edebilirsiniz. Var ise sayınızı tam sayıya çevirip ana sayıdan çıkartıp virgul sonrasını alabılır daha sonrada strcat ile sonucları bırlestırebılırsınız. Açıkcası ben yapmaya üşendim, sımdılık aklıma gelen bu, daha kısa bır yontem de olabılırmi bilmiyorum. Ama en kısası günümüzde ayak uydurmak :) Kolay gelsin.

15.07.2015 12:02    

mustafa06
:dozingoff

> 1 <
Copyright © 2004-2022 SQL: 1.879 saniye - Sorgu: 100 - Ortalama: 0.01879 saniye