27.12.2015 15:54    

schutzhaft
Merhabalar,

Çizimin içerisindeki seçtiğim ölçülendirmelerin excel'de bir hücreye atılmasını forumda bulamadım.

Aslında istediğim lisp, textleri excele aktardığımız lisp gibi, tek fark text'i seçmeyeceğim dimension seçeceğim.

Text'leri excel'e aktardığımız lispi denedim olmadı.



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



Böyle bir lisp yapabilir miyiz?

28.12.2015 13:28    

alumina
Alıntı
schutzhaft :



Kod:

(defun c:de (/ ss i sr d l xl n m)
  (if (setq ss (ssget '((0 . "dimension"))))
    (progn
      (repeat (setq i (sslength ss))
        (if (setq sr (vl-position (setq d (rtos (cdr (assoc 42 (entget
              (ssname ss (setq i (1- i)))))) 2 2)) (mapcar '(lambda(a) (car a)) l)))
          (setq l (subst (list (car (nth sr l)) (1+ (cadr (nth sr l)))) (nth sr l) l))
          (setq l (cons (list d 1) l))))
      (setq xl (open (getfiled "" "" "xls" 9) "w") n 0)
      (write-line (strcat "Sira No" "\t" "Dimension" "\t" "Miktar" "\t"
                    "Toplam Miktar") xl)
      (foreach m (vl-sort (mapcar '(lambda(a) (list (atof (car a)) (cadr a))) l)
                   '(lambda(a b) (< (car a) (car b))))
        (write-line (strcat (rtos (setq n (1+ n)) 2 0) "\t" (vl-string-translate "." ","
                      (rtos (car m) 2 2)) "\t" (rtos (cadr m) 2 0) "\t"
                      (strcat "=" "B" (itoa (1+ n)) "*" "C" (itoa (1+ n)))) xl))
      (write-line (strcat "\t" "Toplam" "\t"
                  (strcat "=" "TOPLA" "(" "C2" ":" "C" (itoa (1+ n)) ")") "\t"
                  (strcat "=" "TOPLA" "(" "D2" ":" "D" (itoa (1+ n)) ")")) xl)
      (close xl)
    )
  ) (princ)
)

30.12.2015 10:09    

schutzhaft
Yardımın için teşekkür ederim ama olayı eksik anlatmışım.

Örnek vermek gerekirse ;

Elimde 6 adet dikdörtgen çizimleri varsayalım. Bu dikdörtgenlerin ölçülerini excele aktarmak istiyorum. Şöyle olacak;

Sıra no | En | Boy | Adet

Seçtiğim ilk dimension en, 2. seçtiğim dimension boy olacak. (Yapabilir miyiz bilmiyorum ama sadece sormak için yazıyorum birde en ve boy yanında adeti ekleyebilir miyiz text olarak seçtiğimi de adet olarak kabul etsin ve excele aktarsın.)

Bu şekilde yapabilir miyiz? Yardımlarınız için şimdiden teşekkürler.

schutzhaft (02.01.2016 12:23 GMT)

30.12.2015 23:33    

alumina
Alıntı
schutzhaft :


Bu seferde eksik anlatmadiniz ins.

Kod:

(defun c:de (/ f s tx fn dt)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg)))
    (if f (redraw (ssname f 0) 4))
    (if s (redraw (ssname s 0) 4))
    (setq *error* nil)
    (princ))
  (prompt "\nSelect first dimension:")
  (if (setq f (ssget ":s" '((0 . "dimension"))))
    (progn (redraw (ssname f 0) 3)
      (prompt "\nSelect second dimension:")
      (if (setq s (ssget ":s" '((0 . "dimension"))))
        (progn (redraw (ssname s 0) 3)
          (prompt "\nSelect text:")
          (if (setq tx (ssget ":s" '((0 . "text"))))
            (progn
              (setq fn (strcat (getvar 'dwgprefix) (vl-filename-base
                (getvar 'dwgname)) ".xls"))
              (if (not (member (strcat (vl-filename-base (getvar 'dwgname)) ".xls")
                  (vl-directory-files (getvar 'dwgprefix) "*.xls")))
                (progn
                  (write-line (strcat "En" "\t" "Boy" "\t" "Miktar")
                    (setq dt (open fn "a"))) (close dt)))
              (write-line (strcat
                (vl-string-translate "." "," (rtos (cdr (assoc 42
                  (entget (ssname f 0)))) 2 2)) "\t"
                (vl-string-translate "." "," (rtos (cdr (assoc 42
                  (entget (ssname s 0)))) 2 2)) "\t"
                (rtos (atof (cdr (assoc 1 (entget (ssname tx 0))))) 2 0))
                  (setq dt (open fn "a"))) (close dt)
            )
          )
        )
      )
    )
  ) (redraw (ssname f 0) 4) (redraw (ssname s 0) 4) (setq *error* nil)
  (princ)
)

02.01.2016 12:21    

schutzhaft
Bu sefer eksik anlatmadım ama;

- lispi çalıştırıyorum
- dimensionları seçip texti seçiyorum ama excel dosyası açılmıyor. (first dimension, second dimension , texti seçiyorum sonra birbirimize bakıyoruz.)

Herhangi bir hatada vermiyor. Atladığım bir nokta mı var?

02.01.2016 16:12    

alumina
Var evet. dwg dosyasi hangi klasordeyse o klasore gidin, dwg dosyasiyla ayni isimde bir excel dosyasi goreceksiniz, o dosyayi acin, sectiginiz olculer ve adetler o excel dosyasinin icinde olacaktir.

Not1: Sonradan sececeginiz olculerde o excel dosyasina yazilacaktir.
Not2: Eger o excel dosyasini kapatmazda acik birakirsaniz, sectiginiz olculer o excel dosyasina yazilmayacaktir.
Not3: Dosyanizla araniza girmek istemem ama siz yinede birbirinize cok bakmayin, kiskanirlar, nazar deger.

02.01.2016 16:59    

schutzhaft
Haklısınız.

Atladığım nokta ise;

Dimensionları seçiyorum texte tıkladıktan sonra kontrol amaçlı excel dosyasına baktığım da excel dosyası, dwg'nin bulunduğu konumda olmuyor. Sonradan farkettim ki seçtiklerim mtext'miş.

Patlattığımda ise lisp canavar gibi çalışıyor ellerinize, emeğinize sağlık. Büyük bir sıkıntıdan kurtardınız.

Fakat 684 tane dikdörtgen çizimi var. Lispe acaba mtexti de entegre etmek mümkün müdür?

schutzhaft (02.01.2016 17:08 GMT)

02.01.2016 22:49    

alumina
Alıntı
schutzhaft :


Text ve Mtext icin uygun hale geldi. Yalniz 684 tane dikdortgen icin boyle tek tek secim yapacaksaniz isiniz cok zor, ve dahasi gozden kacirma veya atlama ihtimalinizde fazla. Eger polyline olan dikdortgenleri ayri bir layere, iclerinde yazan text yada mtext leri de ayri bir layere alirsaniz olculendirmeye gerek kalmaksizin cok daha buyuk bir kolaylik saglayabilirim. (Ornegin polylineler "PL" layerinde, text yada mtext lerde "TX" layerinde olabilir) Isterseniz dedigim sekilde icinde 8-10 tane dikdortgen olan ornek bir dosyayi buraya yukleyin.

Kod:

(defun c:de (/ f s tx fn dt)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg)))
    (if f (redraw (ssname f 0) 4))
    (if s (redraw (ssname s 0) 4))
    (setq *error* nil)
    (princ))
  (prompt "\nSelect first dimension:")
  (if (setq f (ssget ":s" '((0 . "dimension"))))
    (progn (redraw (ssname f 0) 3)
      (prompt "\nSelect second dimension:")
      (if (setq s (ssget ":s" '((0 . "dimension"))))
        (progn (redraw (ssname s 0) 3)
          (prompt "\nSelect text or mtext:")
          (if (setq tx (ssget ":s" '((0 . "*text"))))
            (progn
              (setq fn (strcat (getvar 'dwgprefix) (vl-filename-base
                (getvar 'dwgname)) ".xls"))
              (if (not (member (strcat (vl-filename-base (getvar 'dwgname)) ".xls")
                  (vl-directory-files (getvar 'dwgprefix) "*.xls")))
                (progn
                  (write-line (strcat "En" "\t" "Boy" "\t" "Miktar")
                    (setq dt (open fn "a"))) (close dt)))
              (write-line (strcat
                (vl-string-translate "." "," (rtos (cdr (assoc 42
                  (entget (ssname f 0)))) 2 2)) "\t"
                (vl-string-translate "." "," (rtos (cdr (assoc 42
                  (entget (ssname s 0)))) 2 2)) "\t"
                (rtos (atof (cdr (assoc 1 (entget (ssname tx 0))))) 2 0))
                  (setq dt (open fn "a"))) (close dt)
            )
          )
        )
      )
    )
  ) (redraw (ssname f 0) 4) (redraw (ssname s 0) 4) (setq *error* nil)
  (princ)
)

30.05.2018 09:00    

omurek
Merhaba. Buna benzer bir konuda yardıma ihtiyacım var.

Benim ölçülerde
2500 (D-D)
2500 (D-W1)
1500 (D-W1)

gibi ölçü ve sonrasında text override olarak elle yazılmış yazılar var.

lisp i çalıştırdığım zaman excelde;

2500 (D-D)
2500 (D-W1)
1500 (D-W1)
olarak görmek istediğim değerler sadece
2500 ve 1500 olarak listeleniyor.
2500 (D-D) ve 2500 (D-W1) aynı ölçü sanıp 2 adet 2500 diyor.

Ben istiyorum ki ;

2500 (D-D) 1 adet
2500 (D-W1) 1 adet

gibi listelesin.

Kod üzerinde ufak bir oynama ile yapılabilir diye düşünüyorum ama beceremedim.
Yardımlarınızı rica ederim.

Alıntı
alumina :
Alıntı
schutzhaft :



Kod:

(defun c:de (/ ss i sr d l xl n m)
  (if (setq ss (ssget '((0 . "dimension"))))
    (progn
      (repeat (setq i (sslength ss))
        (if (setq sr (vl-position (setq d (rtos (cdr (assoc 42 (entget
              (ssname ss (setq i (1- i)))))) 2 2)) (mapcar '(lambda(a) (car a)) l)))
          (setq l (subst (list (car (nth sr l)) (1+ (cadr (nth sr l)))) (nth sr l) l))
          (setq l (cons (list d 1) l))))
      (setq xl (open (getfiled "" "" "xls" 9) "w") n 0)
      (write-line (strcat "Sira No" "\t" "Dimension" "\t" "Miktar" "\t"
                    "Toplam Miktar") xl)
      (foreach m (vl-sort (mapcar '(lambda(a) (list (atof (car a)) (cadr a))) l)
                   '(lambda(a b) (< (car a) (car b))))
        (write-line (strcat (rtos (setq n (1+ n)) 2 0) "\t" (vl-string-translate "." ","
                      (rtos (car m) 2 2)) "\t" (rtos (cadr m) 2 0) "\t"
                      (strcat "=" "B" (itoa (1+ n)) "*" "C" (itoa (1+ n)))) xl))
      (write-line (strcat "\t" "Toplam" "\t"
                  (strcat "=" "TOPLA" "(" "C2" ":" "C" (itoa (1+ n)) ")") "\t"
                  (strcat "=" "TOPLA" "(" "D2" ":" "D" (itoa (1+ n)) ")")) xl)
      (close xl)
    )
  ) (princ)
)


01.06.2018 12:02    

bozok
omurek arkadaşımızın talebi benimde işime yarayacak. Bende duvar metrajı yaparken kullanmak istiyorum.
ölçü çizgisine 400 TUĞLA (B) h=2,50 yazıyorum. Buradaki 400 birimi iki kolon arasındaki duvar uzunluğudur. Sonra malzemesi, (B) bulunduğu kat, h=2,50 ise duvar yüksekliği (kirişin altında ise, değilse döşeme altına kadar olan değeri elimle giriyorum). Benim istediğimde yukarıdaki arkadaşımızın talebi gibi. 400 rakamı bir hücreye, 2,50 rakamı yanındaki hücreye yazarak çarpma işlemi gerçekleşecek. Umarım çok şey istememişimdir. Hakkınızı helal edin.

15.06.2018 20:28    

cengiz3dmax
Merhabalar,

çizgi seçildiğinde çizgi ismi ve ölçüsü excel dosyasına yan yana ayrı hücrelere yazılması mümkün müdür ?

iyi çalışmalar,,,

10.07.2019 11:01    

ferhat3858
MERHABA ÖRNEĞİN ELİMDE 3BIYUTLU ÇİZİLMİŞ DOLAP VAR BUNLARIN HERBİR PARÇASINI ÖLÇÜLERİ İLE BİRLİKTE EXCELE AKTARMAK İSTİYORUM BU KONUDA YARDIMCI OLURMUSUNUZ

> 1 <
Copyright © 2004-2022 SQL: 2.617 saniye - Sorgu: 77 - Ortalama: 0.03399 saniye