26.11.2013 13:56    

pulp fiction
arkadaşlar merhaba;

mesela 4-9-6-6 gibi ayrı sayıları toplayıp metraj lispindeki adet kısmına toplamını yazan bir lisp mümkün mü? insert field ten tek tek çok zaman alıyor.

şimdiden teşekkürler...

27.11.2013 00:25    

ProhibiT
Kod:

;|===========================================================================|
| CEM: Seçilen obje gurubundaki textler icindeki sayilarin toplamını        |
|      bularak gösterilen yere yazar. Gösterilen yerde bir Yazı varsa,      |
|      bu yazı değiştirilir, yoksa yeni bir yazı oluşturulur.               |
|      Hazırlayan M.S.Güvercin (ProhibiT) www.cizimokulu.com  27.11.2013    |
|___________________________________________________________________________|;
(defun C:CEM (/ *error* TrnsLt a ctx dro er L nes ness p sp sp0 top tp)
  (defun *error* () (command "_.undo" "end"))
  (defun TrnsLt (pr1 pr2 pr3 /) (vla-transformby (vlax-ename->vla-object pr1)
      (vlax-tmatrix (list (list 1 0 0 (- (car (cadr pr2)) (car pr3)))
                          (list 0 1 0 (- (cadr (cadr pr2)) (cadr pr3)))
                          (list 0 0 1 (- (caddr (cadr pr2)) (caddr pr3)))
  (list 0 0 0 1))))) (setvar "cmdecho" 0)(command "undo" "group")(vl-load-com)
  (setq p (ssget (list (cons 0 "*TEXT"))) nes 0 top 0 l (sslength p))
  (while (not (minusp (setq l (1- l))))
    (setq ness (entget (ssname p l)) top (+ top (atof (cdr (assoc 1 ness))))))
  (entmake (list '(0 . "TEXT") '(10 0.0 0.0 0.0) '(11 0.0 0.0 0.0) '(72 . 0)
               (cons 40 (getvar "TextSize")) '(50 . 0.0) (cons 1 (rtos top))))
  (setq dro (entlast) sp0 (list 0.0 0.0 0.0) a nil)
  (princ "\nToplamın yazılacağı yer <Enter=Çıkış>: ")
  (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
    (if a (redraw (ssname a 0) 4)) (TrnsLt dro sp sp0) (entdel dro)
    (setq sp0 (cadr sp))
    (if (setq a (ssget sp0 (list (cons 0 "*text")))) (redraw (ssname a 0) 3))
    (entdel dro))
  (if (= (car sp) 3) (progn (TrnsLt dro sp sp0) (entdel dro)
      (if (setq tp (ssget sp0 (list (cons 0 "*text"))))
          (setq ctx (entget (ssname tp 0))
                ctx (subst (cons 1 (rtos top)) (assoc 1 ctx) ctx)
                ctx (entmod ctx) ctx (entupd (cdr (assoc -1 ctx))))
          (entdel dro))) (entdel dro)) (command "undo" "e") (prin1))

27.11.2013 07:20    

pulp fiction
Alıntı
ProhibiT :
.
.



Hocam bu lispte textleri topluyor ve tıkladığımız texte adet veriyor. metraj attribute nin içindeki adet kısmına field li bir şekilde atması mümkün mü toplamı. örnek olarak dwg. gönderdim daha anlaşılır olması için... 115597-ornek.dwg

ProhibiT (27.11.2013 07:46 GMT)

27.11.2013 07:50    

ProhibiT
Mümkün elbette. Ama, uğraşmak lazım. Kendi adıma vaktim ve sabrım yetmez açıkçası :)

27.11.2013 08:09    

pulp fiction
Alıntı
ProhibiT :
Mümkün elbette. Ama, uğraşmak lazım. Kendi adıma vaktim ve sabrım yetmez açıkçası :)



canın saolsun hocam :=)

27.11.2013 15:51    

ProhibiT
Kod:

;|===========================================================================|
| CEM: Seçilen obje gurubundaki textler icindeki sayilarin toplamını        |
|      bularak gösterilen yere field olarak yazar. Gösterilen yerde bir     |
|      Yazı varsa, bu yazı değiştirilir, yoksa yeni bir yazı oluşturulur.   |
|      Hazırlayan M.S.Güvercin (ProhibiT) www.cizimokulu.com  27.11.2013    |
|___________________________________________________________________________|;
(defun C:CEM (/ *error* TrnsLt a ctx dro IDs L p sp sp0 tp)
  (defun *error* () (command "_.undo" "end"))
  (defun TrnsLt (pr1 pr2 pr3 /) (vla-transformby (vlax-ename->vla-object pr1)
      (vlax-tmatrix (list (list 1 0 0 (- (car (cadr pr2)) (car pr3)))
                          (list 0 1 0 (- (cadr (cadr pr2)) (cadr pr3)))
                          (list 0 0 1 (- (caddr (cadr pr2)) (caddr pr3)))
                          (list 0 0 0 1)))))
  (setvar "cmdecho" 0)(command "undo" "group")(vl-load-com)
  (setq p (ssget (list (cons 0 "*TEXT"))) IDs "%<\\AcExpr (" L (sslength p))
  (while (not (minusp (setq L (1- L))))
    (setq IDs (strcat IDs "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-ObjectID (vlax-ename->vla-object (ssname p L))))
                      ">%).TextString>%+")))
  (setq IDs (strcat (substr IDs 1 (1- (strlen IDs))) ")>%"))
  (entmake (list '(0 . "TEXT") '(10 0.0 0.0 0.0) '(11 0.0 0.0 0.0) '(72 . 0)
                 (cons 40 (getvar "TextSize")) '(50 . 0.0) (cons 1 IDs)))
  (setq dro (entlast) sp0 '(0.0 0.0 0.0) a nil) (command "updatefield" dro "")
  (princ "\nToplamın yazılacağı yer <Enter=Çıkış>: ")
  (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
    (if a (redraw (ssname a 0) 4)) (TrnsLt dro sp sp0) (entdel dro)
    (setq sp0 (cadr sp))
    (if (setq a (ssget sp0 (list (cons 0 "*text")))) (redraw (ssname a 0) 3))
    (entdel dro))
  (if (= (car sp) 3) (progn (TrnsLt dro sp sp0) (entdel dro)
      (if (setq tp (ssget sp0 (list (cons 0 "*text"))))
          (setq ctx (entget (ssname tp 0))
                ctx (subst (cons 1 IDs) (assoc 1 ctx) ctx) ctx (entmod ctx)
                ctx (command "updatefield" (cdr (assoc -1 ctx)) ""))
        (entdel dro))) (entdel dro)) (command "undo" "e") (prin1))

Toplanmak üzere seçilen Text veya Mtext nesnleri de field özelliğine sahip olabilir.

Seçilen nesnelerin tamamının içeriği tamsayı (integer) türünde olduğunda problem yok, sonuç ta tamsayı olarak yazılır.

Bir tekinde bile ondalık sayı olması durumunda (toplam küsuratsız tamsayı olsa bile) ondalık sayı olarak yazılır. Yazılan sayının ondalık basamak sayısı kontrol edilmez, Dimzin, Luprec ve Field'larda kullanılan basamak sayısı (precission) değerine göre belirlenir.

İçerik değerleri toplanmak üzere seçilen Text veya Mtext nesnelerinin içeriğinde sayısal olmayan karakterler olduğunda, oluşturulan ya da değiştirilen nesne #### şeklinde hatalı görüntülenir.

27.11.2013 21:34    

Travaci
Alıntı
pulp fiction :
Alıntı
ProhibiT :
Mümkün elbette. Ama, uğraşmak lazım. Kendi adıma vaktim ve sabrım yetmez açıkçası :)


canın saolsun hocam :=)


Şahin hocamın iki lispini combine edince bu çıktı ortaya : )

Kod:

(defun c:tpp (/)
   (vl-load-com)
   (setq p (ssget (list (cons 0 "*TEXT"))) IDs "%<\\AcExpr (" L (sslength p))
   (while (not (minusp (setq L (1- L))))
      (setq IDs (strcat IDs "%<\\AcObjProp Object(%<\\_ObjId "
         (itoa (vla-get-ObjectID (vlax-ename->vla-object (ssname p L))))
         ">%).TextString>%+")))
   (setq IDs (strcat (substr IDs 1 (1- (strlen IDs))) ")>%")
      PvT (car (entsel "\nPoz'u Seçiniz: "))) 
   (while (not(and(=(cdr(assoc 0(entget(setq PvT(entnext PvT)))))"ATTRIB")
      (=(cdr(assoc 2(entget PvT)))"ADET"))))
   (setq PvT (entget PvT)
      PvT (subst (cons 1 IDs) (assoc 1 PvT) PvT) PvT (entmod PvT)
      PvT (entupd (cdr (assoc -1 PvT))) PvT (command "_.UpdateFieLd" PvT ""))
      (prin1))

28.11.2013 07:20    

