13.01.2010 02:51    

kemalizmir3535
iyi günler. 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

13.01.2010 06:43    

cngzklc
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 08:05    

ProhibiT
Merhaba cngzklc,

Aradığınız 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...

ProhibiT (13.01.2010 16:54 GMT)

13.01.2010 11:23    

cngzklc
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.

13.01.2010 17:25    

ProhibiT
Merhaba cngzklc :)

Öncelikle o mail adresindeki gerçek adım; başında Mehmet 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...

ProhibiT (14.02.2010 15:20 GMT)

14.01.2010 06:32    

cngzklc
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 08:18    

mstylmz
Arkadaşlar merhaba,

bana her tıklayışta 100.1,100.2.100.3 şeklinde sayı atayacak lisp lazım yardımcı olursanız sevinirim.
teşekkürler

14.01.2010 09:33    

ec
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:44    

mstylmz
çok sağol teşekkürler ama komutun ismi ne nasıl giricem

14.01.2010 09:51    

ec
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 09:56    

miyatu
Alıntı
ec :
miyatu teşekkür ederim.

ama çalıştıramadım. sanırım bir hata var.

şu şekilde;

Command: BLD
referans bloklari sec:
Select objects: Specify opposite corner: 6 found

Select objects:
error: bad argument type: lentityp nil



hata duzeltildi...

Kod:

(defun c:bld()
  (prompt "referans bloklari sec:")
  (setq ref_blok_set (ssget '((0 . "INSERT"))))
  (setq ns (sslength ref_blok_set))
  (while (< 0 ns)
    (setq ref_ad (cdr (assoc 2 (entget (ssname ref_blok_set (- ns 1))))))
    (setq ref_layer (cdr (assoc 8 (entget (ssname ref_blok_set (- ns 1))))))
    (setq sset (ssget "X" (list (cons 0 "INSERT") (cons 2 ref_ad))))
    (setq ns1 (sslength sset))
    (setq ent1 (ssname sset 0))
    (while (< 0 ns1)
      (setq liste (entget ent1))
      (setq liste (subst (cons 8 ref_layer) (assoc 10 liste) liste ))
      (entmod liste)
      (setq ns1 (- ns1 1))
      (setq ent1 (ssname sset (- ns1 1)))
      (princ "\ndegisti_layer"))
    (setq ns (- ns 1))
    (princ "\ndegisti_nesne")))

14.01.2010 10:19    

mstylmz
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.

14.01.2010 10:33    

ec
miyatu teşekkür ederim. çok işime yarayacak.

15.01.2010 12:10    

kemalizmir3535
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

21.01.2010 13:38    

ProhibiT


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

05.02.2010 09:25    

HIPHOP
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))

HIPHOP (05.02.2010 09:36 GMT)

06.02.2010 07:48    

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;
Kod:

(defun c:xy ()
  (setvar "cmdecho" 0)
  (while (setq nokta (getpoint "\Nokta seciniz..."))
    (setq yyer (getpoint nokta)
          x (car nokta) y (cadr nokta)
          yz1 (strcat "X:" (rtos x))
          yz2 (strcat "Y:" (rtos y))
    )
    (command "leader" nokta yyer "" yz1 yz2 "")
  )
  (prin1)
)

Koordinat isimli ve rengi 1 olan Layer'ı kullanıcı oluştursun, fonksiyonu çalıştırmadan önce de current Layer yapıversin. Çok mu eziyet olur? Yukarıda verdiğiniz açıklamalardan Yazı çerçvesi eksik, ve ucunda da ok var :)

İlle de yukarıda verdiğiniz gib olsun istiyorsanız yazılır elbette. Ama açıkçası verdiğiniz kodu edit ederek değil....

Kolay gelsin...

Düzenleme: Çok ısrar ettiniz bir de sizin istediğiniz şekilde yazayım bari :)
Kod:

(defun c:koor ()
  (setvar "cmdecho" 0)
  (setq txh (* (getvar "DIMSCALE") (getvar "TEXTSIZE")))
  (if (tblsearch "LAYER" "Koordinat")
    (command "layer" "c" "1" "Koordinat" "")
    (command "LAYER" "n" "Koordinat" "c" "1" "Koordinat" ""))
  (while (setq nokta (getpoint "\Koordinatı Yazılacak Noktayı seciniz : "))
    (setq n1 (getpoint nokta "\nKoordinatın Yazılacağı Noktayı seciniz : ")
          yz1 (strcat "x:" (rtos (car nokta)))
          yz2 (strcat "y:" (rtos (cadr nokta))))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz1)
      (cons 50 0) (cons 10 (polar (polar n1 (/ pi 4.0) txh) (/ pi 2.0) (* 1.7071 txh)))))
    (setq t1 (entget (entlast)))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz2)
      (cons 50 0) (cons 10 (polar n1 (/ pi 4.0) txh))))
    (setq t2 (entget (entlast)) p1x (caar (textbox t2)))
    (if (> (caadr (textbox t1)) (caadr (textbox t2)))
      (setq p2x (caadr (textbox t1)))
      (setq p2x (caadr (textbox t2))))
    (setq n2 (polar n1 0 (+ (- p2x p1x) (* 1.4142 txh)))
          n3 (polar n2 (/ pi 2.0) (* 2.5 1.7071 txh))
          n4 (polar n3 pi (+ (- p2x p1x) (* 1.4142 txh))))
    (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 8 "Koordinat")
                   (cons 100 "AcDbLine") (cons 10 nokta) (cons 11 n1)))
    (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0)
                   (cons 8 "Koordinat") (cons 100 "AcDbPolyline") (cons 90 4)
                   (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3) (cons 10 n4)))
  )
  (prin1)
)

Layer konusuna kafayı takmıyoruz, Koordinat Layer'ı yoksa yapılır, varsa rengi kontrol edilip Kırmızı olması sağlanır.
Siz yeni noktalar seçtiğiniz sürece koordinat yazmaya devam eder, enter (ya da sağ tuş) girdiğinizde fonksiyon sona erer...

Son düzenleme: Koordinat işinin suyunu çıkardık sayenizde :)



Resimde görüldüğü gibi Koordinat yazılarının değişik konumlar için düzenledim
Kod:

(defun c:koor ()
  (setvar "cmdecho" 0)
  (setq txh (* (getvar "DIMSCALE") (getvar "TEXTSIZE")))
  (setq mirtxo (getvar "mirrtext")) (setvar "mirrtext" 0)
  (if (tblsearch "LAYER" "Koordinat") (command "layer" "c" "1" "Koordinat" "")
    (command "LAYER" "n" "Koordinat" "c" "1" "Koordinat" ""))
  (while (setq nokta (getpoint "\Koordinatı Yazılacak Noktayı seciniz : "))
    (setq n1 (getpoint nokta "\nKoordinatın Yazılacağı Noktayı seciniz : ")
          yz1 (strcat "x:" (rtos (car nokta) (getvar "dimdec") 2))
          yz2 (strcat "y:" (rtos (cadr nokta) (getvar "dimdec") 2))
          aci(angle nokta n1))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz1)
                   (cons 50 0) (cons 10 (polar (polar n1 (/ pi 4.0) txh) (/ pi 2.0) (* (+ 1 0.7071) txh)))))
    (setq t1 (entget (entlast)))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh) (cons 1 yz2)
                   (cons 50 0) (cons 10 (polar n1 (/ pi 4.0) txh))))
    (setq t2 (entget (entlast)) p1x (caar (textbox t2)))
    (if (> (caadr (textbox t1)) (caadr (textbox t2)))
      (setq p2x (caadr (textbox t1))) (setq p2x (caadr (textbox t2))))
    (setq lx (+ (- p2x p1x) (* 2.0 0.7071 txh)) ly (* (+ 2.0 (* 3.0 0.7071)) txh))
    (cond ((and (>= aci 0) (<= aci (/ pi 2.0)))
           (setq n2 (polar n1 0 lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 pi lx)))
          ((and (> aci (/ pi 2.0)) (<= aci pi))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2))
           (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 pi lx) n3 (polar n2 (/ pi 2.0) ly) n4 (polar n3 0 lx)))
          ((and (> aci pi) (<= aci (* 1.50 pi)))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx)) (assoc 10 t1) t1)
                 t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx)) (assoc 10 t2) t2)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2))
           (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 pi lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 0 lx)))
          ((> aci (* pi 1.50))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly)) (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly)) (assoc 10 t2) t2))
           (entmod t1) (entmod t2) (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 0 lx) n3 (polar n2 (* pi 1.50) ly) n4 (polar n3 pi lx))))
    (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 8 "Koordinat")
                   (cons 100 "AcDbLine") (cons 10 nokta) (cons 11 n1)))
    (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0)
                   (cons 8 "Koordinat") (cons 100 "AcDbPolyline") (cons 90 4)
                   (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3) (cons 10 n4)))
  )
  (prin1)
)

ProhibiT (08.02.2010 19:53 GMT)

08.02.2010 11:48    

HIPHOP
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....

HIPHOP (08.02.2010 11:59 GMT)

08.02.2010 18:58    

ProhibiT
Neden bu kadar uzun derken ben destan gibi uzatmışım :)

Text'ler, Espaslar ve Çerçeve Boyutlarında esas aldığım kriterler;

Neredeyse bütün -.shx türü fontlarda, satır aralarındaki temiz aralık=h/cos.alfa kadardır.
Burada h= yazı yüksekliği, alfa=45 derece dir. bu durumda; satır aralığı=h/cos.alfa=h/sqrt(2)=h/1.4142=0.7071h olur.

Yazıların arasındaki satır aralığını ve çerçeveye olan uzaklıklarını bu prensibe göre belirledim.
Bu mesafeleri değiştirmek için aşağıdaki kod içinde "espas" ın yanındaki 0.7071 değerini değiştirmek yeterli.

Yazı yüksekliği ve Yazı Stilini, istediğiniz gibi, son kullanılan Yazı özelliklerini (TextSize ve Current Text Style) kullanacak şekilde değiştirdim.

Kod:

