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ı
edilayk :


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ı
edilayk :


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ı
cagrikara :


Ornek verir misiniz.

18.07.2016 09:07    

cagrikara
Alıntı
alumina :
Alıntı
cagrikara :


Ornek verir misiniz.



Ö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ı
cagrikara :


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

31.07.2016 07:01    

cagrikara
Alıntı
alumina :
Alıntı
cagrikara :


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





Çok Teşekkür ederim. Tam istediğim şey buydu

Ö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.492 saniye - Sorgu: 101 - Ortalama: 0.01477 saniye