|
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.
|
mustafa06
|
|
:dozingoff
|