pulp fiction
Alıntı
Travaci :
Alıntı
pulp fiction :
Alıntı
ProhibiT :
Mümkün elbette. Ama, uğraşmak lazım. Kendi adıma vaktim ve sabrım yetmez açıkçası :)


canın saolsun hocam :=)


Şahin hocamın iki lispini combine edince bu çıktı ortaya : )
.
.
.



hocam muhteşemsin saolasın ellerin dert görmesin :=)

ProhibiT (28.11.2013 08:51 GMT)

28.11.2013 09:01    

ProhibiT
Arkadaşlar sizlerden bir ricam var, alıntı yaparken kod bölümünü almayalım. Aynı Lisp kodunun forumda defalarca yer almasına hem gerek yok, hem de karmaşaya sebep oluyor. Kodların yazarı bir düzenleme yapıyor, alıntılar eski haline kalınca, aradan geçen zaman içinde yazanın bile kafası karışıyor.

28.11.2013 09:22    

özkan-wien
arkadaslar merhaba, dwg icindeki "layer filter" larini nasil kontrol edebilir. Yani var mi yok mu diye?

30.11.2013 08:33    

pulp fiction
arkadaşlar bıktınız benden biliyorum ama son bir şey istiyeceğim :)

seçtiğim textleri seçtiğim sırayla fieldlı bir çekilde boşluk bırakarak attribute te aktaran bir lisp mümkün mü?

örnek;

10 95 25 95 25 30

bu şekilde fieldlı şekilde aktaracak... toplama yapmayacak...

02.12.2013 13:29    

sonerik
Merhabalar;

Bende ekteki dosyada blok yapılmış bir attribute antedim var. bu anted deki sıra numaralarını takip edebileceğim bir lisp yapılabilinir mi? bana liste halinde (exel v.b.) versede olur. veya her kod girdiğinde kendi otomatik sıra ile gitmeli. Neye göre sıra ile gitmeli ? Ürün satırındaki kısa koda göre. Bu anted barkot sistemi için hazırlandı. Barkot işin adı ile başlayıp sıra no ile bitiyor. benim için en önemli sutunlar ürün ve sıra no. Ürün cinsine göre belli bir kod tanımı var. Örnek: Alüminyum levha= all, çelik levha= cll, doğrama=dgr,

136142-is-emri.dwg

02.12.2013 15:30    

özkan-wien
arkadaslar bir liste icindeki ayni elemanlari nasil silebiliriz.

remove duplicate diye bi sey var mi Lisp icin.? tesekkürler

02.12.2013 15:53    

ehya
liste örneğini verirmisin?

02.12.2013 16:01    

özkan-wien
("Plan_kote" "Höhenkote" "Tür_90" "Parkplatzmarkierung" "Tür_90" "Dyn-Batt" "Tür_abb" "Tür_80" "Revision_cloud" "Revision_cloud_text" "Schacht-" "Symbole" "Tür_bst" "BS-Symbole" "Dimention" "Tür_80")

söyle bisey bi klasör altindaki dwglerin listesini aldim, sonlarindaki "status.dwg" leri sildim, ayni olanlari da silmek istiyorum, yani bi tanesi kalacak.

özkan-wien (02.12.2013 22:27 GMT)

02.12.2013 16:21    

sonerik
Alıntı
ehya :
liste örneğini verirmisin?



136142-ornek.xls Bu örnek olabilir. acıklamalarınıda yazdım bilgi amaçlı. Teşekkürler.

02.12.2013 17:25    

ProhibiT
Alıntı
özkan-wien :
("Plan_kote" "Höhenkote" "Tür_90" "Parkplatzmarkierung" "Tür_90" "Dyn-Batt" "Tür_abb" "Tür_80" "Revision_cloud" "Revision_cloud_text" "Schacht-" "Symbole" "Tür_bst" "BS-Symbole" "Dimention" "Tür_80")

söyle bisey bi klasör altindaki dwglerin listesini aldim, sonlarindaki "dwg" leri sildim, ayni olanlari da silmek istiyorum, yani bi tanesi kalacak.



Burada paylaştığım DimInt fonksiyonunda kullandığım bir algoritma var;
Kod:

(setq L (length nks) m -1)
(while (< (setq m (1+ m)) L)
  (setq nks (append (vl-remove (setq tmp (nth m nks)) nks) (list tmp))
        L   (length nks)))