(defun c:koor (/ tsty odz espas dp txh mirtxo nokta n1 yz1 yz2 ti1 ti2 t1 t2
                 p1x p2x n2 n3 n4 aci *error*)
  (command "_.undo" "group") (setvar "cmdecho" 0)
  (defun *error* (er) (princ (strcat "\n" er)) (setq *error* nil)
    (setvar "mirrtext" mirtxo) (setvar "dimzin" odz) (command "_.undo" "e"))
  (setq tsty  (getvar "TEXTSTYLE") odz (getvar "dimzin") espas 0.7071)
  (setvar "dimzin" 0) (if (not odp) (setq odp 2))
  (setq mirtxo (getvar "mirrtext")) (setvar "mirrtext" 0)
  (if (setq dp (getint
                 (strcat "\nOndalık Basamak Sayısı <" (itoa odp) ">: ")))
    (setq odp dp) (setq dp odp))
  (if (not oth) (setq oth (getvar "TEXTSIZE")))
  (if (setq txh (getreal
              (strcat "\n      Yazı Yüksekliği <" (rtos oth 2 dp) ">: ")))
    (setq oth txh) (setq txh oth))
  (if (not (tblsearch "LAYER" "Koordinat"))
    (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
                   (cons 100 "AcDbLayerTableRecord") (cons 2 "Koordinat")
                   (cons 70 0) (cons 62 1) (cons 6 "Continuous"))))
  (while (setq nokta (getpoint "\nKoordinatı Yazılacak Noktayı seciniz : "))
    (setq n1  (getpoint nokta "\n    Koordinat Yazılacak Yeri seciniz : ")
          yz1 (strcat "x:" (rtos (car nokta) 2 dp))
          yz2 (strcat "y:" (rtos (cadr nokta) 2 dp))
          ti1 (list (+ (car n1) (* espas txh)) (+ (cadr n1) (* espas txh)) 0.0)
          ti2 (list (car ti1) (+ (cadr ti1) txh (* espas txh)) 0.0)
          aci (angle nokta n1))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh)
                   (cons 1 yz1) (cons 50 0) (cons 10 ti2) (cons 7 tsty)))
    (setq t1 (entget (entlast)))
    (entmake (list (cons 0 "TEXT") (cons 8 "Koordinat") (cons 40 txh)
                   (cons 1 yz2) (cons 50 0) (cons 10 ti1) (cons 7 tsty)))
    (setq t2  (entget (entlast)) p1x (caar (textbox t2)))
    (if (> (caadr (textbox t1)) (caadr (textbox t2)))
      (setq p2x (caadr (textbox t1))) (setq p2x (caadr (textbox t2))))
    (setq lx (+ (- p2x p1x) (* 2.0 espas txh)) ly (* (+ 2.0 (* 3.0 espas)) txh))
    (cond ((and (>= aci 0) (<= aci (/ pi 2.0)))
           (setq n2 (polar n1 0 lx) n3 (polar n2 (/ pi 2.0) ly)
                 n4 (polar n3 pi lx)))
          ((and (> aci (/ pi 2.0)) (<= aci pi))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx))
                           (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx))
                           (assoc 10 t2) t2)) (entmod t1) (entmod t2)
           (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 pi lx) n3 (polar n2 (/ pi 2.0) ly)
                 n4 (polar n3 0 lx)))
          ((and (> aci pi) (<= aci (* 1.50 pi)))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) pi lx))
                           (assoc 10 t1) t1)
                 t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly))
                           (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) pi lx))
                           (assoc 10 t2) t2)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly))
                           (assoc 10 t2) t2)) (entmod t1) (entmod t2)
           (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 pi lx) n3 (polar n2 (* pi 1.50) ly)
                 n4 (polar n3 0 lx)))
          ((> aci (* pi 1.50))
           (setq t1 (subst (cons 10 (polar (cdr (assoc 10 t1)) (* pi 1.50) ly))
                           (assoc 10 t1) t1)
                 t2 (subst (cons 10 (polar (cdr (assoc 10 t2)) (* pi 1.50) ly))
                           (assoc 10 t2) t2)) (entmod t1) (entmod t2)
           (entupd (cdr (assoc -1 t1))) (entupd (cdr (assoc -1 t2)))
           (setq n2 (polar n1 0 lx) n3 (polar n2 (* pi 1.50) ly)
                 n4 (polar n3 pi lx))))
    (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 8 "Koordinat")
                   (cons 100 "AcDbLine") (cons 10 nokta) (cons 11 n1)))
    (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0)
                   (cons 8 "Koordinat") (cons 100 "AcDbPolyline") (cons 90 4)
                   (cons 70 1) (cons 10 n1) (cons 10 n2) (cons 10 n3)
                   (cons 10 n4))))
  (setvar "mirrtext" mirtxo) (setvar "dimzin" odz) (command "_.undo" "e")
  (setq *error* nil) (prin1)
)


Kolay gelsin...

ProhibiT (31.12.2011 19:33 GMT)

09.02.2010 10:28    

HIPHOP
ü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...

HIPHOP (09.02.2010 10:34 GMT)

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] > 11 < [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.664 saniye - Sorgu: 98 - Ortalama: 0.01698 saniye