11.01.2017 15:14    

alumina
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    

kartal07
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    

Travaci
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    

kartal07
Ç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    

Travaci
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    

Travaci
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    

Travaci
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    

Travaci
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    

e-celebi
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    

emrahoksak
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    

alumina
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    

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

16.01.2017 11:50    

Travaci
emrahoksak




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

17.01.2017 08:57    

kartal07
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    

alumina
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    

alumina
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    

kartal07
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    

alumina
Alıntı
kartal07 :


Eklerim eklemesine de bu son mu?

19.01.2017 08:42    

alumina
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    

kartal07
ç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] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.885 saniye - Sorgu: 102 - Ortalama: 0.01848 saniye