* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
10.01.2017 09:54
84478    
alumina

[70] Editör

Online Durumu

651 ileti
Insaat Muhendisi
Istanbul

Alıntı
sesemba :



Secilen line nesnelerinin kesisim noktalarina adi girilen blogu insert eder.
Kod:

(defun c:bn (/ n ss ns bn 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
          (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 0)))))
          ) (vla-endundomark dc)
        ) (alert (strcat "ERROR\n" """ bn """ " was not found"))
      )
    )
  ) (prin1)
)

11.01.2017 17:16
84486    
sesemba

[2] Girişimci

Online Durumu

2 ileti
Teknik öğretmen
ankara

Alakanız için Teşekkürler arkadaşlar.
TAhmin etmediğim kadar iyi sonuç aldım saolun.. Son kombinasyonda rotate yapma ihtimalimiz var mı ? yani 40x20mm kutu profil bloğunu bazen dikine bazen yatayına kullanmam gerekiyo.. acaba yerleştirmeden önce rotate sorsa..default olarak '0' gelse lazım olmayınca enterle geçsek,ama çevirmek gerekirse açı girsek...
Yardımlarınız için tekrar teşekkür ederim.

11.01.2017 18:14
84487    
alumina

[70] Editör

Online Durumu

651 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 11: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 11:31 GMT)

12.01.2017 15:14
84501    
Travaci

[70] Editör

Online Durumu

2112 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 15: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 15:36
84503    
Travaci

[70] Editör

Online Durumu

2112 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 15:47
84505    
Travaci

[70] Editör

Online Durumu

2112 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 16:11
84509    
Travaci

[70] Editör

Online Durumu

2112 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 16:02
84513    
Travaci

[70] Editör

Online Durumu

2112 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 14: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 18: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ı ?

15.01.2017 00:02
84525    
alumina

[70] Editör

Online Durumu

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

15.01.2017 01: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 14:50
84527    
Travaci

[70] Editör

Online Durumu

2112 ileti
Teknik Ressam
Konstantinopol

emrahoksak




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

17.01.2017 11: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 10:03 GMT)

18.01.2017 11:41
84537    
alumina

[70] Editör

Online Durumu

651 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 13:23
84539    
alumina

[70] Editör

Online Durumu

651 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 10: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 11:00
84546    
alumina

[70] Editör

Online Durumu

651 ileti
Insaat Muhendisi
Istanbul

Alıntı
kartal07 :


Eklerim eklemesine de bu son mu?

Ö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] [86] Sonraki Sayfa
Copyright © 2004-2018 | Tüm Hakları Saklıdır | 2148 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam