Copyright © 2004-2022 SQL: 1.261 saniye - Sorgu: 99 - Ortalama: 0.01274 saniye
11.06.2016 14:20
edilayk |
merhaba arkadaşlar
lisp istekleri bölümünde görmüş olduğum Alumina Beyin yazmış olduğu aşağıdaki lisp i uzun süredir kullanıyorum .Sizden ricam bu lisp e uzunluk ölçümleri için polyline ve arc ı da ekleyebilirmiyiz sadece line de ölçüm yapabiliyor. Birde Seçilen bir komutun açık olan excel dosyasında kendi belirleyeceğim aktif excel hücresine yazdıra bilsem yani işlem yaptıkça yazdırılan excel dosyasının açık olmasını istiyorum .Bu lispte excel dosyası kapalı olduğu için yapılan işlemleri, işlem sırasında göremiyorum.Bu konuda sayın hocalarım yardımcı olabilir misiniz ? yardımlarınız için şimdiden çok teşekkür ederim (defun c:alumina (/ *error* tx ln) (defun *error* (er) (if tx (redraw (car tx) 4)) (setq *error* nil)) (vl-load-com) (if (null (tblsearch "layer" "Metraj_Layer")) (entmake (list (cons 0 "layer") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 "Metraj_Layer") (cons 62 1) (cons 70 0)))) (while (setq tx (entsel "\nSelect text:")) (while (/= (cdr (assoc 0 (entget (car tx)))) "TEXT") (setq tx (entsel "\nSelect text:"))) (redraw (car tx) 3) (setq ln (entsel "\nSelect line:")) (while (/= (cdr (assoc 0 (entget (car ln)))) "LINE") (setq ln (entsel "\nSelect line:"))) (redraw (car tx) 4) (vla-put-layer (vlax-ename->vla-object (car tx)) "Metraj_Layer") (vla-put-layer (vlax-ename->vla-object (car ln)) "Metraj_Layer") (setq dosya (open (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) "_Metraj.xls") "a")) (write-line (strcat (vla-get-textstring (vlax-ename->vla-object (car tx))) "\t" (rtos (vla-get-length (vlax-ename->vla-object (car ln))) 2 2)) dosya) (close dosya)) (princ)) İyi günler diliyorum
|
12.06.2016 20:53
alumina |
Alıntı Kod: (defun c:xl (/ tx ss tn sn dt) (vl-load-com)
(defun *error* (msg) (if (not (wcmatch (strcase msg t) "*cancel*,*exit*")) (princ (strcat "\nError: " msg))) (if tx (redraw (ssname tx 0) 4)) (setq *error* nil) (princ) ) (prompt "\nSelect text or mtext:") (if (setq tx (ssget ":s" '((0 . "*text")))) (progn (redraw (ssname tx 0) 3) (prompt "\nSelect arc, line or polyline:") (if (setq ss (ssget ":s" '((0 . "arc,line,*polyline")))) (progn (if (not (tblobjname "layer" "Metraj")) (vla-put-Color (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "Metraj") 1)) (vla-put-Layer (setq tn (vlax-ename->vla-object (ssname tx 0))) "Metraj") (vla-put-Layer (setq sn (vlax-ename->vla-object (ssname ss 0))) "Metraj") (write-line (strcat (vla-get-TextString tn) "\t" (vl-string-translate "." "," (if (or (= (vla-get-ObjectName sn) "AcDbLine") (= (vla-get-ObjectName sn) "AcDbPolyline")) (rtos (vla-get-Length sn) 2 2) (rtos (vla-get-ArcLength sn) 2 2)))) (setq dt (open (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".xls") "a")) ) (close dt) ) ) (redraw (ssname tx 0) 4) ) ) (setq *error* nil) (princ) )
|
13.06.2016 06:38
Travaci |
edilayk Linkleri görebilmek için ÜYE olmalısınız. alumina Kod: (if (= (vla-get-ObjectName sn) "AcDbArc")
(rtos (vla-get-ArcLength sn) 2 2) (rtos (vla-get-Length sn) 2 2))
|
13.06.2016 09:27
edilayk |
Hocam ellerinize sağlık çok teşekkür ederim.Birde şöyle bir şey istemiştim bu konuda da yardımcı olur musunuz? Sanırım yoğunlukta gözünüzden kaçtı.Seçilen bir komutun açık olan excel dosyasında kendi belirleyeceğim aktif excel hücresine yazdıra bilsem yani işlem yaptıkça yazdırılan excel dosyasının açık olmasını istiyorum .Bu lispte excel dosyası kapalı olduğu için yapılan işlemleri, işlem sırasında göremiyorum.Bu konuda sayın hocam yardımcı olabilir misiniz ? Travacı Beyin yollamış olduğu decc komutu gibi aslında ama bu komutta sıkıntı sadece uzunlukları söylemesi text in dahil olmaması .Eger aktif excel hücresine yazdırmak için yazacağınız lisp çok uzun ise ve sizi çok zahmet verecek ise sadece excel dosyanın açık kalması ( Bu lispte excel dosyası kapalı olduğu için yapılan işlemleri, işlem sırasında göremiyorum ) da işimi görecektir.
yardımlarınız için şimdiden çok teşekkür ederim.
|
13.06.2016 20:06
alumina |
Alıntı Travaci hocamizin yazdigi kisaltmayla birlikte kod daha kaliteli bir hale geldi. Revize edilmis hali asagidaki gibidir. Kod: (defun c:xl (/ tx ss tn sn dt) (vl-load-com)
(defun *error* (msg) (if (not (wcmatch (strcase msg t) "*cancel*,*exit*")) (princ (strcat "\nError: " msg))) (if tx (redraw (ssname tx 0) 4)) (setq *error* nil) (princ) ) (prompt "\nSelect text or mtext:") (if (setq tx (ssget ":s" '((0 . "*text")))) (progn (redraw (ssname tx 0) 3) (prompt "\nSelect arc, line or polyline:") (if (setq ss (ssget ":s" '((0 . "arc,line,*polyline")))) (progn (if (not (tblobjname "layer" "Metraj")) (vla-put-Color (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "Metraj") 1)) (vla-put-Layer (setq tn (vlax-ename->vla-object (ssname tx 0))) "Metraj") (vla-put-Layer (setq sn (vlax-ename->vla-object (ssname ss 0))) "Metraj") (write-line (strcat (vla-get-TextString tn) "\t" (vl-string-translate "." "," (if (= (vla-get-ObjectName sn) "AcDbArc") (rtos (vla-get-ArcLength sn) 2 2) (rtos (vla-get-Length sn) 2 2)))) (setq dt (open (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".xls") "a")) ) (close dt) ) ) (redraw (ssname tx 0) 4) ) ) (setq *error* nil) (princ) )
|
14.06.2016 05:14
seboli61 |
Kod: (vl-load-com) (defun c:FLD2TXT (/ ss n bn an ad s) (prompt "Select the objects you wish to remove the field links from: " ) ;_ end of prompt (setq ss (ssget '((0 . "INSERT,MTEXT,DIMENSION,TEXT,MULTILEADER")))) ;Get selection set from user (setq n 0) ;Initialize counter ;; Step through selection set one entity at a time (while (< n (sslength ss)) (setq bn (ssname ss n)) ;Get the nth entity in the selection set (setq ad (entget bn)) ;Get the entity's data (cond ((= "INSERT" (cdr (assoc 0 ad))) ;Check if block (setq an (entnext bn)) ;Get the next enity after bn ;; Step through each next entity until it is not an attribute (while (and an ;Check if entity is found (setq ad (entget an)) ;Get data (= "ATTRIB" (cdr (assoc 0 ad))) ;Check if attribute ) ;_ end of and (setq s (cdr (assoc 1 ad))) ;Get text value (entmod (list (assoc -1 ad) (cons 1 ""))) ;Modify the entity (entmod (list (assoc -1 ad) (cons 1 s))) ;Modify the entity (entupd an) ;Update screen to show change (setq an (entnext an)) ;Get next entity ) ;_ end of while ) ((= "MULTILEADER" (cdr (assoc 0 ad))) ;Check if block (setq ad (vlax-ename->vla-object bn) s (vla-get-TextString ad) ) (vla-put-TextString ad "") (vla-put-TextString ad s) ) ;; Anything else (t (setq s (cdr (assoc 1 ad))) ;Get text value (entmod (list (assoc -1 ad) (cons 1 ""))) ;Modify the entity (entmod (list (assoc -1 ad) (cons 1 s))) ;Modify the entity (entupd an) ;Update screen to show change ) ) (setq n (1+ n)) ;Increment counter ) ;_ end of while (setq ss nil) ;Clear selection set (gc) ;Clear unused memory (princ) ) ;_ end of defun Yukarıda ki lisp field li her hangi bir şeyi bağlılığını bozarak normal haline getiriyor ama değer olduğu gibi kalıyor benim problemim çoklu nesne seçebiliyorum ama bir tanesini yapıyor. Acaba bunu düzeltebilir misiniz ?
|
14.06.2016 10:30
edilayk |
Alumina Bey
Yardımlarınız için çok teşekkür ederim.Seçilen verileri devamlı olarak açık excel dosyasına yazdırma(13.06.2014 tarihindeki 83582 nolu yazımdaki gibi ) ile ilgili çözümünüzü de sabırsızlıkla bekliyorum. iyi günler
|
23.06.2016 11:29
kabardey46 |
Exceldeki gibi tablo verilerinden çizgi grafik yapan lisp var mıdır
|
16.07.2016 05:14
cagrikara |
Autocad dosyasında bulunan text değerlerine (text değerleri 1000den fazla farklı sayılar içeriyor ve sayıların ondalık kısımı 3 basamaklı) autocad'in bu değerlere rastgele benim belirleyeceğim ondalık kısımı 3 basamaklı değer vermesini istiyorum. ( Belirleyeceğim değerlerin başında + ve - bulunacaktır ve belirleyeceğim değerler 5 ile 10 farklı sayı olacaktır.)
Kısacası 1000 den fazla farklı sayıları belirleyeceğim sayılarla rastgele değiştirmesidir. Yardımınız için şimdiden teşekkür ederim.
|
17.07.2016 11:53
alumina |
Alıntı Ornek verir misiniz.
|
18.07.2016 09:07
cagrikara |
Alıntı Örnek olarak mesajın altında linki bulunan autocad çizimine bakabilirsiniz. bu autocad çiziminde text olarak yazılı olan kotlar belli bir düzene uygun olmayarak yani rastgele olarak (-0.002, -0.001, 0, +0.001, +0.002) olarak değişmesini istiyorum. Örnek Dosya
|
20.07.2016 11:18
alumina |
Alıntı Kod: (defun c:td (/ sn n ss ls dc) (vl-load-com)
(if (setq sn t n -1 ss (ssget '((0 . "text") (1 . "+*,-*,#*")))) (progn (while (/= sn nil) (setq ls (cons (setq sn (getreal "\nNumber:")) ls))) (if (/= (setq ls (vl-remove nil ls)) nil) (progn (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object)))) (repeat (setq i (sslength ss)) (vla-put-TextString (vlax-ename->vla-object (ssname ss (setq i (1- i)))) (nth (setq n (1+ n)) ls)) (if (= n (1- (length ls))) (setq n -1))) (vla-endundomark dc) ) ) ) ) (princ) )
|
23.07.2016 11:40
alves |
autocadde tesisat sembollerimi ayrı ayrı lavabo 20 adet duş 10 adet küvet 5 adet ve diğerlerinin blokladım.bu blokları ayrı ayrı insetrle çizime çağırmak yerine menüden resimlerini görerek onları üzerine tıklayarak çizime dahil edebileceğim bir lisp menüsü varmıdır.
|
23.07.2016 17:40
alumina |
O lisp menusu icin odeyebileceginiz bir butce var midir?
|
23.07.2016 18:01
mttlp |
Çok basit ctrl ve 3 tıkla palet açılır sağ tıkla yeni palet ekle çağıracan blokları kopyala yapıştır her zama bloklar gelir
|
27.07.2016 16:59
alves |
500TL yetermi
|
30.07.2016 07:24
rose11rose |
değerli çizimokulu üyeleri,
İhtiyacım olan bir lispi sizden talep etmekteyim. Mesela 25 katlı bir kulenin kesitten katlarını çizmem gerekiyor. ihtyacım olan şey seçilen nesneyi benim belirlediğim mesafede benim belirlediğim yönde ve benim belirlediğim sayı kadar kopyalamasını istiyorum. örneğin ben birtane katı çiziyorum ve yukarıya doğru 300 değerinde kopyalıyorum sonra 600 sonra 900 sonra 1200 diye gidiyor tek seferde değer verip bunu çözmem lazım yardımlarınızı bekliyorum teşekkürler
|
30.07.2016 15:00
Travaci |
Kod: rose11rose Array komutu zaten bunun için değilmi ?
|
30.07.2016 20:41
rose11rose |
Hic denemedim hocam array komutuyla olup olmadigini bilmiyorum deneyip goruslerimi bildiririm tesekkur ederim
|
cagrikara |
Alıntı Çok Teşekkür ederim. Tam istediğim şey buydu
|