15.04.2013 17:46    

arkadaşlar yardım edebilecek kimse yokmu?

15.04.2013 20:31    

bende iki kod var ama kodların manalarını cozemedıgımden duzenleyemedım ıstersenız verebılırım
bırı textkleri almak için 1. si. diğeri line boyları ıcın 2. cısı




1-----------------------------
; (princ "\t" dosya) OLARAK YAZILIRSA TAB'a basılmış gibi kaydeder....
; Dosya sonra Excell de açılırken hüçrelere bölünmüş olarak açılır...
; Yani Excell dosyası export edilmiş gibi olur.
(defun c:dd ( / )
(command "layer" "new" "metraj_layer" "c" "3" "metraj_layer" "")
(setq donati_text (ssget '((0 . "TEXT")) ) )
(if (/= donati_text nil)
(progn
(setq donati_text_adet (sslength donati_text))
(setq i 0 )
(setq metraj_dosya (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) ".xls"))
(setq dosya (open metraj_dosya "a"))
)
(progn
(princ "\n Dosyaya ara veriyoruz.......")
(setq donati_text (ssget '((0 . "TEXT")) ) )
(setq donati_text_adet (sslength donati_text))
(setq i 0 )
(setq dosya (open metraj_dosya "a"))
(princ "\n " dosya)
(princ "\n " dosya)
(princ "\n " dosya)
(princ "\n " dosya)
)
)
(while (< i donati_text_adet)
(princ (cdr (assoc 1 (entget (ssname donati_text i)))) dosya)
(setq d_eleman (entget (ssname donati_text i)))
(setq old_feature (cdr (assoc 8 d_eleman)))
(setq d_eleman (subst (cons 8 "metraj_layer") (assoc 8 d_eleman) d_eleman))
(entmod d_eleman)
;*******************************************************************************
; *
; Bu satırın sonundaki t yi n yaparsanız tüm yazılar alt alta yazılır. *
; "\t" -> "\n" *
;*******************************************************************************
(if (= i (- donati_text_adet 1))
(princ "\n" dosya)
(princ "\n" dosya)
)
;*******************************************************************************
(setq i (+ i 1))
)
(close dosya)
(princ)
)


2-------------------------
;Derya KILIÇ ağu'2000 Oflaz İnşaat
;çizimdeki toplam ARC ve LINE uzunluklarını hesaplar;
(defun c:top(/ temp sset ssl nsset i topyay topciz basaci sonaci boy bas son alfa)
(prompt "\nUzunlukları Toplanacak Yay ve Doğruları Seçiniz.")
(setq sset (ssget))
(if (null sset)
(progn
(princ "\nBişey şeçilmedi.")
(exit)
)
)
;; Validate selection set
(setq ssl (sslength sset)
nsset (ssadd))
(princ "\n<Seçilen objeler inceleniyor...>")
(while (> ssl 0)
(setq temp (ssname sset (setq ssl (1- ssl))))
(if (or
(= (cdr (assoc 0 (entget temp))) "LINE")
(= (cdr (assoc 0 (entget temp))) "ARC")
(= (cdr (assoc 0 (entget temp))) "CIRCLE")
)
(ssadd temp nsset)
)
)
(setq ssl (sslength nsset)
sset nsset
)
(print ssl)
(princ " ARC, CIRCLE ve LINE objesi bulundu.")

(setq i 0 topyay 0 topciz 0)
(repeat ssl
(setq elist (entget (ssname sset i)))
(cond
((= (cdr (assoc 0 elist)) "ARC")
(setq yaricap (cdr (assoc 40 elist))
alfa (- (cdr (assoc 51 elist))
(cdr (assoc 50 elist))
)
)
(if (< alfa 0.0) (setq alfa (+ alfa (* 2 PI))))
(setq boy (* alfa yaricap)
topyay (+ topyay boy)
)
);ARC
((= (cdr (assoc 0 elist)) "CIRCLE")
(setq yaricap (cdr (assoc 40 elist))
boy (* 2 PI yaricap)
topyay (+ topyay boy)
)
);CIRCLE

((= (cdr (assoc 0 elist)) "LINE")
(setq bas (cdr (assoc 10 elist))
son (cdr (assoc 11 elist))
boy (distance bas son)
topciz (+ topciz boy)
)
);LINE
);cond
(setq i (1+ i))
)
(princ (strcat "\nYaylar = " (rtos topyay 2 2) " m. Doğrular = " (rtos topciz 2 2) " m. Toplam Uzunluk = " (rtos (+ topciz topyay) 2 2) " m"))
(princ)
);defun
(princ "\n © 2000 Derya KILIÇ\n")
(princ "\ntopla.lsp yüklendi. TOP komutu ile çalıştırınız.")
(princ)

16.04.2013 08:27    

Arkadaşlar profesyonel olarak atıksu kanalizasyon projelerinde kullanmak üzere birkaç lisp yazdırmak istiyorum yardımcı olabilirmisiniz.