* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
11.01.2017 15:14
84487    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
sesemba :


Kod:

(defun c:bn (/ n ss ns bn ag dc i lk ls m) (vl-load-com)
  (if (setq n -1 ss (ssget '((0 . "line"))))
    (if (/= (setq bn (getstring T "\nBlock name:")) "")
      (if (tblobjname "block" bn)
        (progn
          (setq ag (getangle "\nBlock rotation <0>:")) (if (= ag nil) (setq ag 0))
          (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object))))
          (repeat (1- (sslength ss))
            (setq ns (vlax-ename->vla-object (ssname ss (setq n (1+ n)))) i n)
            (repeat (- (sslength ss) 1 i)
              (if (not (minusp (vlax-safearray-get-u-bound (setq lk (vlax-variant-value
                  (vla-Intersectwith ns (vlax-ename->vla-object (ssname ss
                    (setq i (1+ i)))) 0))) 1)))
                (if (not (member (setq m (vlax-safearray->list lk)) ls))
                  (progn (setq ls (cons m ls))
                    (vla-InsertBlock (vla-get-modelspace dc) (vlax-3d-point m)
                      bn 1 1 1 ag)))))
          ) (vla-endundomark dc)
        ) (alert (strcat "ERROR\n" """ bn """ " was not found"))
      )
    )
  ) (prin1)
)

12.01.2017 08:23
84495    
kartal07

[2] Girişimci

Online Durumu

8 ileti
tekniker
ankara

Arkadaşlar Merhaba sizlerden bir konu hakkında yardımlarınızı bekliyorum.Elimde bir tane blok sayma işlemi yapan bir lisp var.Bu lisp çizilen bir proje içerisinde blokların isimlerini ve kaç tane olduğunu gösteriyor(metin belgesine kaydediyor).Ancak çizim içerisinde blokların description(açıklama) alanlarında yazılar var.Bu açıklama bölümündeki yazılarında metin belgesinde gösterilmesi gerekiyor.Bunu nasıl yapabilirim.Yardımlarınız için şimdiden teşekkür ederim..

kartal07 (12.01.2017 08:31 GMT)

12.01.2017 12:14
84501    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

kartal07


Kod:

(defun c:BDE (/ ss fl ls nm n bs) (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "insert"))))
    (if (setq fl (getfiled "Block Data Extraction"
        (vl-filename-base (getvar 'dwgname)) "txt" 1))
      (progn
        (setq fl (open fl "w"))
        (repeat (setq n (sslength ss))
          (if (not (member (setq nm (vla-get-EffectiveName
              (vlax-ename->vla-object (ssname ss (setq n (1- n)))))) ls)) 
            (progn
              (setq ls (append ls (list nm)) s 0)
              (repeat (setq bs (sslength ss))
                (if (= (cdr (assoc 2 (entget (ssname ss (setq bs (1- bs)))))) nm)
                  (setq s (1+ s))))
              (write-line (strcat (rtos s 2 0) "  "
                (cdr (assoc 4 (tblsearch "block" nm))) "  " nm) fl)
            )
          )
        ) (close fl)     
      )
    )
  ) (princ)
)

12.01.2017 12:29
84502    
kartal07

[2] Girişimci

Online Durumu

8 ileti
tekniker
ankara

Çok teşekkür ederim Travaci kardeşim..ellerine sağlık

Benim üzerinde çalıştığın lispe description(açıklama) eklenemiyor mu?
Seçim yapılmadan lispi komut satırından çağırdığımızda oluştursa.Olabilir mi?

12.01.2017 12:36
84503    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

kartal07


Lisp paylaşırken kişiye özel deil genele hitap edicek şekilde paylaşmaya çalışıyoruz.
Siz dosya içindeki blockları seçebilirsiniz ama bir başkası projenin belli bir kısmı seçemez.
Seçim yapmanız istendiğinde komut satırına ALL yazabilirsiniz.

İllede öyle olsun isterseniz
bu kısmı

Kod:

(setq ss (ssget (list (cons 0 "insert"))))

Böyle olucak sekilde değiştirin

Kod:

(setq ss (ssget "_x" (list (cons 0 "insert"))))

12.01.2017 12:47
84505    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

kartal07




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




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




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

12.01.2017 13:11
84509    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

kartal07


İlk günden senin de ne istediğini bilmeyenler grubuna katılman üzücü.

Kod:

(defun c:BDE (/ ss fl ls nm n bs) (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "insert"))))
    (if (setq fl (getfiled "Block Data Extraction"
        (vl-filename-base (getvar 'dwgname)) "xls" 1))
      (progn
        (setq fl (open fl "w"))
        (repeat (setq n (sslength ss))
          (if (not (member (setq nm (vla-get-EffectiveName
              (vlax-ename->vla-object (ssname ss (setq n (1- n)))))) ls)) 
            (progn
              (setq ls (append ls (list nm)) s 0)
              (repeat (setq bs (sslength ss))
                (if (= (cdr (assoc 2 (entget (ssname ss (setq bs (1- bs)))))) nm)
                  (setq s (1+ s))))
              (write-line (strcat (cdr (assoc 4 (tblsearch "block" nm)))
                 "\t" nm "\t" (rtos s 2 0)) fl)
            )
          )
        ) (close fl)     
      )
    )
  ) (princ)
)

13.01.2017 13:02
84513    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

kartal07


Autocad ile ilgili soruları bu başlık altında sormayınız.
Overkill komutunu çalıştırdığınızda Tolerance değerini deneyin.

14.01.2017 11:33
84517    
e-celebi

[2] Girişimci

Online Durumu

5 ileti
Müh
İst

Herkese Merhaba

Mevcut bir bloğu çizimde seçilen textin insert noktasına, text ile aynı açıda yerleştiren bir lispe ihtiyacım var.
Yardımcı olacak herkese şimdiden teşekkürler.

14.01.2017 15:44
84523    
emrahoksak

[2] Girişimci

Online Durumu

6 ileti
mimar
van

MERHABA arkadaşlar benim şöyle bir problemim var alan hesaplamasında alanlar çogu zaman degişiyor bende bu yüzden field oluşturup öyle
çalışma yapıyorum fakat tek bir fiel oluşturup onu kopyalıyorum ve herbirinin objesini ayrı ayrı degiştiriyorum acaba bunu daha pratik bir şekilde yapabilecegim bir lisp varmı ?

14.01.2017 21:02
84525    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
e-celebi :



Kod:

(defun c:bn (/ bs ts dc bn tn) (vl-load-com)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg)))
    (if bs (redraw (ssname bs 0) 4)) (setq *error* nil))
  (if (setq bs (ssget ":s" '((0 . "insert"))))
    (progn (redraw (ssname bs 0) 3)
      (if (setq ts (ssget ":s" '((0 . "*text"))))
        (progn
          (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object))))
          (vla-move (setq bn (vlax-ename->vla-object (ssname bs 0))) (vlax-3d-point
            (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint bn))))
            (vlax-3d-point (vlax-safearray->list (vlax-variant-value
            (vla-get-InsertionPoint (setq tn (vlax-ename->vla-object (ssname ts 0))))))))
          (vla-put-Rotation bn (vla-get-Rotation tn))
          (vla-endundomark dc)
        )
      ) (redraw (ssname bs 0) 4)
    )
  ) (setq *error* nil) (prin1)
)

14.01.2017 22:46
84526    
e-celebi

[2] Girişimci

Online Durumu

5 ileti
Müh
İst

Çok teşekkürler alumina. Eline, beynine sağlık çok makbule geçti.

16.01.2017 11:50
84527    
Travaci

[70] Editör

Online Durumu

2194 ileti
Teknik Ressam
Konstantinopol

emrahoksak




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

17.01.2017 08:57
84530    
kartal07

[2] Girişimci

Online Durumu

8 ileti
tekniker
ankara

Merhaba arkadaşlar herkese kolay gelsin.
Seçilen bloğun ismi,description(açıklama) kısmı ve girilen blok ismine bağlı olarak layer(katman) ismini değiştiren lisp var mıdır?(Kullanıcı blok adı ve description alanını girecek.)Araştırmalarım sonucunda sadece blok ismi değişiyor.

Blok adı: deneme
Description(açıklama): blok hakkında açıklama yapılacak
Layer(Katman): ---Layer İsmi:deneme

Yardımlarınızı bekliyorum arkadaşlar.

kartal07 (18.01.2017 07:03 GMT)

18.01.2017 08:41
84537    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
kartal07 :


Kod:

(defun c:bh (/ sb bn ds dc nm nn) (vl-load-com)
  (if (setq sb (ssget ":s" '((0 . "insert"))))
    (progn (redraw (ssname sb 0) 3)
      (if (/= (setq bn (getstring T "\nBlock or layer name:")) "")
        (if (and (not (tblobjname "block" bn)) (not (tblobjname "layer" bn)))
          (if (setq ds (getstring T "\nBlock description:"))
            (progn
              (vla-startundomark (setq dc (vla-get-activedocument
                (vlax-get-acad-object))))
              (vla-Add (vla-get-Layers dc) bn)
              (vla-put-Layer (setq nm (vlax-ename->vla-object (ssname sb 0))) bn)
              (vla-put-Name (setq nn (vla-Item (vla-get-Blocks dc)
                (vla-get-Name nm))) bn)
              (vla-put-Comments nn ds) (vla-endundomark dc)
            )
          ) (alert (strcat "ERROR\n" """ bn """ " is already in use"))
        )
      ) (redraw (ssname sb 0) 4)
    )
  ) (princ)
)

18.01.2017 10:23
84539    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
kartal07 :


"0" layeri haric ("0" layerinin adi degistirilemez) secilen blok nesnesinin name, layer ve description bilgilerini edit eder.
Kod:

(defun c:bh (/ sb dc nm bb bn ds) (vl-load-com)
  (if (setq sb (ssget ":s" '((0 . "insert") (-4 . "<not") (8 . "0") (-4 . "not>"))))
    (progn (redraw (ssname sb 0) 3)
      (setq dc (vla-get-activedocument (vlax-get-acad-object))
            nm (vlax-ename->vla-object (ssname sb 0)))
      (prompt (strcat "\nLayer name: " (vla-get-Layer nm) "\nBlock name: "
        (vla-get-Name nm) "\nBlock description: " (vla-get-Comments
        (setq bb (vla-Item (vla-get-Blocks dc) (vla-get-Name nm))))))
      (if (/= (setq bn (getstring T "\nBlock or layer name:")) "")
        (if (and (not (tblobjname "block" bn)) (not (tblobjname "layer" bn)))
          (if (setq ds (getstring T "\nBlock description:"))
            (progn
              (vla-startundomark dc)
              (vla-put-Name (vla-Item (vla-get-Layers dc) (vla-get-Layer nm)) bn)
              (vla-put-Name bb bn) (vla-put-Comments bb ds)
              (vla-endundomark dc)
            )
          ) (alert (strcat "ERROR\n" """ bn """ " is already in use"))
        )
      ) (redraw (ssname sb 0) 4)
    )
  ) (princ)
)

19.01.2017 07:42
84545    
kartal07

[2] Girişimci

Online Durumu

8 ileti
tekniker
ankara

Yardımların için teşekkür ederim alumina .

Sana rica etsem bu kodlara blok layer bilgisinin girilmesini ekleyebilir misiniz?

19.01.2017 08:00
84546    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
kartal07 :


Eklerim eklemesine de bu son mu?

19.01.2017 08:42
84549    
alumina

[70] Editör

Online Durumu

676 ileti
Insaat Muhendisi
Istanbul

Alıntı
kartal07 :


Kod:

(defun c:bh (/ sb dc nm bb bn ln ds) (vl-load-com)
  (if (setq sb (ssget ":s" '((0 . "insert") (-4 . "<not") (8 . "0") (-4 . "not>"))))
    (progn (redraw (ssname sb 0) 3)
      (setq dc (vla-get-activedocument (vlax-get-acad-object))
            nm (vlax-ename->vla-object (ssname sb 0)))
      (prompt (strcat "\nLayer name: " (vla-get-Layer nm) "\nBlock name: "
        (vla-get-Name nm) "\nBlock description: " (vla-get-Comments
        (setq bb (vla-Item (vla-get-Blocks dc) (vla-get-Name nm))))))
      (if (/= (setq ln (getstring T "\nLayer name:")) "")
        (if (not (tblobjname "layer" ln))
          (if (/= (setq bn (getstring T "\nBlock name:")) "")
            (if (not (tblobjname "block" bn))
              (if (setq ds (getstring T "\nBlock description:"))
                (progn
                  (vla-startundomark dc)
                  (vla-put-Name (vla-Item (vla-get-Layers dc) (vla-get-Layer nm)) ln)
                  (vla-put-Name bb bn) (vla-put-Comments bb ds)
                  (vla-endundomark dc)
                )
              ) (alert (strcat "ERROR\n" bn " is already in use"))
            )
          ) (alert (strcat "ERROR\n" ln " is already in use"))
        )
      ) (redraw (ssname sb 0) 4)
    )
  ) (princ)
)

19.01.2017 08:45
84550    
kartal07

[2] Girişimci

Online Durumu

8 ileti
tekniker
ankara

çok teşekkür ederim alumina.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] [60] [65] [70] > 75 < [80] [85] [90] Sonraki Sayfa
Copyright © 2004-2019 | Tüm Hakları Saklıdır | 334 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam | İletişim