13.01.2010 06:43    

ProhibiT;

Hocam ilgilendiğiniz için teşekkur ederim.Size istediğiniz bilgi mailini atmıştım. Fakat gerek kalmadı. O istediğim lispi buldum. Yani malzeme listesini excel'e atan lisp. Denedim çalışıyor.

Belki diğer arkadaşlarada lazım olur. Lisp aşağıdaki gibidir.


(defun c:b2e (/ p1 p2 p3 p4 p1a p2a p1b p4b pvlist phlist palllist newpvlist
i j column row ss palist en ed ttext fn fh
)
(setvar "osmode" 33)
(setq p1 (getpoint "\nThe left Up corner point:"))
(setq p3 (getpoint "\nThe Right Bottom corner point:"))
(setvar "osmode" 0)
(setq p2 (list (car p1) (car (cdr p3)) 0))
(setq p4 (list (car p3) (car (cdr p1)) 0))
(setq p1a (polar p1 0 1))
(setq p2a (polar p2 0 1))
(setq p1b (polar p1 (* pi 1.5) 1))
(setq p4b (polar p4 pi 1))

; Get the Table's horizontal and vertical line's place
(setq pvlist (vl-Get-Int-Pt p1a p2a))
(setq pvlist (mapcar
'(lambda (x)
(polar x pi 1)
)
pvlist
)
)
(setq phlist (vl-Get-Int-Pt p1b p4b))
(setq palllist (list pvlist))
(setq i 1)
(repeat (- (length phlist) 1)
(setq newpvlist (mapcar
'(lambda (x)
(list (car (nth i phlist)) (car (cdr x))
(car (cddr x))
)
)
pvlist
)
)
(setq palllist (append
palllist
(list newpvlist)
)
)
(setq i (1+ i))
)
(setq column (length palllist))
(setq row (length (nth 0 palllist)))
(setq j 0)
(setq finallist nil)
(repeat (- row 1)
(setq i 0
rowlist nil
)
(repeat (- column 1)
(setq pa1 (nth j (nth i palllist)))
(setq pa2 (nth (1+ j) (nth i palllist)))
(setq pa3 (nth (1+ j) (nth (1+ i) palllist)))
(setq pa4 (nth j (nth (1+ i) palllist)))
(setq palist (list pa1 pa2 pa3 pa4))
(SETQ SS (SSGET "WP" palist))
(if (/= ss nil)
(progn
(SETQ EN (SSNAME SS 0))
(SETQ ED (ENTGET EN))
(setq ttext (cdr (assoc 1 ed)))
(setq rowlist (append
rowlist
(list ttext)
)
)
)
(setq rowlist (append
rowlist
(list " ")
)
)
)
(setq i (1+ i))
)
(setq finallist (append
finallist
(list rowlist)
)
)
(setq j (1+ j))
)


;;Now all the N horizontal and M vertical lines' intersecting points(N*M) are obtained
(setq outlist finallist)

;;The subrounine to tranfer text to excel
(2xl outlist)
)