(setq nok (vl-sort nks '<) (length nok))

Bir line nesnesi ile bir gurup nesnenin intersection'ları bulunup nks değişken adlı listeye atandıktan sonra, bu liste içinde (üst üste çizgiler olduğunda ortaya çıkan) biribirinin aynı noktaların elenmesi için kullandığım bir algoritma.

Liste içindeki elemanları bir döngü içinde sırayla ele alarak, her adımda sıradaki elemanı vl-remove ile listeden kaldırdığımda, liste içindeki verilen kritere uygun tüm elemanlar kaldırılıyor, kaldırdığım (bir veya daha çok sayıda) elemanı listeye append ile (bir tane olarak) tekrar eklediğimde liste içinde tekrarlanan elemanlar temizlenmiş oluyor.

03.12.2013 07:57    

özkan-wien
Sayin ProhibiT hocam cok tesekkür ederim süper bisey oldu. Resmen LISP in acigini kapatmissiniz.
Iyi calismalar.

03.12.2013 09:48    

ProhibiT
Aslında AutoLISP'in bir açığı eksiği yok. :) Biz kendi aramızda anlaştık, ilgi duyan arkadaşlar için bahsettiğimiz konuyu detaylı bir örnekle açıklarsak.
Kod:

(setq a (list "ELmn1" "ELmn2" "ELmn1" "ELmn2" "ELmn3" "ELmn1" "ELmn2"))
;;; başlangıçta listemizde 7 elaman var.
(vl-remove (nth 0 a) a) ;;; -> ("ELmn2" "ELmn2" "ELmn3" "ELmn2")  elde ederiz.
;;; listemizdeki ilk elemanı vl-remove ile kaldırdığımızda,
;;; ilk elemanla aynı içeriğe sahip tüm elemanlar kaldırılır.
(append (list (nth 0 a)) (vl-remove (nth 0 a) a))
;;; append ile listemize ilk elemanı eklersek,
;;; liste içinde ilk elemandan yalnızca bir tane kalır.
;;; yeni liste uzunluğumuz 5 oldu.
;;; yeni listemiz -> ("ELmn1" "ELmn2" "ELmn2" "ELmn3" "ELmn2") şekline gelir.
;;; 3 tane olan ELmn1'i tek bir tane olacak hale getirdik.

;;; eleme işlemini döngü içinde tekrarlanan (veya tekrarlanmayan)
;;; tüm liste elemanları için yaparsak.
(setq a (list "ELmn1" "ELmn2" "ELmn1" "ELmn2" "ELmn3" "ELmn1" "ELmn2") n -1)
(while (< (setq n (1+ n)) (length a))
  (setq a (append (list (nth n a)) (vl-remove (nth n a) a))))
(setq a (vl-sort a '<)) ;;; gerekiyorsa liste elemanları sıralanabilir.
;;; -> listemizi ("ELmn1" "ELmn2" "ELmn3") şeklinde elde ederiz.


Gene bazı arkadaşlarımızın ilgisini çekebilir düşüncesiyle Travacı arkadaşımızla özel mesajlarla didkleye didileye imbikten geçirdiğimiz bir yöntemi de paylaşalım.

ssget ile seçilen Text veya Mtext nesnelerinin içeriklerini aralarına "+" işareti koyarak birleştirmek istiyoruz.
Kod:

(setq Yz  (ssget (list (cons 0 "*text"))) n -1 Tyz nil)
(while (< (setq n (1+ n)) (sslength Yz))
  (setq Tyz (strcat
              (if Tyz
                (strcat "+" (setq Txi (cdr (assoc 1 (entget (ssname Yz n))))))
                Txi))))

Seçim setindeki eleman sayısı kadar tekrarlanacak bir döngü kuruyoruz.
Döngü içinde her adımda, sıradaki Yazı nesnesinin içeriğini ekleyerek devam ediyoruz.
Bu ekleme işlemi sırasında setq içinde if kullanarak, Tyz nil ise yalnızca sıradaki elemanın içeriğini, nil değilse "+" ile sıradaki elemanın içeriğini ekliyoruz. Böylece döngüden çıktığımızda hedeflediğimiz birleştirilmiş yazıyı eksiksiz fazlasız elde ediyoruz. LISP dilinin güzelliği; setq içinde setq ve setq içinde if kullanıldığına dikkat ediniz.

ProhibiT (03.12.2013 10:08 GMT)

03.12.2013 10:20    

özkan-wien
Lisp guzel de hocam "duplicate_remove" da olsa daha iyi olurdu. :-) Telefon kulubesinde calim atmissin valla.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] > 48 < [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.644 saniye - Sorgu: 100 - Ortalama: 0.01644 saniye