Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.319 saniye - Sorgu: 100 - Ortalama: 0.01319 saniye
 |
 |
 |
 |
|
|
|
|
11.01.2017 15:14
 alumina
|
Alıntı 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ı 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
|
|
|
|
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ı 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ı "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ı Eklerim eklemesine de bu son mu?
|
|
19.01.2017 08:42
alumina
|
Alıntı 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) )
|
|
kartal07
|
|
çok teşekkür ederim alumina.
|