;;; A subrountine from a Korea Friend for obtaining the intersection point of a line through 2 points with many other object
(defun vl-Get-Int-Pt (FirstPoint SecondPoint / acadDocument mSpace SSetName
SSets SSet reapp ex obj Baseline
)
(vl-load-com)
(setq acadDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq mSpace (vla-get-ModelSpace acadDocument))
(setq SSetName "MySSet")
(setq SSets (vla-get-SelectionSets acadDocument))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list SSets
SSetName
)
)
)
(vla-clear (vla-Item SSets SSetName))
)
(setq SSet (vla-Item SSets SSetName))
(setq Baseline (vla-Addline mspace (vlax-3d-point FirstPoint)
(vlax-3d-point SecondPoint)
)
)
(vla-SelectByPolygon SSet acSelectionSetFence
(kht:list->safearray (append
FirstPoint
SecondPoint
) 'vlax-vbdouble
)
)
(vlax-for obj sset (if (setq ex (kht-intersect
(vlax-vla-object->ename BaseLine)
(vlax-vla-object->ename obj)
)
)
(setq reapp (append
reapp
ex
)
)
)
)
(vla-delete BaseLine)
(setq reapp (vl-sort reapp '(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
reapp
)


;;; My modify to omitting the text objects' intersection
(defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
(vl-load-com)
(setq c (cdr (assoc 0 (entget en1)))
d (cdr (assoc 0 (entget en2)))
)
(if (or
(= c "TEXT")
(= d "TEXT")
)
(setq e -1)
)
(setq En1 (vlax-ename->vla-object En1))
(setq En2 (vlax-ename->vla-object En2))
(setq a (vla-intersectwith en1 en2 acExtendNone))
(setq a (vlax-variant-value a))
(setq b (vlax-safearray-get-u-bound a 1))
(if (= e -1)
(setq b e)
)
(if (/= b -1)
(progn
(setq a (vlax-safearray->list a))
(repeat (/ (length a) 3)
(setq ex-app (append
ex-app
(list (list (car a) (cadr a) (caddr a)))
)
)
(setq a (cdr (cdr (cdr a))))
)
ex-app
)
nil
)
)

(defun kht:list->safearray (lst datatype)
(vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
(1-
(length lst)
)
)
) lst
)
)
;;; End of the Korea Friend's Subrountine


(defun TerminaExcel ()
(vlax-release-object *cells*)
(vlax-release-object *item*)
(vlax-release-object *workbooks*)
(vlax-release-object *Excel*)
)

(defun IniciaExcel (/ m)
(vl-load-com)
(setq m (vlax-get-or-create-object "excel.application"))
(if (= (vla-get-visible m) :Vlax-false)
(vla-put-visible (vlax-get-or-create-object "excel.application") T)
)

(setq *Excel* (vlax-get-or-create-object "excel.application"))
(if (= (vlax-get-property *Excel* "activeworkbook") nil)
(progn
(setq *workbooks* (vlax-get-property *Excel* "workbooks"))
(vlax-invoke-method *workbooks* "add")
(setq deltaRow nil)
)
)

(setq *workbooks* (vlax-get-property *Excel* "activeworkbook")
*item* (vlax-get-property *workbooks* "activesheet")
*cells* (vlax-get-property *item* "cells")
)
(if (= (vlax-get-object "Excel.Application") nil)
(progn
(vla-put-visible *Excel* T)
)
)


)



;; My subrounine to transfer the Table to excel
(defun 2xl (outlist / temp val cll rll cel ccel ccell curid curval curcell)
(IniciaExcel)
(setq list1 (conexcelcolumn))
(setq curRow 1)
(if (= deltaRow nil) (setq deltaRow 0))
(repeat (length outList)
(setq temp 1)
(repeat (length (nth 0 outlist))
(setq val (nth (1- temp) (nth (- curRow 1) outList)))
(setq cll (nth temp list1))
(setq rll (itoa (+ curRow deltaRow)))
(setq cel (strcat cll rll))
(setq curId (strcat (nth temp list1) (itoa (+ curRow deltaRow)))
curCell (vlax-variant-value (vlax-invoke-method *item* "Evaluate"
curId
)
)
curVal (nth (1- temp) (nth (- curRow 1) outList))
)

(vlax-put-property curCell "Formula" curVal)
(vlax-release-object curCell)
(setq temp (1+ temp))
)
(setq curRow (1+ curRow))
)
(setq deltaRow (+ deltaRow (- curRow 0)))
(TerminaExcel)
(princ)
)


;;;Subrouine to produce a list corresponding to the Excel's Column, For Example:A,B,...Z,AA,AB,....
(defun conexcelcolumn (/ a b list1)
(setq a 65)
(setq list1 nil)
(repeat 26
(setq list1 (append
list1
(list (chr a))
)
)
(setq a (1+ a))
)
(setq a 65)
(repeat 26
(setq b 65)
(repeat 26
(setq list1 (append
list1
(list (strcat (chr a) (chr b)))
)
)
(setq b (1+ b))
)
(setq a (1+ a))
)

list1
)

(prompt "\nCopyright (c) 2006 qjchen\n")
(prompt "Enter b2e to start.")
(princ)

13.01.2010 11:23    

Alıntı

---

ProhibiT :
Merhaba cngzklc,

Aradığın lispi bulmanıza, problemi çözmenize sevindim...
Gönderdiğiniz dosyadan yola çıkarak başladım yazmaya ama henüz bitirememiştim :)

Paylaştığınız Lisp'e şimdi bir göz attım, henüz denemedim.
Sizin Material tablolarınızda, sutunları oluşturan dikey çizgiler her satır için ayrı ayrı çizilmiş.
Yazmaya başladığımda bundan dolayı epeyce uğraştım.
Paylaştığınız programda, gerçekten çok zekice çözülmüş bu problem.
Sol alt köşe ile sağ üst köşe noktaları arasında hayali bir doğru düşünülmüş.
Bu doğruyla intersection'ı olan bütün yatay ve dikey çizgilerin bu hayali çizgiyle kesişim noktalarından oluşan bir matris oluşturup, hücre sınırlarını buna göre belirlemiş.
AutoCAD'de excel'e de ActiveX ile transfer etmiş. Gayet mantıklı ve akıllıca

Kolay gelsin...

---

Merhaba ProhibiT,

Bu programı çalıştırırken dikkat edilmesi gereken iki husus var.
1.'si her hangi bir excel dosyası açık olmayacak.
2.'si ise malzeme listesinde ki her satır ve her sütunda tek kelime olması gerekiyor.

Bu şekilde kontrol ederseniz daha yararlı olabilir.

Kolay gelsin.

14.01.2010 06:32    

Alıntı

---

ProhibiT :
Merhaba cngzklc :)

Öncelikle o mail adresindeki gerçek adım; başında Mehemt var :)

Göderdiğiniz çizim dosyasını aldıktan sonra konuya girdim hemen... Sutun ve satır sayısını belirlemekti ilk iş.
Bunun için öncelikle seçilen bölgedeki (tablodaki) bütün çizgilerlerden (Line Objects) bir selection set oluşturdum. Bunların içinde başlangıç ve bitim noktalarının X değerleri kendi içinde biribirine eşit olanlar dikey. Benzer şekilde başlangıç ve bitim noktalarının Y değerleri biribirine eşit olanlar da yatay çizgiler diyip guruplandırdım.

Dikey çizgilerin her satırda ayrı ayrı çizgiler olması ve X koordinatları biribirinden çok, çok küçük farklarla da olsa farklı olmaları işi karıştırıyordu. X leri teorik olarak biribirinden farklı olan bu çizgiler pratikte tek bir sütun çizgisiydiler...

Kısacası 2 gün boğuştum bu problemle :)) sonunda da işin bu kısmını çözmüştüm...
Tam bu arada sizin paylaştığınız Lispi gördüm. Adamcağız o kadar akıllıca, o kadar sade ve basit bir mantıkla çözmüşki benim debelenip durduğum problemi. Kendime kızdım, adama hayranlık duydum açıkçası...

Her nesye, bir şey daha öğrenmiş olduk. Son yazdığınız mesajda bahsettiğiniz, her hücrede bir tek text kabul etmesi durumu ilginç. Ama o algoritmanın sadeliği ve basitliği açısından da mantıklı.

Birilerinin bu seviyede çözdüğü bir konuda yeniden bir şeyler yazmak artık pek mantıklı değil, Amerika'yı yeniden keşfetmek gibi olacak. Paylaştığınız örnekte algoritma ve çözüm mantığı ne kadar sade ve basitse, programın kodlama tekniği de bir o kadar uzun ve gereksiz derecede karmaşık geldi bana. Bahsettiğiniz AutoCAD ortamındaki hücre içinde birden fazla text olması durumu çözülebilir bir şeydir büyük ihtimalle. Ama dediğim gibi kompleks yaptım :)))

Selamlar, Saygılar, Kolay gelsin...

---

Merhaba Mehmet Abi,

Gönderdiğim dosyada orta sütun için söyleyim; her satırda 3 kelime var. Bunu da 3 kelimenin arasında ki iki boşluğa dikey çizgi çizerek çözdüm ve problemsiz çalışıyor.

