AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > Lisp istekleri
23.12.2013 08:56    
ProhibiT
"böyle bir lispim var" demişsiniz. Değişken isimlerinden biçim özelliklerine kadar her şeyinden benim yazdığım bir kod olduğu anlaşılıyor.

Fonksiyon, seçilen bir veya daha çok Text nesnesinin sayısal içeriğinin toplamının Field olarak seçilen tek bir CARPAN attribute'üne atanması için yazılmış.

Verdiğiniz örnekte, tek bir text seçip birden fazla Attribute'e field olarak atanması söz konusu.
Tek bir Text nesnesi seçilip, birden çok Attribute nesnesiyle mi ilişkilendirilecek. İstenen bu mu?
Yoksa birden çok Text nesnesi ve gene birden çok Attribute nesnesi mi söz konusu?

23.12.2013 09:10    
Travaci
ProhibiT

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

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))
23.12.2013 09:21    
pulp fiction
Alıntı
ProhibiT :
"böyle bir lispim var" demişsiniz. Değişken isimlerinden biçim özelliklerine kadar her şeyinden benim yazdığım bir kod olduğu anlaşılıyor.

Fonksiyon, seçilen bir veya daha çok Text nesnesinin sayısal içeriğinin toplamının Field olarak seçilen tek bir CARPAN attribute'üne atanması için yazılmış.

Verdiğiniz örnekte, tek bir text seçip birden fazla Attribute'e field olarak atanması söz konusu.
Tek bir Text nesnesi seçilip, birden çok Attribute nesnesiyle mi ilişkilendirilecek. İstenen bu mu?
Yoksa birden çok Text nesnesi ve gene birden çok Attribute nesnesi mi söz konusu?


böyle bir lispim var derken hocam bendeki lisplerin %90'ını saolasınız ya siz yaptınız ya da travaci arkadaşımız zaten :=)

aman yanlış anlaşılma olmasın :=)

Tek bir Text nesnesi seçilip, birden çok Attribute nesnesiyle ilişkilendirilecek.

23.12.2013 13:42    
ProhibiT
Kusuruma bakmayın bende Alzheimer belirtileri başladı galiba :)
Kod:

(defun c:aTTas (/ Ats ID Ip L n p PvT)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (while (not (setq Ip (ssget ":S" (list (cons 0 "*TEXT"))))))
  (redraw (setq Ip (ssname Ip 0)) 3)
  (setq ID (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-ObjectID (vlax-ename->vla-object Ip)))
                ">%).TextString>%")) (princ "\nPoz'ları Seçiniz: ")
  (setq Ats (ssget (list (cons 0 "Insert") (cons 66 1))) n -1) (redraw Ip 4)
  (while (< (setq n (1+ n)) (sslength Ats))
    (setq PvT (ssname Ats n))
    (while (not
            (and (= (cdr (assoc 0 (entget (setq PvT (entnext PvT))))) "ATTRIB")
                 (= (cdr (assoc 2 (entget PvT))) "CARPAN"))))
    (setq PvT (entget PvT) PvT (subst (cons 1 ID) (assoc 1 PvT) PvT)
          PvT (entmod PvT) PvT (entupd (cdr (assoc -1 PvT)))
          PvT (command "_.UpdateFieLd" PvT "")))
  (command "_.undo" "e") (prin1))
23.12.2013 14:04    
pulp fiction
hocam çok teşekkür ederim saolasınız...

23.12.2013 15:10    
Travaci
ProhibiT

Estağfurullah hocam, ben birşey sorayım ;
Kod:

(entupd (cdr (assoc -1 PvT)))

Yukarıdaki satırı kullanmasamda ekran görüntüsünü güncelliyor, İstisnai durumlar mı var bunun için ?

24.12.2013 10:57    
ProhibiT
Eskiden kalma alışkanlıkla entupd işlevini her durumda kullanıyorum. Eski sürümlerde regenauto açık değilken entupd kullanmak gerekiyordu. Yeni sürümlerde böyle bir problem yok. İstisnai durumlar var elbette. Alt nesneleri (sub entities) olan Ana nesnelerde (complex entities), alt nesneler entmod ile işlenmişse, ana nesne entupd ile işleme alınmadan ekran görüntüsü (otomatik veya zorlanmış regenerate işlemine kadar) güncellenmez. Örneğin, bir Polyline nesnesinin alt nesnesi olan Vertex entmod ile işlenip değiştirildiğinde, ana nesne olan polyline entupd ile işleme alınıncaya (ya da regen işlemi gerçekleşinceye) kadar ekranda görüntü güncellenmez.

24.12.2013 12:34    
kerem1453
ustalarımızdan bir ricam olcak çapını verdigim daire içindeki yazıları ve çapı verilen daireleri seçmek için bir lisp yazmak mümkümüdür.(bu istedigim lisp betonarme projelerde poz numaralarını tek seferde silmek için kullanabilcek bir lisp)

24.12.2013 14:51    
ProhibiT
Kod:

;|===========================================================================|
| CrSc: Circles Selection                                                   |
|   Belirlenen bir Circle nesnesi ile aynı Layer'da ve aynı Çapta Circle    |
|   nesneleri ve bunların içindeki Text, Mtext ve Insert Nesneleri seçilir. |
|                        M. Şahin Güvercin - www.cizimokulu.com  24.12.2013 |
|---------------------------------------------------------------------------|;
(defun c:CrSc (/ Cmb m n nk1 nk2 prS PvT Pzn)
  (princ "\nÖrnek Çember Seçiniz: ")
  (while (not (setq Cmb (ssget ":S" (list (cons 0 "Circle"))))))
  (if Cmb (progn (setq Cmb (ssname Cmb 0)) (redraw Cmb 3))(exit))
  (princ "\rÇember ve Poz Numaraları seçiniz: \r")
  (setq Cmb (entget Cmb) n -1 Pzn (ssadd)
        Cmb (ssget (list '(0 . "Circle") (assoc 8 Cmb) (assoc 40 Cmb))))
  (while (< (setq n (1+ n)) (sslength Cmb))
    (setq PvT (entget (ssname Cmb n))
          nk1 (polar (cdr (assoc 10 PvT)) (* 1.25 pi) (cdr (assoc 40 PvT)))
          nK2 (polar nK1 (* 0.25 pi) (* (cdr (assoc 40 PvT)) 2.0))
          prS (ssget "f" (list nk1 nk2) (list (cons 0 "*Text,Insert"))) m -1)
    (while (< (setq m (1+ m)) (sslength prS)) (ssadd (ssname prS m) Pzn)))
  (setq n -1)(while(<(setq n (1+ n))(sslength Pzn))(ssadd(ssname Pzn n) Cmb))
(sssetfirst nil Cmb) (prin1))
24.12.2013 15:17    
kerem1453
şahin hocam çok tşk ederim zahmet edip ilgilendiginiz için.yalnız lisp bazen çalışıyo bazende şu şekilde bir hata veriyo
; error: bad argument type: lselsetp nil
bunun nedeni ne olabilir ? düzeltme şansınız olurmu ?

24.12.2013 15:38    
ProhibiT
Bahsedilen hatanın nedenini bilmiyorum. Belirlenen bölgede, örnek çemberin kriterlerine uygun Circle nesnesi bulunamamasından, yani seçim setinin boş olmasından kaynaklanıyor olabilir. ikinci sebep te, çember içinde nesne bulunamadığında prS seçim seti tanımsız kalacağından hata oluşabilir. Bu tür hata kontrollerine gerek görmemiştim açıkçası.

Bahsedilen ve öngörülmeyen durumların kontrol mekanizması eklenmiş hali;
Kod:

;|===========================================================================|
| CrSc: Circles Selection                                                   |
|   Belirlenen bir Circle nesnesi ile aynı Layer'da ve aynı Çapta Circle    |
|   nesneleri ve bunların içindeki Text, Mtext ve Insert Nesneleri seçilir. |
|                        M. Şahin Güvercin - www.cizimokulu.com  25.12.2013 |
|---------------------------------------------------------------------------|;
(defun c:CrSc (/ Cmb m n nk1 nk2 prS PvT Pzn)
  (princ "\nÖrnek Çember Seçiniz: ")
  (while (not (setq Cmb (ssget ":S" (list (cons 0 "Circle"))))))
  (if Cmb (progn (setq Cmb (ssname Cmb 0)) (redraw Cmb 3)) (exit))
  (princ "\rÇember ve Poz Numaraları seçiniz: \r")
  (setq Cmb (entget Cmb) n -1 Pzn (ssadd)
        Cmb (ssget (list '(0 . "Circle") (assoc 8 Cmb) (assoc 40 Cmb))))
  (if (or (not Cmb) (/= (type Cmb) 'Pickset)) (exit))
  (while (< (setq n (1+ n)) (sslength Cmb))
    (setq PvT (entget (ssname Cmb n))
          nk1 (polar (cdr (assoc 10 PvT)) (* 1.25 pi) (cdr (assoc 40 PvT)))
          nK2 (polar nK1 (* 0.25 pi) (* (cdr (assoc 40 PvT)) 2.0))
          prS (ssget "f" (list nk1 nk2) (list (cons 0 "*Text,Insert"))) m -1)
    (if Prs (while (< (setq m (1+ m)) (sslength prS))
              (ssadd (ssname prS m) Pzn)))) (setq n -1)
  (while (< (setq n (1+ n)) (sslength Pzn)) (ssadd (ssname Pzn n) Cmb))
  (sssetfirst nil Cmb) (prin1))

ProhibiT (25.12.2013 13:29 GMT)

25.12.2013 15:48    
kerem1453
23∅8/20 bu tip donatı yazısının ∅ işratinden önceki kısmı(donatı adet kısmı) cizimden toplu bir şekilde silen bir lisp yazmak mümkünmü bunu bir sefer değilde mouse ile seçtigimiz alanda kalan komple yazılara uygulayabilen.şahin hocam crsc lispinde yaptıgınız değişiklik ve emeginiz içinde çok tşk ederim.

25.12.2013 22:07    
Travaci
kerem1453

Kod:

(defun c:Adel (/ obj dat txt n) (vl-load-com)
  (if (setq obj (ssget (list (cons 0 "*text"))))
    (progn (setq n 0) 
      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
      (repeat (sslength obj)
        (setq dat (vlax-ename->vla-object (ssname obj n))
              txt (vla-get-TextString dat) n (1+ n))
        (if (vl-string-search "Ø" txt) (vla-put-TextString dat
            (substr txt (1+ (vl-string-position (ascii "Ø") txt))))))
      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    )
  ) (princ)
)

Ø işaretinin yazılımı kullandığın font a göre değişiklik gösteriyor %%c, %%d, Ø, ƒ gibi...
Yukarıdaki kodda Ø gördüğün yerleri sen hangisini kullanıyorsan onunla değiştir.
Bir benzeride burada

Travaci (14.01.2015 21:23 GMT)

26.12.2013 14:26    
kerem1453
tşk ederim travacı eline saglık...

27.12.2013 10:50    
CAN123
Arkadaşlar merhaba,

Seçeceğimiz dairelerin X,Y koordinatlarını ve çaplarını aşağıdaki formatta text dosyasına yazdıracak bir lispe ihtiyacım var. Satırın başında "H" olması da gerekiyor.

H 3305.4 -40.2 17.5

Buradaki 3305.4 X koordinatı, -40.2 Y koordinatı ve 17.5 ise dairenin çapı.

şimdiden teşekkürler

27.12.2013 12:23    
Travaci
CAN123

Kod:

(defun c:Cdata (/ *error* lpr dmz obj dat txt n)
  (setq lpr (getvar "luprec") dmz (getvar "dimzin"))
  (defun *error* (msg) (setvar "luprec" lpr) (setvar "dimzin" dmz)
    (close txt) (princ msg))
  (setq obj (ssget (list (cons 0 "circle"))) n 0)
  (if obj (progn (setq txt (open (getfiled "" "" "txt" 9) "w"))
  (setvar "luprec" 1) (setvar "dimzin" 0)
  (repeat (sslength obj)
    (setq dat (entget (ssname obj n)) n (1+ n))
    (write-line (strcat "H " (rtos (cadr (assoc 10 dat)) 2)
      " " (rtos (caddr (assoc 10 dat)) 2)
      " " (rtos (* 2 (cdr (assoc 40 dat))) 2)) txt))
  (close txt) (setvar "luprec" lpr) (setvar "dimzin" dmz))) (princ)
) (terpri) (write-line "Hazırlayan: Erkan Travaci")

Travaci (29.12.2013 00:44 GMT)

27.12.2013 12:24    
CAN123
Travacı arkadaşım çok teşekkürler iyi varsınız.

Küçük bi sorunum var. 0,0 başlangıç noktasını nasıl değiştirebilirim. ucs'den değiştirdim ama olmadı yada ben yapamadım. Programın başında başlangıç noktasını belirleyip daha sonra X ve Y yönünü seçtirmek mümkün mü?

teşekkurler

27.12.2013 12:58    
Travaci
Ucs ni taşısanda yine 0,0 a göre vericek, oyüzden objelerini 0 koordinatına göre taşı. Herzaman dwg formatında çalışmama olasılığı için kodu tekrar düzenledim.

27.12.2013 15:35    
CAN123
Travacı arkadaşım teşekkürler. Bu işlemi çokça yapacağımdan Ucs'yi taşıyabilseydik çok iyi olacaktı.


eline sağlık

27.12.2013 22:46    
Travaci
Alıntı
CAN123 :
Travacı arkadaşım teşekkürler. Bu işlemi çokça yapacağımdan Ucs'yi taşıyabilseydik çok iyi olacaktı.
Kod:

(defun c:ndata (/ lpr dmz obj dat txt n)
  (setq n 0 lpr (getvar "luprec") dmz (getvar "dimzin"))
  (if (setq obj (ssget (list (cons 0 "circle"))))
    (progn
      (setq txt (open (getfiled "" "" "nc1" 9) "w"))
      (setvar "luprec" 1) (setvar "dimzin" 0)
      (repeat (sslength obj)
        (setq dat (entget (ssname obj n)) n (1+ n))
        (write-line (strcat "H " 
              (rtos (car (trans (cdr (assoc 10 dat)) 0 1)) 2)
          " " (rtos (cadr (trans (cdr (assoc 10 dat)) 0 1)) 2)
          " " (rtos (* 2  (cdr (assoc 40 dat))) 2)) txt))
    (close txt) (setvar "luprec" lpr) (setvar "dimzin" dmz))
  ) (princ)
)

Travaci (14.01.2015 21:18 GMT)

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