Tekrar ilgilendiğin için teşekkur ederim.
Kolay gelsin.

14.01.2010 09:33    

mstylmz, bu lisp işini görür sanırım.

(defun c:ty ()
(setq tc_met (getstring t "\nSayıların başına gelecek metni yazın:"))
(if (= tc_met nil)
(progn)
(progn

(setq tc_num (getint "\nBirinci Numara:"))
(if (= tc_num nil)
(progn)
(progn
(setvar "errno" 0)
(setq tc_num_uy tc_num)
(setq tc_ent nil)
(while (= tc_ent nil)
(initget "C")
(setq tc_ent (entsel "\nYazıyı Seç / Cıkış:"))
(if (= tc_ent nil)
(progn
(if (= (getvar "errno") 0)
(progn
(setq tc_ent nil)
(setvar "errno" 0)
)
)
(if (= (getvar "errno") 52)
(progn
(setq tc_ent t)
(setvar "errno" 0)
)
)
)
(progn
(setq tc_tan (cdr (assoc 0 (entget (car tc_ent)))))
(if (/= tc_tan "TEXT")
(progn
(princ "\nSeçilen nesne yazı değil...")
(setq tc_ent nil)
)
(progn
(setq tc_stil (cdr (assoc 7 (entget (car tc_ent)))))
(setq tc_stil_yuk
(cdr (assoc 40 (tblsearch "style" tc_stil))
)
)
(if (= tc_stil_yuk 0.0)
(progn
(command "change" tc_ent "" "" "" "" "" "" (strcat tc_met (rtos tc_num_uy 2 0)))
(setq tc_num_uy (1+ tc_num_uy))
(setq tc_ent nil)
)
(progn
(command "change" tc_ent "" ""
"" "" "" (strcat tc_met (rtos tc_num_uy 2 0)
))
(setq tc_num_uy (1+ tc_num_uy))
(setq tc_ent nil)
)
)
)
)
)
)
)
)
)))
(princ)
)
(princ)

14.01.2010 09:51    

komut ismi ty

komutu girdiğinde

"Sayıların başına gelecek metni yazın:" yazısı gelecek, oraya 100. yazabilirsin.

Enter'e bastığında "Birinci Numara:" yazısı gelecek, buraya da 5 yazabilirsin.

her tıkladığın yazıya sırayla 100.5 , 100.6 , 100.7 gibi numaralandıracaktır.

14.01.2010 10:19    

komut ismi ty

komutu girdiğinde

"Sayıların başına gelecek metni yazın:" yazısı gelecek, oraya 100. yazabilirsin.

Enter'e bastığında "Birinci Numara:" yazısı gelecek, buraya da 5 yazabilirsin.

her tıkladığın yazıya sırayla 100.5 , 100.6 , 100.7 gibi numaralandıracaktır.

hocam komutu girdim "Sayıların başına gelecek metni yazın:" gir yazdı "100. "girdim
birinci numara yazdı onada"1" dedim ama daha sonra yazıyı seç uyarısı çıktı direk tıklama olmuyor yazı seç uyarısı veriyor. herhangi bir yazıyı seçersem 100.1 yapıyor kendisi direk tıklayınca yazıları atmıyor.

15.01.2010 12:10    

IYI GUNLER
. yardımınızı istediğim konu, excell.den aktardığım noktaların numara adlarının görünmemesi, excellden noktaları atıyorum ama, sadece noktalar olarak, bunların numaralarının da görünmesini rica edecektim. bu konuda lsp.niz varsa yardımcı olursanız sevinirim

05.02.2010 09:25    

elimdeki koordinat veren lisp için birkaç değişiklik yapılmasını rica edicem. ilgilenebilecek kişilere şimdiden teşekkürler.

istediğim şeyler şunlar...

komutu girince. kendisi yeni bir layer açsın, "koordinat" adında... bu layer kırmızı olsun, verdiği koordinatları kutu içinde versin, kutunun köşesinden, koordinat noktasına bir çizgi olsun....

şeklide görüldüğü gibi...

[URL=http://img69.imageshack.us/i/adszp.gif/][IMG]http://img69.imageshack.us/img69/1053/adszp.gif[/IMG][/URL]



(defun c:kn (/ gec_stil gec_yuk nokta_yakala aralik bilgi nokta x y nokta_y nokta_2 nok_y

x_koor y_koor x_1 y_1 yazi aciklama)
(prompt "
10/2005 © Ver 2.0 Koordinat yazımı.")

(setvar "CMDECHO" 0)
(setq gec_stil (getvar "TEXTSTYLE"))
(setq gec_yuk ( getvar "TEXTSIZE"))
(setq nokta_yakala (getvar "OSMODE"))


(setq aralik (* gec_yuk 1.618))

(setq bilgi (strcat "
Aktif yazı stili <" gec_stil "> / yüksekliği <" (rtos gec_yuk) "> dir."))
(princ bilgi)

(while (= nokta nil)
(setq nokta (getpoint "
Koordinatı alınacak noktayı giriniz: "))
(if (= nokta nil) (princ "Bir nokta girmelisiniz..."))
)
(setq x (car nokta)
y (cadr nokta))

(setq x_koor (strcat "x:" (rtos x) ))
(setq y_koor (strcat "y:" (rtos y)))
(princ x_koor) (princ y_koor)

(setq nokta_y (getpoint ( strcat "
Yazının başlangıç noktasını giriniz /<Koordinat noktası>: ")))
(if (= nokta_y nil) (setq nokta_y nokta))

(setq x_1 (car nokta_y)
y_1 (cadr nokta_y))

(setq nok_y (- y_1 aralik))
(setq nokta_2 (list x_1 nok_y))

(setvar "OSMODE" 0)

;;;******************************** değiştirilebilir bölüm

(command "text" nokta_y "" "" x_koor)
;(command "text" "S" "STANDARD" nokta_y "" "0" x_koor)

(command "text" nokta_2 "" "" y_koor)
;(command "text" "S" "STANDARD" nokta_2 "" "0" y_koor)

(command "._line" nokta nokta_y "")

;;;*********************************

(setvar "OSMODE" nokta_yakala)
(princ))

08.02.2010 11:48    

Alıntı

---

ProhibiT :
İstediğinizi çok net ifade etmişsiniz. Ama, burada verilen AutoLisp kod çok uzun. Bu kadarına gerek var mı? Bir düşünün... Bir de şunu deneyin;

---

bu kadarına gerek varmı bilemem çünkü ben lisp yazmayı bilmiyorum :D

bu kadar uzun yazılmış olmasının sebepleri de farklı olabilir elbet. mesela; en son hangi yazı karakterini kullandıysan o karakter ile koordinat veriyordu "kn" lispi....

senin en son yazdığın lisp gerçekten çok güzel olmuş. ama koordinat verirken standart yazıda koordinat veriyor. sonradan ona ince ayar yapmak zorunda kalıyoruz. dert değil bu böyle de olur.. teşekkürler eline sağlık.

(sonradan gelen edit)... mesela. x ve y satırlarının aralarını daha yakın tutmak, kutucuk ile yazı arasındaki mesafeyi dar tutmak.... v.s v.s bu tarz ayarları lispin neresinden değiştirebilirim böyle bir olanak var mı acaba?

yani lispte basit değişiklikleri yapmak istiyorum da. hem böylece biraz daha içine girmiş olurum lisp yazma işinin....

09.02.2010 10:28    

üstadım bu kadar zahmetlere giriyorsunuz ya allah razı olsun... ama ben de bu işi öğrenip başkalarına aynı yolla yardım etmek istiyorum. sadece bir yol göstericiye ihtiyacım var. çabuk öğrenen biriyim zaten. azcıkta html ve php kodlama mantığını da bilirim. yani bence ben bu işi yaparım :D


kullandıktan sonra gelen edit.... espas ı değiştirdim. ve böylece kullandım. fevkaladenin fevkinde olmuş eline fikrine sağlık... bence site yönetimi, bu lispi şuan ki koordinat veren lisp ile değiştirmeli...